From 34792a9f23717d78cc5fc90ed26d3d636354e59f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 17 Dec 2008 19:17:37 -0600 Subject: [PATCH] Remove >r/r> --- .../compiler/cfg/builder/builder-tests.factor | 2 +- .../cfg/linear-scan/linear-scan-tests.factor | 2 +- basis/compiler/tests/codegen.factor | 18 +++++------ basis/compiler/tests/curry.factor | 6 ++-- basis/compiler/tests/optimizer.factor | 8 ++--- .../tree/dead-code/dead-code-tests.factor | 2 +- basis/compiler/tree/debugger/debugger.factor | 6 ++-- .../modular-arithmetic-tests.factor | 4 +-- .../tree/propagation/propagation-tests.factor | 4 +-- basis/cpu/ppc/bootstrap.factor | 4 +-- basis/cpu/x86/64/64.factor | 4 +-- basis/cpu/x86/bootstrap.factor | 4 +-- basis/db/sqlite/lib/lib.factor | 2 +- basis/delegate/delegate-tests.factor | 2 +- basis/fry/fry-docs.factor | 2 +- basis/fry/fry-tests.factor | 2 +- basis/fry/fry.factor | 2 +- basis/furnace/chloe-tags/chloe-tags.factor | 2 +- basis/grouping/grouping-docs.factor | 2 +- basis/heaps/heaps-tests.factor | 2 +- basis/lcs/lcs.factor | 2 +- .../rewrite/point-free/point-free.factor | 5 +++- basis/locals/rewrite/sugar/sugar.factor | 2 +- basis/match/match.factor | 2 +- basis/math/functions/functions-tests.factor | 2 +- basis/math/intervals/intervals-tests.factor | 8 ++--- basis/opengl/shaders/shaders.factor | 4 +-- basis/persistent/deques/deques.factor | 6 ++-- basis/persistent/heaps/heaps.factor | 2 +- basis/serialize/serialize.factor | 9 +++--- basis/stack-checker/errors/errors-docs.factor | 16 ++-------- .../known-words/known-words.factor | 4 +-- .../stack-checker/stack-checker-tests.factor | 12 ++++---- basis/tuple-arrays/tuple-arrays.factor | 2 +- basis/validators/validators.factor | 2 +- .../dragdrop-listener.factor | 30 +++++++++++-------- basis/windows/kernel32/kernel32.factor | 2 -- basis/xml-rpc/example.factor | 2 +- basis/xml-rpc/xml-rpc.factor | 8 ++--- basis/xmode/catalog/catalog.factor | 22 +++++++------- basis/xmode/loader/syntax/syntax.factor | 2 +- basis/xmode/marker/marker.factor | 4 +-- basis/xmode/marker/state/state.factor | 6 ++-- basis/xmode/rules/rules.factor | 5 ++-- basis/xmode/utilities/utilities.factor | 2 +- core/bootstrap/primitives.factor | 3 +- 46 files changed, 115 insertions(+), 129 deletions(-) diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index c3cce1425e..0b303a8a43 100644 --- a/basis/compiler/cfg/builder/builder-tests.factor +++ b/basis/compiler/cfg/builder/builder-tests.factor @@ -14,7 +14,7 @@ kernel.private math ; [ ] [ dup ] [ swap ] - [ >r r> ] + [ [ ] dip ] [ fixnum+ ] [ fixnum+fast ] [ 3 fixnum+fast ] diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index 948302c74b..7420b4fd17 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -249,7 +249,7 @@ SYMBOL: max-uses ] with-scope ; : random-test ( num-intervals max-uses max-registers max-insns -- ) - over >r random-live-intervals r> int-regs associate check-linear-scan ; + over [ random-live-intervals ] dip int-regs associate check-linear-scan ; [ ] [ 30 2 1 60 random-test ] unit-test [ ] [ 60 2 2 60 random-test ] unit-test diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index e743c8484b..3d17009e31 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -75,7 +75,7 @@ unit-test -12 -13 [ [ 0 swap fixnum-fast ] bi@ ] compile-call ] unit-test -[ -1 2 ] [ 1 2 [ >r 0 swap fixnum- r> ] compile-call ] unit-test +[ -1 2 ] [ 1 2 [ [ 0 swap fixnum- ] dip ] compile-call ] unit-test [ 12 13 ] [ -12 -13 [ [ 0 swap fixnum- ] bi@ ] compile-call @@ -88,13 +88,13 @@ unit-test ! Test slow shuffles [ 3 1 2 3 4 5 6 7 8 9 ] [ 1 2 3 4 5 6 7 8 9 - [ >r >r >r >r >r >r >r >r >r 3 r> r> r> r> r> r> r> r> r> ] + [ [ [ [ [ [ [ [ [ [ 3 ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] compile-call ] unit-test [ 2 2 2 2 2 2 2 2 2 2 1 ] [ 1 2 - [ swap >r dup dup dup dup dup dup dup dup dup r> ] compile-call + [ swap [ dup dup dup dup dup dup dup dup dup ] dip ] compile-call ] unit-test [ ] [ [ 9 [ ] times ] compile-call ] unit-test @@ -110,7 +110,7 @@ unit-test float+ swap { [ "hey" ] [ "bye" ] } dispatch ; : try-breaking-dispatch-2 ( -- ? ) - 1 1.0 2.5 try-breaking-dispatch "bye" = >r 3.5 = r> and ; + 1 1.0 2.5 try-breaking-dispatch "bye" = [ 3.5 = ] dip and ; [ t ] [ 10000000 [ drop try-breaking-dispatch-2 ] all? @@ -131,10 +131,10 @@ unit-test 2dup 1 slot eq? [ 2drop ] [ 2dup array-nth tombstone? [ [ - [ array-nth ] 2keep >r 1 fixnum+fast r> array-nth + [ array-nth ] 2keep [ 1 fixnum+fast ] dip array-nth pick 2dup hellish-bug-1 3drop ] 2keep - ] unless >r 2 fixnum+fast r> hellish-bug-2 + ] unless [ 2 fixnum+fast ] dip hellish-bug-2 ] if ; inline recursive : hellish-bug-3 ( hash array -- ) @@ -159,9 +159,9 @@ TUPLE: my-tuple ; [ 5 ] [ "hi" foox ] unit-test ! Making sure we don't needlessly unbox/rebox -[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ >r eq? r> ] compile-call ] unit-test +[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ [ eq? ] dip ] compile-call ] unit-test -[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ ] compile-call >r eq? r> ] unit-test +[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ ] compile-call [ eq? ] dip ] unit-test [ t ] [ 1.0 dup [ [ 2.0 float+ ] keep ] compile-call nip eq? ] unit-test @@ -188,7 +188,7 @@ TUPLE: my-tuple ; [ 2 1 ] [ 2 1 - [ 2dup fixnum< [ >r die r> ] when ] compile-call + [ 2dup fixnum< [ [ die ] dip ] when ] compile-call ] unit-test ! Regression diff --git a/basis/compiler/tests/curry.factor b/basis/compiler/tests/curry.factor index ecc2d87b73..1857baf503 100644 --- a/basis/compiler/tests/curry.factor +++ b/basis/compiler/tests/curry.factor @@ -8,7 +8,7 @@ IN: compiler.tests [ 3 ] [ 5 [ 2 [ - ] 2curry call ] compile-call ] unit-test [ 3 ] [ 5 2 [ [ - ] 2curry call ] compile-call ] unit-test [ 3 ] [ 5 2 [ [ - ] 2curry 9 swap call /i ] compile-call ] unit-test -[ 3 ] [ 5 2 [ [ - ] 2curry >r 9 r> call /i ] compile-call ] unit-test +[ 3 ] [ 5 2 [ [ - ] 2curry [ 9 ] dip call /i ] compile-call ] unit-test [ -10 -20 ] [ 10 20 -1 [ [ * ] curry bi@ ] compile-call ] unit-test @@ -21,14 +21,14 @@ IN: compiler.tests [ [ 6 2 + ] ] [ 2 5 - [ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry ] + [ [ [ + ] curry ] dip 0 < [ -2 ] [ 6 ] if swap curry ] compile-call >quotation ] unit-test [ 8 ] [ 2 5 - [ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry call ] + [ [ [ + ] curry ] dip 0 < [ -2 ] [ 6 ] if swap curry call ] compile-call ] unit-test diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index fa6a3c7b21..bb1cb2eab5 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -248,12 +248,12 @@ USE: binary-search.private : lift-loop-tail-test-1 ( a quot -- ) over even? [ - [ >r 3 - r> call ] keep lift-loop-tail-test-1 + [ [ 3 - ] dip call ] keep lift-loop-tail-test-1 ] [ over 0 < [ 2drop ] [ - [ >r 2 - r> call ] keep lift-loop-tail-test-1 + [ [ 2 - ] dip call ] keep lift-loop-tail-test-1 ] if ] if ; inline @@ -290,7 +290,7 @@ HINTS: recursive-inline-hang-3 array ; ! Wow : counter-example ( a b c d -- a' b' c' d' ) - dup 0 > [ 1 - >r rot 2 * r> counter-example ] when ; inline + dup 0 > [ 1 - [ rot 2 * ] dip counter-example ] when ; inline : counter-example' ( -- a' b' c' d' ) 1 2 3.0 3 counter-example ; @@ -330,7 +330,7 @@ PREDICATE: list < improper-list [ 0 5 ] [ 0 interval-inference-bug ] unit-test : aggressive-flush-regression ( a -- b ) - f over >r drop r> 1 + ; + f over [ drop ] dip 1 + ; [ 1.0 aggressive-flush-regression drop ] must-fail diff --git a/basis/compiler/tree/dead-code/dead-code-tests.factor b/basis/compiler/tree/dead-code/dead-code-tests.factor index b64e30d8f9..1e9e93fa7c 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 >r + r> ] ] [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test +[ [ over [ + ] dip ] ] [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test [ [ [ ] [ ] if ] ] [ [ [ 1 ] [ 2 ] if drop ] optimize-quot ] unit-test diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor index 213a8357e6..9f2cc0536e 100644 --- a/basis/compiler/tree/debugger/debugger.factor +++ b/basis/compiler/tree/debugger/debugger.factor @@ -80,10 +80,12 @@ M: shuffle-node pprint* effect>> effect>string text ; [ out-d>> length 1 = ] } 1&& ; +SYMBOLS: >R R> ; + M: #shuffle node>quot { - { [ dup #>r? ] [ drop \ >r , ] } - { [ dup #r>? ] [ drop \ r> , ] } + { [ dup #>r? ] [ drop \ >R , ] } + { [ dup #r>? ] [ drop \ R> , ] } { [ dup [ in-r>> empty? ] [ out-r>> empty? ] bi and ] [ diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor index b535dfe39c..31c50587cf 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 ; -[ [ >r >fixnum r> >fixnum fixnum+fast ] ] +[ [ [ >fixnum ] dip >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 -[ [ >r >fixnum r> >fixnum fixnum+fast 4 fixnum*fast ] ] +[ [ [ >fixnum ] dip >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/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 87152a8e2b..b9a88de34a 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -18,7 +18,7 @@ IN: compiler.tree.propagation.tests [ V{ fixnum } ] [ [ 1 ] final-classes ] unit-test -[ V{ fixnum } ] [ [ 1 >r r> ] final-classes ] unit-test +[ V{ fixnum } ] [ [ 1 [ ] dip ] final-classes ] unit-test [ V{ fixnum object } ] [ [ 1 swap ] final-classes ] unit-test @@ -198,7 +198,7 @@ IN: compiler.tree.propagation.tests [ { fixnum byte-array } declare [ nth-unsafe ] 2keep [ nth-unsafe ] 2keep nth-unsafe - >r >r 298 * r> 100 * - r> 208 * - 128 + -8 shift + [ [ 298 * ] dip 100 * - ] dip 208 * - 128 + -8 shift 255 min 0 max ] final-classes ] unit-test diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index 445c7082bc..b27f3aee72 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -302,9 +302,7 @@ big-endian on 4 ds-reg 0 STW ] f f f \ -rot define-sub-primitive -[ jit->r ] f f f \ >r define-sub-primitive - -[ jit-r> ] f f f \ r> define-sub-primitive +[ jit->r ] f f f \ load-local define-sub-primitive ! Comparisons : jit-compare ( insn -- ) diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 841a4e4c55..e46c8f6914 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -50,8 +50,8 @@ M: x86.64 %prologue ( n -- ) M: stack-params %load-param-reg drop - >r R11 swap param@ MOV - r> param@ R11 MOV ; + [ R11 swap param@ MOV ] dip + param@ R11 MOV ; M: stack-params %save-param-reg drop diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index 26488b8d95..5e3405e93a 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -319,9 +319,7 @@ big-endian off ds-reg [] temp1 MOV ] f f f \ -rot define-sub-primitive -[ jit->r ] f f f \ >r define-sub-primitive - -[ jit-r> ] f f f \ r> define-sub-primitive +[ jit->r ] f f f \ load-local define-sub-primitive ! Comparisons : jit-compare ( insn -- ) diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor index bcd38b172d..fd0d1131d7 100644 --- a/basis/db/sqlite/lib/lib.factor +++ b/basis/db/sqlite/lib/lib.factor @@ -42,7 +42,7 @@ ERROR: sqlite-sql-error < sql-error n string ; sqlite3_bind_parameter_index ; : parameter-index ( handle name text -- handle name text ) - >r dupd sqlite-bind-parameter-index r> ; + [ dupd sqlite-bind-parameter-index ] dip ; : sqlite-bind-text ( handle index text -- ) utf8 encode dup length SQLITE_TRANSIENT diff --git a/basis/delegate/delegate-tests.factor b/basis/delegate/delegate-tests.factor index d1e7d31656..7d297af1ed 100644 --- a/basis/delegate/delegate-tests.factor +++ b/basis/delegate/delegate-tests.factor @@ -20,7 +20,7 @@ PROTOCOL: baz foo { bar 0 } { whoa 1 } ; CONSULT: baz goodbye these>> ; M: hello foo this>> ; M: hello bar hello-test ; -M: hello whoa >r this>> r> + ; +M: hello whoa [ this>> ] dip + ; GENERIC: bing ( c -- d ) PROTOCOL: bee bing ; diff --git a/basis/fry/fry-docs.factor b/basis/fry/fry-docs.factor index 1dff0942bd..d91f44aecb 100644 --- a/basis/fry/fry-docs.factor +++ b/basis/fry/fry-docs.factor @@ -20,7 +20,7 @@ HELP: '[ { $examples "See " { $link "fry.examples" } "." } ; HELP: >r/r>-in-fry-error -{ $error-description "Thrown by " { $link POSTPONE: '[ } " if the fried quotation contains calls to " { $link >r } " or " { $link r> } ". Explicit retain stack manipulation of this form does not work with fry; use " { $link dip } " instead." } ; +{ $error-description "Thrown by " { $link POSTPONE: '[ } " if the fried quotation contains calls to retain stack manipulation primitives." } ; ARTICLE: "fry.examples" "Examples of fried quotations" "The easiest way to understand fried quotations is to look at some examples." diff --git a/basis/fry/fry-tests.factor b/basis/fry/fry-tests.factor index 0137e8be22..ca0268ee70 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 '[ >r _ r> ]" eval ] +[ "USING: fry kernel ; 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/fry/fry.factor b/basis/fry/fry.factor index f84ad233cd..e62a42749f 100644 --- a/basis/fry/fry.factor +++ b/basis/fry/fry.factor @@ -25,7 +25,7 @@ M: >r/r>-in-fry-error summary "Explicit retain stack manipulation is not permitted in fried quotations" ; : check-fry ( quot -- quot ) - dup { >r r> load-locals get-local drop-locals } intersect + dup { load-local load-locals get-local drop-locals } intersect empty? [ >r/r>-in-fry-error ] unless ; PREDICATE: fry-specifier < word { _ @ } memq? ; diff --git a/basis/furnace/chloe-tags/chloe-tags.factor b/basis/furnace/chloe-tags/chloe-tags.factor index f500acd7ab..1c320182bf 100644 --- a/basis/furnace/chloe-tags/chloe-tags.factor +++ b/basis/furnace/chloe-tags/chloe-tags.factor @@ -32,7 +32,7 @@ IN: furnace.chloe-tags [ [ "/" ?tail drop "/" ] dip present 3append ] when* ; : a-url ( href rest query value-name -- url ) - dup [ >r 3drop r> value ] [ + dup [ [ 3drop ] dip value ] [ drop swap parse-query-attr >>query diff --git a/basis/grouping/grouping-docs.factor b/basis/grouping/grouping-docs.factor index 3b3a98eabd..e68c0ede1a 100644 --- a/basis/grouping/grouping-docs.factor +++ b/basis/grouping/grouping-docs.factor @@ -20,7 +20,7 @@ ARTICLE: "grouping" "Groups and clumps" { $unchecked-example "dup n groups concat sequence= ." "t" } } { "With clumps, collecting the first element of each subsequence but the last one, together with the last subseqence, yields the original sequence:" - { $unchecked-example "dup n clumps unclip-last >r [ first ] map r> append sequence= ." "t" } + { $unchecked-example "dup n clumps unclip-last [ [ first ] map ] dip append sequence= ." "t" } } } ; diff --git a/basis/heaps/heaps-tests.factor b/basis/heaps/heaps-tests.factor index e28eb3007a..8fa6a274e7 100644 --- a/basis/heaps/heaps-tests.factor +++ b/basis/heaps/heaps-tests.factor @@ -61,7 +61,7 @@ IN: heaps.tests random-alist [ heap-push-all ] keep dup data>> clone swap - ] keep 3 /i [ 2dup >r delete-random r> heap-delete ] times + ] keep 3 /i [ 2dup [ delete-random ] dip heap-delete ] times data>> [ [ key>> ] map ] bi@ [ natural-sort ] bi@ ; diff --git a/basis/lcs/lcs.factor b/basis/lcs/lcs.factor index 759e923a34..8c67590697 100644 --- a/basis/lcs/lcs.factor +++ b/basis/lcs/lcs.factor @@ -5,7 +5,7 @@ IN: lcs r [ 1+ ] bi@ r> min min ; + 0 1 ? + [ [ 1+ ] bi@ ] dip min min ; : lcs-step ( insert delete change same? -- next ) 1 -1./0. ? + max max ; ! -1./0. is -inf (float) diff --git a/basis/locals/rewrite/point-free/point-free.factor b/basis/locals/rewrite/point-free/point-free.factor index bd322bfff3..33e0f4d3b3 100644 --- a/basis/locals/rewrite/point-free/point-free.factor +++ b/basis/locals/rewrite/point-free/point-free.factor @@ -30,7 +30,10 @@ M: local-writer localize read-local-quot [ set-local-value ] append ; M: def localize - local>> [ prefix ] [ local-reader? [ 1array >r ] [ >r ] ? ] bi ; + local>> + [ prefix ] + [ local-reader? [ 1array load-local ] [ load-local ] ? ] + bi ; M: object localize 1quotation ; diff --git a/basis/locals/rewrite/sugar/sugar.factor b/basis/locals/rewrite/sugar/sugar.factor index 05b1e2345e..835fa6e421 100644 --- a/basis/locals/rewrite/sugar/sugar.factor +++ b/basis/locals/rewrite/sugar/sugar.factor @@ -101,7 +101,7 @@ M: hashtable rewrite-sugar* rewrite-element ; M: wrapper rewrite-sugar* rewrite-element ; M: word rewrite-sugar* - dup { >r r> load-locals get-local drop-locals } memq? + dup { load-locals get-local drop-locals } memq? [ >r/r>-in-lambda-error ] [ call-next-method ] if ; M: object rewrite-sugar* , ; diff --git a/basis/match/match.factor b/basis/match/match.factor index 7d393dadc9..fee06686b8 100644 --- a/basis/match/match.factor +++ b/basis/match/match.factor @@ -47,7 +47,7 @@ MACRO: match-cond ( assoc -- ) [ "Fall-through in match-cond" throw ] [ first2 - >r [ dupd match ] curry r> + [ [ dupd match ] curry ] dip [ bind ] curry rot [ ?if ] 2curry append ] reduce ; diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor index a06a67e4a1..cf0ce5f0bb 100644 --- a/basis/math/functions/functions-tests.factor +++ b/basis/math/functions/functions-tests.factor @@ -97,7 +97,7 @@ IN: math.functions.tests : verify-gcd ( a b -- ? ) 2dup gcd - >r rot * swap rem r> = ; + [ rot * swap rem ] dip = ; [ t ] [ 123 124 verify-gcd ] unit-test [ t ] [ 50 120 verify-gcd ] unit-test diff --git a/basis/math/intervals/intervals-tests.factor b/basis/math/intervals/intervals-tests.factor index 8c29171a57..378ca2fb4b 100644 --- a/basis/math/intervals/intervals-tests.factor +++ b/basis/math/intervals/intervals-tests.factor @@ -255,8 +255,7 @@ IN: math.intervals.tests 0 pick interval-contains? over first \ recip eq? and [ 2drop t ] [ - [ >r random-element ! dup . - r> first execute ] 2keep + [ [ random-element ] dip first execute ] 2keep second execute interval-contains? ] if ; @@ -287,8 +286,7 @@ IN: math.intervals.tests 0 pick interval-contains? over first { / /i mod rem } member? and [ 3drop t ] [ - [ >r [ random-element ] bi@ ! 2dup . . - r> first execute ] 3keep + [ [ [ random-element ] bi@ ] dip first execute ] 3keep second execute interval-contains? ] if ; @@ -304,7 +302,7 @@ IN: math.intervals.tests : comparison-test ( -- ? ) random-interval random-interval random-comparison - [ >r [ random-element ] bi@ r> first execute ] 3keep + [ [ [ random-element ] bi@ ] dip first execute ] 3keep second execute dup incomparable eq? [ 2drop t ] [ = ] if ; [ t ] [ 40000 [ drop comparison-test ] all? ] unit-test diff --git a/basis/opengl/shaders/shaders.factor b/basis/opengl/shaders/shaders.factor index 5b63b63afe..eb5bbb0ee8 100755 --- a/basis/opengl/shaders/shaders.factor +++ b/basis/opengl/shaders/shaders.factor @@ -115,7 +115,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ; PREDICATE: gl-program < integer (gl-program?) ; : ( vertex-shader-source fragment-shader-source -- program ) - >r check-gl-shader - r> check-gl-shader + [ check-gl-shader ] + [ check-gl-shader ] bi* 2array check-gl-program ; diff --git a/basis/persistent/deques/deques.factor b/basis/persistent/deques/deques.factor index 657f7ce56a..be63d807b9 100644 --- a/basis/persistent/deques/deques.factor +++ b/basis/persistent/deques/deques.factor @@ -14,7 +14,7 @@ C: cons : each ( list quot: ( elt -- ) -- ) over - [ [ >r car>> r> call ] [ >r cdr>> r> ] 2bi each ] + [ [ [ car>> ] dip call ] [ [ cdr>> ] dip ] 2bi each ] [ 2drop ] if ; inline recursive : reduce ( list start quot -- end ) @@ -27,7 +27,7 @@ C: cons 0 [ drop 1+ ] reduce ; : cut ( list index -- back front-reversed ) - f swap [ >r [ cdr>> ] [ car>> ] bi r> ] times ; + f swap [ [ [ cdr>> ] [ car>> ] bi ] dip ] times ; : split-reverse ( list -- back-reversed front ) dup length 2/ cut [ reverse ] bi@ ; @@ -41,7 +41,7 @@ TUPLE: deque { front read-only } { back read-only } ; [ back>> ] [ front>> ] bi deque boa ; : flipped ( deque quot -- newdeque ) - >r flip r> call flip ; + [ flip ] dip call flip ; PRIVATE> : deque-empty? ( deque -- ? ) diff --git a/basis/persistent/heaps/heaps.factor b/basis/persistent/heaps/heaps.factor index 6381b91dc3..f6d38b5b25 100644 --- a/basis/persistent/heaps/heaps.factor +++ b/basis/persistent/heaps/heaps.factor @@ -32,7 +32,7 @@ PRIVATE> [ >branch< swap remove-left -rot [ ] 2dip rot ] if ; : both-with? ( obj a b quot -- ? ) - swap >r with r> swap both? ; inline + swap [ with ] dip swap both? ; inline GENERIC: sift-down ( value prio left right -- heap ) diff --git a/basis/serialize/serialize.factor b/basis/serialize/serialize.factor index f062548482..3ec1e96c72 100644 --- a/basis/serialize/serialize.factor +++ b/basis/serialize/serialize.factor @@ -70,9 +70,10 @@ M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ; } cond ; : serialize-shared ( obj quot -- ) - >r dup object-id - [ CHAR: o write1 serialize-cell drop ] - r> if* ; inline + [ + dup object-id + [ CHAR: o write1 serialize-cell drop ] + ] dip if* ; inline M: f (serialize) ( obj -- ) drop CHAR: n write1 ; @@ -256,7 +257,7 @@ SYMBOL: deserialized [ ] tri ; : copy-seq-to-tuple ( seq tuple -- ) - >r dup length r> [ set-array-nth ] curry 2each ; + [ dup length ] dip [ set-array-nth ] curry 2each ; : deserialize-tuple ( -- array ) #! Ugly because we have to intern the tuple before reading diff --git a/basis/stack-checker/errors/errors-docs.factor b/basis/stack-checker/errors/errors-docs.factor index d4a074031d..c3b9797a36 100644 --- a/basis/stack-checker/errors/errors-docs.factor +++ b/basis/stack-checker/errors/errors-docs.factor @@ -28,22 +28,10 @@ $nl } ; HELP: too-many->r -{ $error-description "Thrown if inference notices a quotation pushing elements on the retain stack without popping them at the end." } -{ $examples - { $code - ": too-many->r-example ( a b -- )" - " >r 3 + >r ;" - } -} ; +{ $error-description "Thrown if inference notices a quotation pushing elements on the retain stack without popping them at the end." } ; HELP: too-many-r> -{ $error-description "Thrown if inference notices a quotation popping elements from the return stack it did not place there." } -{ $examples - { $code - ": too-many-r>-example ( a b -- )" - " r> 3 + >r ;" - } -} ; +{ $error-description "Thrown if inference notices a quotation popping elements from the return stack it did not place there." } ; HELP: missing-effect { $error-description "Thrown when inference encounters a word lacking a stack effect declaration. Stack effects of words must be declared, with the exception of words which only push literals on the stack." } diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index bce42f1456..62d2b5036c 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -174,8 +174,6 @@ M: object infer-call* : infer-special ( word -- ) { - { \ >r [ 1 infer->r ] } - { \ r> [ 1 infer-r> ] } { \ declare [ infer-declare ] } { \ call [ infer-call ] } { \ (call) [ infer-call ] } @@ -213,7 +211,7 @@ M: object infer-call* "local-word-def" word-prop infer-quot-here ; { - >r r> declare call (call) slip 2slip 3slip dip 2dip 3dip + declare call (call) slip 2slip 3slip dip 2dip 3dip curry compose execute (execute) if dispatch (throw) load-locals get-local drop-locals do-primitive alien-invoke alien-indirect alien-callback diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index defcde53f0..8dd07b9619 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -218,7 +218,7 @@ DEFER: do-crap* MATH: xyz ( a b -- c ) M: fixnum xyz 2array ; M: float xyz - [ 3 ] bi@ swapd >r 2array swap r> 2array swap ; + [ 3 ] bi@ swapd [ 2array swap ] dip 2array swap ; [ [ xyz ] infer ] [ inference-error? ] must-fail-with @@ -480,7 +480,7 @@ DEFER: an-inline-word dup [ normal-word-2 ] when ; : an-inline-word ( obj quot -- ) - >r normal-word r> call ; inline + [ normal-word ] dip call ; inline { 1 1 } [ [ 3 * ] an-inline-word ] must-infer-as @@ -503,7 +503,7 @@ ERROR: custom-error ; ] unit-test [ T{ effect f 1 1 t } ] [ - [ dup >r 3 throw r> ] infer + [ dup [ 3 throw ] dip ] infer ] unit-test ! This was a false trigger of the undecidable quotation @@ -511,7 +511,7 @@ ERROR: custom-error ; { 2 1 } [ find-last-sep ] must-infer-as ! Regression -: missing->r-check >r ; +: missing->r-check 1 load-locals ; [ [ missing->r-check ] infer ] must-fail @@ -548,7 +548,7 @@ M: object inference-invalidation-d inference-invalidation-c 2drop ; [ [ inference-invalidation-d ] infer ] must-fail -: bad-recursion-3 ( -- ) dup [ >r bad-recursion-3 r> ] when ; inline +: bad-recursion-3 ( -- ) dup [ [ bad-recursion-3 ] dip ] when ; inline [ [ bad-recursion-3 ] infer ] must-fail : bad-recursion-4 ( -- ) 4 [ dup call roll ] times ; inline @@ -572,7 +572,7 @@ M: object inference-invalidation-d inference-invalidation-c 2drop ; DEFER: eee' : ddd' ( ? -- ) [ f eee' ] when ; inline recursive -: eee' ( ? -- ) >r swap [ ] r> ddd' call ; inline recursive +: eee' ( ? -- ) [ swap [ ] ] dip ddd' call ; inline recursive [ [ eee' ] infer ] [ inference-error? ] must-fail-with diff --git a/basis/tuple-arrays/tuple-arrays.factor b/basis/tuple-arrays/tuple-arrays.factor index 5da7085773..af62c0b0d7 100644 --- a/basis/tuple-arrays/tuple-arrays.factor +++ b/basis/tuple-arrays/tuple-arrays.factor @@ -16,7 +16,7 @@ M: tuple-array nth [ seq>> nth ] [ class>> ] bi prefix >tuple ; M: tuple-array set-nth ( elt n seq -- ) - >r >r tuple>array 1 tail r> r> seq>> set-nth ; + [ tuple>array 1 tail ] 2dip seq>> set-nth ; M: tuple-array new-sequence class>> ; diff --git a/basis/validators/validators.factor b/basis/validators/validators.factor index 7c41d3efdb..78e01fdaf7 100644 --- a/basis/validators/validators.factor +++ b/basis/validators/validators.factor @@ -51,7 +51,7 @@ IN: validators ] if ; : v-regexp ( str what regexp -- str ) - >r over r> matches? + [ over ] dip matches? [ drop ] [ "invalid " prepend throw ] if ; : v-email ( str -- str ) diff --git a/basis/windows/dragdrop-listener/dragdrop-listener.factor b/basis/windows/dragdrop-listener/dragdrop-listener.factor index 8384bb1acc..4543aa703a 100644 --- a/basis/windows/dragdrop-listener/dragdrop-listener.factor +++ b/basis/windows/dragdrop-listener/dragdrop-listener.factor @@ -36,26 +36,30 @@ SYMBOL: +listener-dragdrop-wrapper+ { { "IDropTarget" { [ ! DragEnter - >r 2drop - filenames-from-data-object - length 1 = [ DROPEFFECT_COPY ] [ DROPEFFECT_NONE ] if - dup 0 r> set-ulong-nth + [ + 2drop + filenames-from-data-object + length 1 = [ DROPEFFECT_COPY ] [ DROPEFFECT_NONE ] if + dup 0 + ] dip set-ulong-nth >>last-drop-effect drop S_OK ] [ ! DragOver - >r 2drop last-drop-effect>> 0 r> set-ulong-nth + [ 2drop last-drop-effect>> 0 ] dip set-ulong-nth S_OK ] [ ! DragLeave drop S_OK ] [ ! Drop - >r 2drop nip - filenames-from-data-object - dup length 1 = [ - first unparse [ "USE: parser " % % " run-file" % ] "" make - eval-listener - DROPEFFECT_COPY - ] [ 2drop DROPEFFECT_NONE ] if - 0 r> set-ulong-nth + [ + 2drop nip + filenames-from-data-object + dup length 1 = [ + first unparse [ "USE: parser " % % " run-file" % ] "" make + eval-listener + DROPEFFECT_COPY + ] [ 2drop DROPEFFECT_NONE ] if + 0 + ] dip set-ulong-nth S_OK ] } } diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index 7fd90acbe8..c38b5f94ca 100755 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -987,8 +987,6 @@ FUNCTION: DWORD GetFileType ( HANDLE hFile ) ; FUNCTION: DWORD GetFullPathNameW ( LPCTSTR lpFileName, DWORD nBufferLength, LPTSTR lpBuffer, LPTSTR* lpFilePart ) ; ALIAS: GetFullPathName GetFullPathNameW -! clear "license.txt" 32768 "char[32768]" f over >r GetFullPathName r> swap 2 * head >string . - ! FUNCTION: GetGeoInfoA ! FUNCTION: GetGeoInfoW ! FUNCTION: GetHandleContext diff --git a/basis/xml-rpc/example.factor b/basis/xml-rpc/example.factor index 836a85d52d..e2be36c450 100644 --- a/basis/xml-rpc/example.factor +++ b/basis/xml-rpc/example.factor @@ -10,7 +10,7 @@ USING: kernel hashtables xml-rpc xml calendar sequences { "divide" [ / ] } } ; : apply-function ( name args -- {number} ) - >r functions hash r> first2 rot call 1array ; + [ functions hash ] dip first2 rot call 1array ; : problem>solution ( xml-doc -- xml-doc ) receive-rpc dup rpc-method-name swap rpc-method-params diff --git a/basis/xml-rpc/xml-rpc.factor b/basis/xml-rpc/xml-rpc.factor index 9472f5e09d..602fb90172 100644 --- a/basis/xml-rpc/xml-rpc.factor +++ b/basis/xml-rpc/xml-rpc.factor @@ -55,7 +55,7 @@ M: base64 item>xml "params" build-tag* ; : method-call ( name seq -- xml ) - params >r "methodName" build-tag r> + params [ "methodName" build-tag ] dip 2array "methodCall" build-tag* build-xml ; : return-params ( seq -- xml ) @@ -117,7 +117,7 @@ TAG: boolean xml>item : unstruct-member ( tag -- ) children-tags first2 first-child-tag xml>item - >r children>string r> swap set ; + [ children>string ] dip swap set ; TAG: struct xml>item [ @@ -158,10 +158,10 @@ TAG: array xml>item : post-rpc ( rpc url -- rpc ) ! This needs to do something in the event of an error - >r send-rpc r> http-post nip string>xml receive-rpc ; + [ send-rpc ] dip http-post nip string>xml receive-rpc ; : invoke-method ( params method url -- ) - >r swap r> post-rpc ; + [ swap ] dip post-rpc ; : put-http-response ( string -- ) "HTTP/1.1 200 OK\nConnection: close\nContent-Length: " write diff --git a/basis/xmode/catalog/catalog.factor b/basis/xmode/catalog/catalog.factor index 16da4be1d3..f8f1788bcf 100644 --- a/basis/xmode/catalog/catalog.factor +++ b/basis/xmode/catalog/catalog.factor @@ -8,12 +8,13 @@ TUPLE: mode file file-name-glob first-line-glob ; r - mode new { - { "FILE" f (>>file) } - { "FILE_NAME_GLOB" f (>>file-name-glob) } - { "FIRST_LINE_GLOB" f (>>first-line-glob) } - } init-from-tag r> + "NAME" over at [ + mode new { + { "FILE" f (>>file) } + { "FILE_NAME_GLOB" f (>>file-name-glob) } + { "FIRST_LINE_GLOB" f (>>first-line-glob) } + } init-from-tag + ] dip rot set-at ; TAGS> @@ -56,7 +57,7 @@ SYMBOL: rule-sets [ get-rule-set nip swap (>>delegate) ] [ 2drop ] if ; : each-rule ( rule-set quot -- ) - >r rules>> values concat r> each ; inline + [ rules>> values concat ] dip each ; inline : resolve-delegates ( ruleset -- ) [ resolve-delegate ] each-rule ; @@ -65,8 +66,7 @@ SYMBOL: rule-sets over [ dupd update ] [ nip clone ] if ; : import-keywords ( parent child -- ) - over >r [ keywords>> ] bi@ ?update - r> (>>keywords) ; + over [ [ keywords>> ] bi@ ?update ] dip (>>keywords) ; : import-rules ( parent child -- ) swap [ add-rule ] curry each-rule ; @@ -115,5 +115,5 @@ ERROR: mutually-recursive-rulesets ruleset ; : find-mode ( file-name first-line -- mode ) modes - [ nip >r 2dup r> suitable-mode? ] assoc-find - 2drop >r 2drop r> [ "text" ] unless* ; + [ nip [ 2dup ] dip suitable-mode? ] assoc-find + 2drop [ 2drop ] dip [ "text" ] unless* ; diff --git a/basis/xmode/loader/syntax/syntax.factor b/basis/xmode/loader/syntax/syntax.factor index cbebe090c3..9b53000e02 100644 --- a/basis/xmode/loader/syntax/syntax.factor +++ b/basis/xmode/loader/syntax/syntax.factor @@ -101,4 +101,4 @@ TAGS> : init-eol-span-tag ( -- ) [ drop init-eol-span ] , ; : parse-keyword-tag ( tag keyword-map -- ) - >r dup main>> string>token swap children>string r> set-at ; + [ dup main>> string>token swap children>string ] dip set-at ; diff --git a/basis/xmode/marker/marker.factor b/basis/xmode/marker/marker.factor index f777eaa18c..c37d60df14 100644 --- a/basis/xmode/marker/marker.factor +++ b/basis/xmode/marker/marker.factor @@ -69,7 +69,7 @@ M: string-matcher text-matches? ] keep string>> length and ; M: regexp text-matches? - >r >string r> match-head ; + [ >string ] dip match-head ; : rule-start-matches? ( rule -- match-count/f ) dup start>> tuck swap can-match-here? [ @@ -97,7 +97,7 @@ DEFER: get-rules f swap rules>> at ?push-all ; : get-char-rules ( vector/f char ruleset -- vector/f ) - >r ch>upper r> rules>> at ?push-all ; + [ ch>upper ] dip rules>> at ?push-all ; : get-rules ( char ruleset -- seq ) f -rot [ get-char-rules ] keep get-always-rules ; diff --git a/basis/xmode/marker/state/state.factor b/basis/xmode/marker/state/state.factor index 7b28bcfcdf..44d3a0285e 100644 --- a/basis/xmode/marker/state/state.factor +++ b/basis/xmode/marker/state/state.factor @@ -20,14 +20,14 @@ SYMBOLS: line last-offset position context current-rule-set keywords>> ; : token, ( from to id -- ) - 2over = [ 3drop ] [ >r line get subseq r> , ] if ; + 2over = [ 3drop ] [ [ line get subseq ] dip , ] if ; : prev-token, ( id -- ) - >r last-offset get position get r> token, + [ last-offset get position get ] dip token, position get last-offset set ; : next-token, ( len id -- ) - >r position get 2dup + r> token, + [ position get 2dup + ] dip token, position get + dup 1- position set last-offset set ; : push-context ( rules -- ) diff --git a/basis/xmode/rules/rules.factor b/basis/xmode/rules/rules.factor index e4f12bcc49..adc43d7bb6 100644 --- a/basis/xmode/rules/rules.factor +++ b/basis/xmode/rules/rules.factor @@ -41,7 +41,7 @@ MEMO: standard-rule-set ( id -- ruleset ) : ?push-all ( seq1 seq2 -- seq1+seq2 ) [ - over [ >r V{ } like r> over push-all ] [ nip ] if + over [ [ V{ } like ] dip over push-all ] [ nip ] if ] when* ; : rule-set-no-word-sep* ( ruleset -- str ) @@ -107,8 +107,7 @@ M: regexp text-hash-char drop f ; text-hash-char [ suffix ] when* ; : add-rule ( rule ruleset -- ) - >r dup rule-chars* >upper swap - r> rules>> inverted-index ; + [ dup rule-chars* >upper swap ] dip rules>> inverted-index ; : add-escape-rule ( string ruleset -- ) over [ diff --git a/basis/xmode/utilities/utilities.factor b/basis/xmode/utilities/utilities.factor index 69fc08742b..b5a2f6eb98 100644 --- a/basis/xmode/utilities/utilities.factor +++ b/basis/xmode/utilities/utilities.factor @@ -53,5 +53,5 @@ SYMBOL: tag-handler-word : TAGS> tag-handler-word get - tag-handlers get >alist [ >r dup main>> r> case ] curry + tag-handlers get >alist [ [ dup main>> ] dip case ] curry define ; parsing diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index b3c3cb88e4..61d178ccf8 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -380,12 +380,11 @@ tuple { "over" "kernel" } { "pick" "kernel" } { "swap" "kernel" } - { ">r" "kernel" } - { "r>" "kernel" } { "eq?" "kernel" } { "tag" "kernel.private" } { "slot" "slots.private" } { "get-local" "locals.backend" } + { "load-local" "locals.backend" } { "drop-locals" "locals.backend" } } [ make-sub-primitive ] assoc-each