From 5fdb474c7662e239620a5dfdfcd50680df697496 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 17 Dec 2008 22:29:32 -0600 Subject: [PATCH] Fixing various test failures and updating some more vocabs for >r/r> removal --- .../tree/dead-code/dead-code-tests.factor | 2 +- .../modular-arithmetic-tests.factor | 4 +-- basis/concurrency/messaging/messaging.factor | 6 ++--- basis/fry/fry-tests.factor | 2 +- basis/help/cookbook/cookbook.factor | 2 +- basis/listener/listener-tests.factor | 2 +- basis/locals/locals-tests.factor | 2 +- .../porter-stemmer-tests.factor | 4 +-- basis/porter-stemmer/porter-stemmer.factor | 12 ++++----- basis/prettyprint/prettyprint-tests.factor | 2 +- .../stack-checker/stack-checker-tests.factor | 6 ++--- basis/unicode/script/script.factor | 5 ++-- core/combinators/combinators.factor | 2 +- core/growable/growable.factor | 4 +-- core/kernel/kernel-tests.factor | 4 +-- core/namespaces/namespaces-docs.factor | 2 +- core/parser/parser-tests.factor | 27 ++++++++++--------- core/syntax/syntax-docs.factor | 6 ++--- core/vocabs/loader/loader-tests.factor | 2 +- core/vocabs/parser/parser-docs.factor | 3 +-- core/words/words-docs.factor | 2 +- core/words/words-tests.factor | 2 +- extra/coroutines/coroutines-tests.factor | 2 +- extra/fuel/fuel.factor | 2 +- extra/koszul/koszul.factor | 22 +++++++-------- extra/slides/slides.factor | 2 +- extra/spheres/spheres.factor | 11 ++++---- extra/sudoku/sudoku.factor | 12 ++++----- extra/tetris/game/game.factor | 2 +- extra/tetris/gl/gl.factor | 2 +- 30 files changed, 79 insertions(+), 79 deletions(-) diff --git a/basis/compiler/tree/dead-code/dead-code-tests.factor b/basis/compiler/tree/dead-code/dead-code-tests.factor index 1e9e93fa7c..7c28866e94 100644 --- a/basis/compiler/tree/dead-code/dead-code-tests.factor +++ b/basis/compiler/tree/dead-code/dead-code-tests.factor @@ -79,7 +79,7 @@ IN: compiler.tree.dead-code.tests [ [ read drop 1 2 ] ] [ [ read [ 1 2 ] dip drop ] optimize-quot ] unit-test -[ [ over [ + ] dip ] ] [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test +[ [ over >R + R> ] ] [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test [ [ [ ] [ ] if ] ] [ [ [ 1 ] [ 2 ] if drop ] optimize-quot ] unit-test diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor index 31c50587cf..5d6a9cdea1 100644 --- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor +++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor @@ -8,13 +8,13 @@ compiler.tree.debugger ; : test-modular-arithmetic ( quot -- quot' ) build-tree optimize-tree nodes>quot ; -[ [ [ >fixnum ] dip >fixnum fixnum+fast ] ] +[ [ >R >fixnum R> >fixnum fixnum+fast ] ] [ [ { integer integer } declare + >fixnum ] test-modular-arithmetic ] unit-test [ [ +-integer-integer dup >fixnum ] ] [ [ { integer integer } declare + dup >fixnum ] test-modular-arithmetic ] unit-test -[ [ [ >fixnum ] dip >fixnum fixnum+fast 4 fixnum*fast ] ] +[ [ >R >fixnum R> >fixnum fixnum+fast 4 fixnum*fast ] ] [ [ { integer integer } declare + 4 * >fixnum ] test-modular-arithmetic ] unit-test TUPLE: declared-fixnum { x fixnum } ; diff --git a/basis/concurrency/messaging/messaging.factor b/basis/concurrency/messaging/messaging.factor index 7a00f62e9e..61a3c38991 100644 --- a/basis/concurrency/messaging/messaging.factor +++ b/basis/concurrency/messaging/messaging.factor @@ -20,13 +20,13 @@ M: thread send ( message thread -- ) my-mailbox mailbox-get ?linked ; : receive-timeout ( timeout -- message ) - my-mailbox swap mailbox-get-timeout ?linked ; + [ my-mailbox ] dip mailbox-get-timeout ?linked ; : receive-if ( pred -- message ) - my-mailbox swap mailbox-get? ?linked ; inline + [ my-mailbox ] dip mailbox-get? ?linked ; inline : receive-if-timeout ( timeout pred -- message ) - my-mailbox -rot mailbox-get-timeout? ?linked ; inline + [ my-mailbox ] 2dip mailbox-get-timeout? ?linked ; inline : rethrow-linked ( error process supervisor -- ) [ ] dip send ; diff --git a/basis/fry/fry-tests.factor b/basis/fry/fry-tests.factor index ca0268ee70..7189450394 100644 --- a/basis/fry/fry-tests.factor +++ b/basis/fry/fry-tests.factor @@ -56,7 +56,7 @@ sequences eval accessors ; 3 '[ [ [ _ 1array ] call 1array ] call 1array ] call ] unit-test -[ "USING: fry kernel ; f '[ load-local _ ]" eval ] +[ "USING: fry locals.backend ; f '[ load-local _ ]" eval ] [ error>> >r/r>-in-fry-error? ] must-fail-with [ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [ diff --git a/basis/help/cookbook/cookbook.factor b/basis/help/cookbook/cookbook.factor index e72fbb439c..0d435a1eaf 100644 --- a/basis/help/cookbook/cookbook.factor +++ b/basis/help/cookbook/cookbook.factor @@ -360,7 +360,7 @@ ARTICLE: "cookbook-pitfalls" "Pitfalls to avoid" { $list "Factor only makes use of one native thread, and Factor threads are scheduled co-operatively. C library calls block the entire VM." "Factor does not hide anything from the programmer, all internals are exposed. It is your responsibility to avoid writing fragile code which depends too much on implementation detail." - { "When a source file uses two vocabularies which define words with the same name, the order of the vocabularies in the " { $link POSTPONE: USE: } " or " { $link POSTPONE: USING: } " forms is important. The parser prints warnings when vocabularies shadow words from other vocabularies; see " { $link "vocabulary-search-shadow" } ". The " { $vocab-link "qualified" } " vocabulary implements qualified naming, which can be used to resolve ambiguities." } + { "When a source file uses two vocabularies which define words with the same name, the order of the vocabularies in the " { $link POSTPONE: USE: } " or " { $link POSTPONE: USING: } " forms is important. The " { $link POSTPONE: QUALIFIED: } " word implements qualified naming, which can be used to resolve ambiguities." } { "If a literal object appears in a word definition, the object itself is pushed on the stack when the word executes, not a copy. If you intend to mutate this object, you must " { $link clone } " it first. See " { $link "syntax-literals" } "." } { "For a discussion of potential issues surrounding the " { $link f } " object, see " { $link "booleans" } "." } { "Factor's object system is quite flexible. Careless usage of union, mixin and predicate classes can lead to similar problems to those caused by ``multiple inheritance'' in other languages. In particular, it is possible to have two classes such that they have a non-empty intersection and yet neither is a subclass of the other. If a generic word defines methods on two such classes, various disambiguation rules are applied to ensure method dispatch remains deterministic, however they may not be what you expect. See " { $link "method-order" } " for details." } diff --git a/basis/listener/listener-tests.factor b/basis/listener/listener-tests.factor index e681bac314..61aa323924 100644 --- a/basis/listener/listener-tests.factor +++ b/basis/listener/listener-tests.factor @@ -1,6 +1,6 @@ USING: io io.streams.string io.streams.duplex listener tools.test parser math namespaces continuations vocabs kernel -compiler.units eval ; +compiler.units eval vocabs.parser ; IN: listener.tests : hello "Hi" print ; parsing diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor index b5c201a5d9..e7f0b74194 100644 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -2,7 +2,7 @@ USING: locals math sequences tools.test hashtables words kernel namespaces arrays strings prettyprint io.streams.string parser accessors generic eval combinators combinators.short-circuit combinators.short-circuit.smart math.order math.functions -definitions compiler.units fry lexer ; +definitions compiler.units fry lexer words.symbol ; IN: locals.tests :: foo ( a b -- a a ) a a ; diff --git a/basis/porter-stemmer/porter-stemmer-tests.factor b/basis/porter-stemmer/porter-stemmer-tests.factor index 42c358646b..72bf5c0bb5 100644 --- a/basis/porter-stemmer/porter-stemmer-tests.factor +++ b/basis/porter-stemmer/porter-stemmer-tests.factor @@ -57,8 +57,8 @@ io.files io.encodings.utf8 ; [ "mate" ] [ "mate" step5 "" like ] unit-test [ { } ] [ - "resource:extra/porter-stemmer/test/voc.txt" utf8 file-lines + "resource:basis/porter-stemmer/test/voc.txt" utf8 file-lines [ stem ] map - "resource:extra/porter-stemmer/test/output.txt" utf8 file-lines + "resource:basis/porter-stemmer/test/output.txt" utf8 file-lines [ 2array ] 2map [ first2 = not ] filter ] unit-test diff --git a/basis/porter-stemmer/porter-stemmer.factor b/basis/porter-stemmer/porter-stemmer.factor index 7ae273f20a..b6eb0ff464 100644 --- a/basis/porter-stemmer/porter-stemmer.factor +++ b/basis/porter-stemmer/porter-stemmer.factor @@ -7,7 +7,7 @@ USING: kernel math parser sequences combinators splitting ; ] [ CHAR: y = [ over zero? - [ 2drop t ] [ >r 1- r> consonant? not ] if + [ 2drop t ] [ [ 1- ] dip consonant? not ] if ] [ 2drop t ] if @@ -15,18 +15,18 @@ USING: kernel math parser sequences combinators splitting ; : skip-vowels ( i str -- i str ) 2dup bounds-check? [ - 2dup consonant? [ >r 1+ r> skip-vowels ] unless + 2dup consonant? [ [ 1+ ] dip skip-vowels ] unless ] when ; : skip-consonants ( i str -- i str ) 2dup bounds-check? [ - 2dup consonant? [ >r 1+ r> skip-consonants ] when + 2dup consonant? [ [ 1+ ] dip skip-consonants ] when ] when ; : (consonant-seq) ( n i str -- n ) skip-vowels 2dup bounds-check? [ - >r 1+ >r 1+ r> r> skip-consonants >r 1+ r> + [ 1+ ] [ 1+ ] [ ] tri* skip-consonants [ 1+ ] dip (consonant-seq) ] [ 2drop @@ -42,7 +42,7 @@ USING: kernel math parser sequences combinators splitting ; over 1 < [ 2drop f ] [ - 2dup nth >r over 1- over nth r> = [ + 2dup nth [ over 1- over nth ] dip = [ consonant? ] [ 2drop f @@ -52,7 +52,7 @@ USING: kernel math parser sequences combinators splitting ; : consonant-end? ( n seq -- ? ) [ length swap - ] keep consonant? ; -: last-is? ( str possibilities -- ? ) >r peek r> member? ; +: last-is? ( str possibilities -- ? ) [ peek ] dip member? ; : cvc? ( str -- ? ) { diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor index 648c707967..b1239086d7 100644 --- a/basis/prettyprint/prettyprint-tests.factor +++ b/basis/prettyprint/prettyprint-tests.factor @@ -3,7 +3,7 @@ kernel math namespaces parser prettyprint prettyprint.config prettyprint.sections sequences tools.test vectors words effects splitting generic.standard prettyprint.private continuations generic compiler.units tools.walker eval -accessors make ; +accessors make vocabs.parser ; IN: prettyprint.tests [ "4" ] [ 4 unparse ] unit-test diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index 8dd07b9619..7b2a6d2d83 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -6,7 +6,7 @@ quotations effects tools.test continuations generic.standard sorting assocs definitions prettyprint io inspector classes.tuple classes.union classes.predicate debugger threads.private io.streams.string io.timeouts io.thread -sequences.private destructors combinators eval ; +sequences.private destructors combinators eval locals.backend ; IN: stack-checker.tests \ infer. must-infer @@ -320,7 +320,7 @@ DEFER: bar : bad-bin ( a b -- ) 5 [ 5 bad-bin bad-bin 5 ] [ 2drop ] if ; [ [ bad-bin ] infer ] must-fail -[ [ r> ] infer ] [ inference-error? ] must-fail-with +[ [ 1 drop-locals ] infer ] [ inference-error? ] must-fail-with ! Regression [ [ cleave ] infer ] [ inference-error? ] must-fail-with @@ -502,7 +502,7 @@ ERROR: custom-error ; [ custom-error inference-error ] infer ] unit-test -[ T{ effect f 1 1 t } ] [ +[ T{ effect f 1 2 t } ] [ [ dup [ 3 throw ] dip ] infer ] unit-test diff --git a/basis/unicode/script/script.factor b/basis/unicode/script/script.factor index 9691797128..ad9a6d0896 100644 --- a/basis/unicode/script/script.factor +++ b/basis/unicode/script/script.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2008 Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: accessors values kernel sequences assocs io.files -io.encodings ascii math.ranges io splitting math.parser +io.encodings ascii math.ranges io splitting math.parser namespaces make byte-arrays locals math sets io.encodings.ascii -words compiler.units arrays interval-maps unicode.data ; +words words.symbol compiler.units arrays interval-maps +unicode.data ; IN: unicode.script > set-nth-unsafe ; : contract ( len seq -- ) [ length ] keep - [ 0 -rot set-nth-unsafe ] curry + [ [ 0 ] 2dip set-nth-unsafe ] curry (each-integer) ; inline : growable-check ( n seq -- n seq ) diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor index 320025b124..0702f4931f 100644 --- a/core/kernel/kernel-tests.factor +++ b/core/kernel/kernel-tests.factor @@ -17,7 +17,7 @@ IN: kernel.tests [ ] [ :c ] unit-test -[ { } set-retainstack r> ] [ { "kernel-error" 13 f f } = ] must-fail-with +[ 3 [ { } set-retainstack ] dip ] [ { "kernel-error" 13 f f } = ] must-fail-with [ ] [ :c ] unit-test @@ -35,7 +35,7 @@ IN: kernel.tests [ ] [ [ :c ] with-string-writer drop ] unit-test -: overflow-r 3 >r overflow-r ; +: overflow-r 3 [ overflow-r ] dip ; [ overflow-r ] [ { "kernel-error" 14 f f } = ] must-fail-with diff --git a/core/namespaces/namespaces-docs.factor b/core/namespaces/namespaces-docs.factor index 4716a8fe99..1cc3d86e98 100644 --- a/core/namespaces/namespaces-docs.factor +++ b/core/namespaces/namespaces-docs.factor @@ -34,7 +34,7 @@ ARTICLE: "namespaces.private" "Namespace implementation details" ARTICLE: "namespaces" "Variables and namespaces" "The " { $vocab-link "namespaces" } " vocabulary implements simple dynamically-scoped variables." $nl -"A variable is an entry in an assoc of bindings, where the assoc is implicit rather than passed on the stack. These assocs are termed " { $emphasis "namespaces" } ". Nesting of scopes is implemented with a search order on namespaces, defined by a " { $emphasis "namestack" } ". Since namespaces are just assoc, any object can be used as a variable, however by convention, variables are keyed by symbols (see " { $link "symbols" } ")." +"A variable is an entry in an assoc of bindings, where the assoc is implicit rather than passed on the stack. These assocs are termed " { $emphasis "namespaces" } ". Nesting of scopes is implemented with a search order on namespaces, defined by a " { $emphasis "namestack" } ". Since namespaces are just assoc, any object can be used as a variable, however by convention, variables are keyed by symbols (see " { $link "words.symbol" } ")." $nl "The " { $link get } " and " { $link set } " words read and write variable values. The " { $link get } " word searches up the chain of nested namespaces, while " { $link set } " always sets variable values in the current namespace only. Namespaces are dynamically scoped; when a quotation is called from a nested scope, any words called by the quotation also execute in that scope." { $subsection get } diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index bdbd6b37a8..2870be9a4f 100644 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -2,7 +2,8 @@ USING: arrays math parser tools.test kernel generic words io.streams.string namespaces classes effects source-files assocs sequences strings io.files io.pathnames definitions continuations sorting classes.tuple compiler.units debugger -vocabs vocabs.loader accessors eval combinators lexer ; +vocabs vocabs.loader accessors eval combinators lexer +vocabs.parser words.symbol ; IN: parser.tests \ run-file must-infer @@ -485,19 +486,19 @@ must-fail-with [ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test -[ "DEFER: blah" eval ] [ error>> error>> no-current-vocab? ] must-fail-with +[ "DEFER: blahy" eval ] [ error>> error>> no-current-vocab? ] must-fail-with [ - "IN: parser.tests : blah ; parsing FORGET: blah" eval + "IN: parser.tests : blahy ; parsing FORGET: blahy" eval ] [ error>> staging-violation? ] must-fail-with ! Bogus error message -DEFER: blah +DEFER: blahy -[ "IN: parser.tests USE: kernel TUPLE: blah < tuple ; : blah ; TUPLE: blah < tuple ; : blah ;" eval ] -[ error>> error>> def>> \ blah eq? ] must-fail-with +[ "IN: parser.tests USE: kernel TUPLE: blahy < tuple ; : blahy ; TUPLE: blahy < tuple ; : blahy ;" eval ] +[ error>> error>> def>> \ blahy eq? ] must-fail-with [ ] [ f lexer set f file set "Hello world" note. ] unit-test @@ -511,14 +512,16 @@ SYMBOLS: a b c ; DEFER: blah -[ ] [ "IN: symbols.tests GENERIC: blah" eval ] unit-test -[ ] [ "IN: symbols.tests USE: symbols SYMBOLS: blah ;" eval ] unit-test +[ ] [ "IN: parser.tests GENERIC: blah" eval ] unit-test +[ ] [ "IN: parser.tests SYMBOLS: blah ;" eval ] unit-test [ f ] [ \ blah generic? ] unit-test [ t ] [ \ blah symbol? ] unit-test -[ "IN: symbols.tests USE: symbols SINGLETONS: blah blah blah ;" eval ] -[ error>> error>> def>> \ blah eq? ] +DEFER: blah1 + +[ "IN: parser.tests SINGLETONS: blah1 blah1 blah1 ;" eval ] +[ error>> error>> def>> \ blah1 eq? ] must-fail-with IN: qualified.tests.foo @@ -548,8 +551,8 @@ EXCLUDE: qualified.tests.bar => x ; [ 3 ] [ x ] unit-test [ 4 ] [ y ] unit-test -[ "USE: qualified IN: qualified.tests FROM: qualified.tests => doesnotexist ;" eval ] +[ "IN: qualified.tests FROM: qualified.tests => doesnotexist ;" eval ] [ error>> no-word-error? ] must-fail-with -[ "USE: qualified IN: qualified.tests RENAME: doesnotexist qualified.tests => blah" eval ] +[ "IN: qualified.tests RENAME: doesnotexist qualified.tests => blahx" eval ] [ error>> no-word-error? ] must-fail-with diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 54b8b1b401..36f427d5ad 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -414,7 +414,7 @@ HELP: QUALIFIED: { $syntax "QUALIFIED: vocab" } { $description "Similar to " { $link POSTPONE: USE: } " but loads vocabulary with prefix." } { $examples { $example - "USING: prettyprint qualified ;" + "USING: prettyprint ;" "QUALIFIED: math" "1 2 math:+ ." "3" } } ; @@ -423,7 +423,7 @@ HELP: QUALIFIED-WITH: { $syntax "QUALIFIED-WITH: vocab word-prefix" } { $description "Works like " { $link POSTPONE: QUALIFIED: } " but uses " { $snippet "word-prefix" } " as prefix." } { $examples { $code - "USING: prettyprint qualified ;" + "USING: prettyprint ;" "QUALIFIED-WITH: math m" "1 2 m:+ ." "3" @@ -445,7 +445,7 @@ HELP: RENAME: { $syntax "RENAME: word vocab => newname" } { $description "Imports " { $snippet "word" } " from " { $snippet "vocab" } ", but renamed to " { $snippet "newname" } "." } { $examples { $example - "USING: prettyprint qualified ;" + "USING: prettyprint ;" "RENAME: + math => -" "2 3 - ." "5" diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor index 533bea76fc..57bc824f59 100644 --- a/core/vocabs/loader/loader-tests.factor +++ b/core/vocabs/loader/loader-tests.factor @@ -3,7 +3,7 @@ USING: vocabs.loader tools.test continuations vocabs math kernel arrays sequences namespaces io.streams.string parser source-files words assocs classes.tuple definitions debugger compiler.units tools.vocabs accessors eval -combinators ; +combinators vocabs.parser ; ! This vocab should not exist, but just in case... [ ] [ diff --git a/core/vocabs/parser/parser-docs.factor b/core/vocabs/parser/parser-docs.factor index b2e964962d..71862402cd 100644 --- a/core/vocabs/parser/parser-docs.factor +++ b/core/vocabs/parser/parser-docs.factor @@ -35,8 +35,7 @@ $nl "fee:append calls foe:append" "foe:append calls sequences:append" "12345678" -} -"The " { $vocab-link "qualified" } " vocabulary contains some tools for helping with shadowing." ; +} ; ARTICLE: "vocabulary-search-errors" "Word lookup errors" "If the parser cannot not find a word in the current vocabulary search path, it attempts to look for the word in all loaded vocabularies." diff --git a/core/words/words-docs.factor b/core/words/words-docs.factor index 02fb5cf54e..764df9924c 100644 --- a/core/words/words-docs.factor +++ b/core/words/words-docs.factor @@ -33,7 +33,7 @@ $nl { $subsection define-inline } "Word definitions should declare their stack effect, unless the definition is completely trivial. See " { $link "effect-declaration" } "." $nl -"All other types of word definitions, such as " { $link "symbols" } " and " { $link "generic" } ", are just special cases of the above." ; +"All other types of word definitions, such as " { $link "words.symbol" } " and " { $link "generic" } ", are just special cases of the above." ; ARTICLE: "primitives" "Primitives" "Primitives are words defined in the Factor VM. They provide the essential low-level services to the rest of the system." diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor index 09ebcb6b77..10c17a0e79 100644 --- a/core/words/words-tests.factor +++ b/core/words/words-tests.factor @@ -1,7 +1,7 @@ USING: arrays generic assocs kernel math namespaces sequences tools.test words definitions parser quotations vocabs continuations classes.tuple compiler.units -io.streams.string accessors eval ; +io.streams.string accessors eval words.symbol ; IN: words.tests [ 4 ] [ diff --git a/extra/coroutines/coroutines-tests.factor b/extra/coroutines/coroutines-tests.factor index e07e9725d0..f4ac97354d 100644 --- a/extra/coroutines/coroutines-tests.factor +++ b/extra/coroutines/coroutines-tests.factor @@ -16,6 +16,6 @@ test1 dup *coresume . dup *coresume . dup *coresume . dup *coresume 2drop : test3 ( -- co ) [ [ coyield* ] each ] cocreate ; -{ "c" "b" "a" } [ test3 { "a" "b" "c" } over coresume >r dup *coresume >r *coresume r> r> ] unit-test +{ "c" "b" "a" } [ test3 { "a" "b" "c" } over coresume [ dup *coresume [ *coresume ] dip ] dip ] unit-test { 4+2/3 } [ [ 1+ coyield 2 * coyield 3 / coreset ] cocreate 1 5 [ over coresume ] times nip ] unit-test \ No newline at end of file diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index 4535ac7fd6..58efe2d8ce 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -7,7 +7,7 @@ eval help io io.files io.pathnames io.streams.string kernel lexer listener listener.private make math memoize namespaces parser prettyprint prettyprint.config quotations sequences sets sorting source-files strings tools.vocabs vectors vocabs -vocabs.loader ; +vocabs.loader vocabs.parser ; IN: fuel diff --git a/extra/koszul/koszul.factor b/extra/koszul/koszul.factor index 3b675e5258..7ac69d2980 100755 --- a/extra/koszul/koszul.factor +++ b/extra/koszul/koszul.factor @@ -108,7 +108,7 @@ SYMBOL: boundaries : ((d)) ( basis -- value ) boundaries get at ; -: dx.y ( x y -- vec ) >r ((d)) r> wedge ; +: dx.y ( x y -- vec ) [ ((d)) ] dip wedge ; DEFER: (d) @@ -120,7 +120,7 @@ DEFER: (d) : linear-op ( vec quot -- vec ) [ [ - -rot >r swap call r> alt*n (alt+) + -rot [ swap call ] dip alt*n (alt+) ] curry assoc-each ] with-terms ; inline @@ -165,7 +165,7 @@ DEFER: (d) swap call [ at 0 or ] curry map ; inline : op-matrix ( domain range quot -- matrix ) - rot [ >r 2dup r> (op-matrix) ] map 2nip ; inline + rot [ [ 2dup ] dip (op-matrix) ] map 2nip ; inline : d-matrix ( domain range -- matrix ) [ (d) ] op-matrix ; @@ -176,7 +176,7 @@ DEFER: (d) ! Graded by degree : (graded-ker/im-d) ( n seq -- null/rank ) #! d: C(n) ---> C(n+1) - [ ?nth ] 2keep >r 1+ r> ?nth + [ ?nth ] [ [ 1+ ] dip ?nth ] 2bi dim-im/ker-d ; : graded-ker/im-d ( graded-basis -- seq ) @@ -188,13 +188,13 @@ DEFER: (d) ! Bi-graded for two-step complexes : (bigraded-ker/im-d) ( u-deg z-deg bigraded-basis -- null/rank ) #! d: C(u,z) ---> C(u+2,z-1) - [ ?nth ?nth ] 3keep >r >r 2 + r> 1 - r> ?nth ?nth + [ ?nth ?nth ] 3keep [ [ 2 + ] dip 1 - ] dip ?nth ?nth dim-im/ker-d ; : bigraded-ker/im-d ( bigraded-basis -- seq ) dup length [ over first length [ - >r 2dup r> spin (bigraded-ker/im-d) + [ 2dup ] dip spin (bigraded-ker/im-d) ] map 2nip ] with map ; @@ -224,13 +224,13 @@ DEFER: (d) ] if ; : laplacian-matrix ( basis1 basis2 basis3 -- matrix ) - dupd d-matrix m.m' >r d-matrix m'.m r> ?m+ ; + dupd d-matrix m.m' [ d-matrix m'.m ] dip ?m+ ; : laplacian-betti ( basis1 basis2 basis3 -- n ) laplacian-matrix null/rank drop ; : laplacian-kernel ( basis1 basis2 basis3 -- basis ) - >r tuck r> + [ tuck ] dip laplacian-matrix dup empty-matrix? [ 2drop f ] [ @@ -246,7 +246,7 @@ DEFER: (d) dup length [ graded-triple ] with map ; : graded-laplacian ( generators quot -- seq ) - >r basis graded graded-triples [ first3 ] r> compose map ; + [ basis graded graded-triples [ first3 ] ] dip compose map ; inline : graded-laplacian-betti ( generators -- seq ) @@ -273,12 +273,12 @@ DEFER: (d) : bigraded-triples ( grid -- triples ) dup length [ over first length [ - >r 2dup r> spin bigraded-triple + [ 2dup ] dip spin bigraded-triple ] map 2nip ] with map ; : bigraded-laplacian ( u-generators z-generators quot -- seq ) - >r [ basis graded ] bi@ tensor bigraded-triples r> + [ [ basis graded ] bi@ tensor bigraded-triples ] dip [ [ first3 ] prepose map ] curry map ; inline : bigraded-laplacian-betti ( u-generators z-generators -- seq ) diff --git a/extra/slides/slides.factor b/extra/slides/slides.factor index dc8bdd4576..0ce946dc49 100755 --- a/extra/slides/slides.factor +++ b/extra/slides/slides.factor @@ -88,7 +88,7 @@ TUPLE: slides < book ; : prev-page ( book -- ) -1 change-page ; : (strip-tease) ( data n -- data ) - >r first3 r> head 3array ; + [ first3 ] dip head 3array ; : strip-tease ( data -- seq ) dup third length 1- [ diff --git a/extra/spheres/spheres.factor b/extra/spheres/spheres.factor index 543c26ae14..f08e08c787 100755 --- a/extra/spheres/spheres.factor +++ b/extra/spheres/spheres.factor @@ -154,8 +154,7 @@ M: spheres-gadget distance-step ( gadget -- dz ) : (make-reflection-framebuffer) ( depthbuffer -- framebuffer ) gen-framebuffer dup [ - swap >r - GL_FRAMEBUFFER_EXT GL_DEPTH_ATTACHMENT_EXT GL_RENDERBUFFER_EXT r> + swap [ GL_FRAMEBUFFER_EXT GL_DEPTH_ATTACHMENT_EXT GL_RENDERBUFFER_EXT ] dip glFramebufferRenderbufferEXT ] with-framebuffer ; @@ -244,10 +243,10 @@ M: spheres-gadget pref-dim* ( gadget -- dim ) [ drop dup [ -+ ] bi@ ] 2keep ; : (reflection-face) ( gadget face -- ) - swap reflection-texture>> >r >r - GL_FRAMEBUFFER_EXT - GL_COLOR_ATTACHMENT0_EXT - r> r> 0 glFramebufferTexture2DEXT + swap reflection-texture>> [ + GL_FRAMEBUFFER_EXT + GL_COLOR_ATTACHMENT0_EXT + ] 2dip 0 glFramebufferTexture2DEXT check-framebuffer ; : (draw-reflection-texture) ( gadget -- ) diff --git a/extra/sudoku/sudoku.factor b/extra/sudoku/sudoku.factor index 93b1804e36..c02242e170 100644 --- a/extra/sudoku/sudoku.factor +++ b/extra/sudoku/sudoku.factor @@ -6,7 +6,7 @@ IN: sudoku SYMBOL: solutions SYMBOL: board -: pair+ ( a b c d -- a+b c+d ) swapd + >r + r> ; +: pair+ ( a b c d -- a+b c+d ) swapd [ + ] 2bi@ ; : row ( n -- row ) board get nth ; : board> ( m n -- x ) row nth ; @@ -19,13 +19,13 @@ SYMBOL: board : box-contains? ( n x y -- ? ) [ 3 /i 3 * ] bi@ - 9 [ >r 3dup r> cell-contains? ] contains? - >r 3drop r> ; + 9 [ [ 3dup ] dip cell-contains? ] contains? + [ 3drop ] dip ; DEFER: search : assume ( n x y -- ) - [ >board ] 2keep [ >r 1+ r> search ] 2keep f>board ; + [ >board ] 2keep [ [ 1+ ] dip search ] 2keep f>board ; : attempt ( n x y -- ) { @@ -59,9 +59,9 @@ DEFER: search : search ( x y -- ) { - { [ over 9 = ] [ >r drop 0 r> 1+ search ] } + { [ over 9 = ] [ [ drop 0 ] dip 1+ search ] } { [ over 0 = over 9 = and ] [ 2drop solution. ] } - { [ 2dup board> ] [ >r 1+ r> search ] } + { [ 2dup board> ] [ [ 1+ ] dip search ] } [ solve ] } cond ; diff --git a/extra/tetris/game/game.factor b/extra/tetris/game/game.factor index 30622c9e38..ef5ffcc344 100644 --- a/extra/tetris/game/game.factor +++ b/extra/tetris/game/game.factor @@ -88,7 +88,7 @@ TUPLE: tetris : tetris-move ( tetris move -- ? ) #! moves the piece if possible, returns whether the piece was moved 2dup can-move? [ - >r current-piece r> move-piece drop t + [ current-piece ] dip move-piece drop t ] [ 2drop f ] if ; diff --git a/extra/tetris/gl/gl.factor b/extra/tetris/gl/gl.factor index a9b00ffb7c..e7c01742d5 100644 --- a/extra/tetris/gl/gl.factor +++ b/extra/tetris/gl/gl.factor @@ -20,7 +20,7 @@ IN: tetris.gl ! TODO: move implementation specific stuff into tetris-board : (draw-row) ( x y row -- ) - >r over r> nth dup + [ over ] dip nth dup [ gl-color 2array draw-block ] [ 3drop ] if ; : draw-row ( y row -- ) -- 2.34.1