diff --git a/core/alien/alien.factor b/core/alien/alien.factor index d0adec1fcf..cfa9fb2e16 100755 --- a/core/alien/alien.factor +++ b/core/alien/alien.factor @@ -39,7 +39,7 @@ M: alien equal? 2dup [ expired? ] either? [ [ expired? ] both? ] [ - [ alien-address ] 2apply = + [ alien-address ] bi@ = ] if ] [ 2drop f diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 196ec614b7..b911faf672 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -115,7 +115,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) swap [ swapd set-at ] curry assoc-each ; : union ( assoc1 assoc2 -- union ) - 2dup [ assoc-size ] 2apply + pick new-assoc + 2dup [ assoc-size ] bi@ + pick new-assoc [ rot update ] keep [ swap update ] keep ; : diff ( assoc1 assoc2 -- diff ) diff --git a/core/bit-arrays/bit-arrays-tests.factor b/core/bit-arrays/bit-arrays-tests.factor index 5774b86e45..e28c16c3c2 100755 --- a/core/bit-arrays/bit-arrays-tests.factor +++ b/core/bit-arrays/bit-arrays-tests.factor @@ -21,7 +21,7 @@ IN: bit-arrays.tests { t f t } { f t f } ] [ { t f t } >bit-array dup clone dup [ not ] change-each - [ >array ] 2apply + [ >array ] bi@ ] unit-test [ diff --git a/core/bootstrap/stage2.factor b/core/bootstrap/stage2.factor index f472e0158f..bbb2e44843 100755 --- a/core/bootstrap/stage2.factor +++ b/core/bootstrap/stage2.factor @@ -23,7 +23,7 @@ SYMBOL: bootstrap-time : load-components ( -- ) "exclude" "include" - [ get-global " " split [ empty? not ] subset ] 2apply + [ get-global " " split [ empty? not ] subset ] bi@ seq-diff [ "bootstrap." prepend require ] each ; diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index e2206213a6..2945bd2546 100755 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -67,7 +67,7 @@ C: anonymous-complement members>> [ class< ] with all? ; : anonymous-complement< ( first second -- ? ) - [ class>> ] 2apply swap class< ; + [ class>> ] bi@ swap class< ; : (class<) ( first second -- -1/0/1 ) { diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index 85a6fb241d..eb6b3bd6e2 100755 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -47,8 +47,8 @@ TUPLE: mixin-instance loc class mixin ; M: mixin-instance equal? { { [ over mixin-instance? not ] [ f ] } - { [ 2dup [ mixin-instance-class ] 2apply = not ] [ f ] } - { [ 2dup [ mixin-instance-mixin ] 2apply = not ] [ f ] } + { [ 2dup [ mixin-instance-class ] bi@ = not ] [ f ] } + { [ 2dup [ mixin-instance-mixin ] bi@ = not ] [ f ] } { [ t ] [ t ] } } cond 2nip ; diff --git a/core/compiler/tests/curry.factor b/core/compiler/tests/curry.factor index d2e7115f8f..61d20fd8ab 100755 --- a/core/compiler/tests/curry.factor +++ b/core/compiler/tests/curry.factor @@ -10,7 +10,7 @@ IN: compiler.tests [ 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 -[ -10 -20 ] [ 10 20 -1 [ [ * ] curry 2apply ] compile-call ] unit-test +[ -10 -20 ] [ 10 20 -1 [ [ * ] curry bi@ ] compile-call ] unit-test [ [ 5 2 - ] ] [ 5 [ [ 2 - ] curry ] compile-call >quotation ] unit-test [ [ 5 2 - ] ] [ [ 5 [ 2 - ] curry ] compile-call >quotation ] unit-test diff --git a/core/compiler/tests/templates.factor b/core/compiler/tests/templates.factor index 8a33d57fe7..081a8fd47c 100755 --- a/core/compiler/tests/templates.factor +++ b/core/compiler/tests/templates.factor @@ -72,13 +72,13 @@ unit-test ] unit-test [ 12 13 ] [ - -12 -13 [ [ 0 swap fixnum-fast ] 2apply ] compile-call + -12 -13 [ [ 0 swap fixnum-fast ] bi@ ] compile-call ] unit-test [ -1 2 ] [ 1 2 [ >r 0 swap fixnum- r> ] compile-call ] unit-test [ 12 13 ] [ - -12 -13 [ [ 0 swap fixnum- ] 2apply ] compile-call + -12 -13 [ [ 0 swap fixnum- ] bi@ ] compile-call ] unit-test [ 1 ] [ diff --git a/core/cpu/arm/architecture/architecture.factor b/core/cpu/arm/architecture/architecture.factor index 8742a693cb..563dd10bc4 100755 --- a/core/cpu/arm/architecture/architecture.factor +++ b/core/cpu/arm/architecture/architecture.factor @@ -63,7 +63,7 @@ M: arm-backend load-indirect ( obj reg -- ) M: immediate load-literal over v>operand small-enough? [ - [ v>operand ] 2apply swap MOV + [ v>operand ] bi@ swap MOV ] [ v>operand load-indirect ] if ; @@ -322,10 +322,10 @@ M: arm-backend fp-shadows-int? ( -- ? ) f ; ! Alien intrinsics M: arm-backend %unbox-byte-array ( dst src -- ) - [ v>operand ] 2apply byte-array-offset ADD ; + [ v>operand ] bi@ byte-array-offset ADD ; M: arm-backend %unbox-alien ( dst src -- ) - [ v>operand ] 2apply alien-offset <+> LDR ; + [ v>operand ] bi@ alien-offset <+> LDR ; M: arm-backend %unbox-f ( dst src -- ) drop v>operand 0 MOV ; diff --git a/core/cpu/ppc/allot/allot.factor b/core/cpu/ppc/allot/allot.factor index df0a08a86d..6c37fce4f1 100755 --- a/core/cpu/ppc/allot/allot.factor +++ b/core/cpu/ppc/allot/allot.factor @@ -33,7 +33,7 @@ IN: cpu.ppc.allot f fresh-object ; M: ppc-backend %box-float ( dst src -- ) - [ v>operand ] 2apply %allot-float 12 MR ; + [ v>operand ] bi@ %allot-float 12 MR ; : %allot-bignum ( #digits -- ) #! 1 cell header, 1 cell length, 1 cell sign, + digits diff --git a/core/cpu/ppc/architecture/architecture.factor b/core/cpu/ppc/architecture/architecture.factor index 1daf3ac622..903ac32df9 100755 --- a/core/cpu/ppc/architecture/architecture.factor +++ b/core/cpu/ppc/architecture/architecture.factor @@ -71,7 +71,7 @@ M: ds-loc loc>operand ds-loc-n cells neg ds-reg swap ; M: rs-loc loc>operand rs-loc-n cells neg rs-reg swap ; M: immediate load-literal - [ v>operand ] 2apply LOAD ; + [ v>operand ] bi@ LOAD ; M: ppc-backend load-indirect ( obj reg -- ) [ 0 swap LOAD32 rc-absolute-ppc-2/2 rel-literal ] keep @@ -138,7 +138,7 @@ M: ppc-backend %replace >r v>operand r> loc>operand STW ; M: ppc-backend %unbox-float ( dst src -- ) - [ v>operand ] 2apply float-offset LFD ; + [ v>operand ] bi@ float-offset LFD ; M: ppc-backend %inc-d ( n -- ) ds-reg dup rot cells ADDI ; @@ -291,10 +291,10 @@ M: ppc-backend %unbox-small-struct ! Alien intrinsics M: ppc-backend %unbox-byte-array ( dst src -- ) - [ v>operand ] 2apply byte-array-offset ADDI ; + [ v>operand ] bi@ byte-array-offset ADDI ; M: ppc-backend %unbox-alien ( dst src -- ) - [ v>operand ] 2apply alien-offset LWZ ; + [ v>operand ] bi@ alien-offset LWZ ; M: ppc-backend %unbox-f ( dst src -- ) drop 0 swap v>operand LI ; diff --git a/core/cpu/x86/allot/allot.factor b/core/cpu/x86/allot/allot.factor index f837a92504..5519a9a8d5 100755 --- a/core/cpu/x86/allot/allot.factor +++ b/core/cpu/x86/allot/allot.factor @@ -101,6 +101,6 @@ M: x86-backend %box-alien ( dst src -- ) ] %allot "end" get JMP "f" resolve-label - f [ v>operand ] 2apply MOV + f [ v>operand ] bi@ MOV "end" resolve-label ] with-scope ; diff --git a/core/cpu/x86/architecture/architecture.factor b/core/cpu/x86/architecture/architecture.factor index f993639c05..31fa4c8e4b 100755 --- a/core/cpu/x86/architecture/architecture.factor +++ b/core/cpu/x86/architecture/architecture.factor @@ -109,9 +109,9 @@ M: x86-backend %dispatch-label ( word -- ) 0 cell, rc-absolute-cell rel-word ; M: x86-backend %unbox-float ( dst src -- ) - [ v>operand ] 2apply float-offset [+] MOVSD ; + [ v>operand ] bi@ float-offset [+] MOVSD ; -M: x86-backend %peek [ v>operand ] 2apply MOV ; +M: x86-backend %peek [ v>operand ] bi@ MOV ; M: x86-backend %replace swap %peek ; @@ -162,10 +162,10 @@ M: x86-backend %return ( -- ) 0 %unwind ; ! Alien intrinsics M: x86-backend %unbox-byte-array ( dst src -- ) - [ v>operand ] 2apply byte-array-offset [+] LEA ; + [ v>operand ] bi@ byte-array-offset [+] LEA ; M: x86-backend %unbox-alien ( dst src -- ) - [ v>operand ] 2apply alien-offset [+] MOV ; + [ v>operand ] bi@ alien-offset [+] MOV ; M: x86-backend %unbox-f ( dst src -- ) drop v>operand 0 MOV ; diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor index a7937cdb9d..033ae0680c 100755 --- a/core/debugger/debugger.factor +++ b/core/debugger/debugger.factor @@ -82,7 +82,7 @@ ERROR: assert got expect ; : depth ( -- n ) datastack length ; : trim-datastacks ( seq1 seq2 -- seq1' seq2' ) - 2dup [ length ] 2apply min tuck tail >r tail r> ; + 2dup [ length ] bi@ min tuck tail >r tail r> ; ERROR: relative-underflow stack ; diff --git a/core/dlists/dlists-tests.factor b/core/dlists/dlists-tests.factor index 2bc0e6a3fb..28db6e1cbd 100755 --- a/core/dlists/dlists-tests.factor +++ b/core/dlists/dlists-tests.factor @@ -63,7 +63,7 @@ IN: dlists.tests [ 0 ] [ 1 over push-front dup pop-front* dlist-length ] unit-test : assert-same-elements - [ prune natural-sort ] 2apply assert= ; + [ prune natural-sort ] bi@ assert= ; : dlist-push-all [ push-front ] curry each ; diff --git a/core/effects/effects.factor b/core/effects/effects.factor index 23e8daf122..aed4a64c6c 100755 --- a/core/effects/effects.factor +++ b/core/effects/effects.factor @@ -18,8 +18,8 @@ TUPLE: effect in out terminated? ; { [ dup not ] [ t ] } { [ over effect-terminated? ] [ t ] } { [ dup effect-terminated? ] [ f ] } - { [ 2dup [ effect-in length ] 2apply > ] [ f ] } - { [ 2dup [ effect-height ] 2apply = not ] [ f ] } + { [ 2dup [ effect-in length ] bi@ > ] [ f ] } + { [ 2dup [ effect-height ] bi@ = not ] [ f ] } { [ t ] [ t ] } } cond 2nip ; diff --git a/core/generator/registers/registers.factor b/core/generator/registers/registers.factor index e03923e860..aac1b2cdc6 100755 --- a/core/generator/registers/registers.factor +++ b/core/generator/registers/registers.factor @@ -79,7 +79,7 @@ M: ds-loc minimal-ds-loc* ds-loc-n min ; M: ds-loc operand-class* ds-loc-class ; M: ds-loc set-operand-class set-ds-loc-class ; M: ds-loc live-loc? - over ds-loc? [ [ ds-loc-n ] 2apply = not ] [ 2drop t ] if ; + over ds-loc? [ [ ds-loc-n ] bi@ = not ] [ 2drop t ] if ; ! A retain stack location. TUPLE: rs-loc n class ; @@ -89,7 +89,7 @@ TUPLE: rs-loc n class ; M: rs-loc operand-class* rs-loc-class ; M: rs-loc set-operand-class set-rs-loc-class ; M: rs-loc live-loc? - over rs-loc? [ [ rs-loc-n ] 2apply = not ] [ 2drop t ] if ; + over rs-loc? [ [ rs-loc-n ] bi@ = not ] [ 2drop t ] if ; UNION: loc ds-loc rs-loc ; @@ -206,7 +206,7 @@ INSTANCE: constant value %move ; : %move ( dst src -- ) - 2dup [ move-spec ] 2apply 2array { + 2dup [ move-spec ] bi@ 2array { { { f f } [ %move-bug ] } { { f unboxed-c-ptr } [ %move-bug ] } { { f unboxed-byte-array } [ %move-bug ] } @@ -318,7 +318,7 @@ M: phantom-stack cut-phantom : phantoms ( -- phantom phantom ) phantom-d get phantom-r get ; -: each-phantom ( quot -- ) phantoms rot 2apply ; inline +: each-phantom ( quot -- ) phantoms rot bi@ ; inline : finalize-heights ( -- ) [ finalize-height ] each-phantom ; @@ -442,7 +442,7 @@ M: loc lazy-store : fast-shuffle? ( live-locs -- ? ) #! Test if we have enough free registers to load all #! shuffle inputs at once. - T{ int-regs } free-vregs [ length ] 2apply <= ; + T{ int-regs } free-vregs [ length ] bi@ <= ; : finalize-locs ( -- ) #! Perform any deferred stack shuffling. @@ -488,7 +488,7 @@ M: loc lazy-store : phantom&spec ( phantom spec -- phantom' spec' ) [ length f pad-left ] keep - [ ] 2apply ; inline + [ ] bi@ ; inline : phantom&spec-agree? ( phantom spec quot -- ? ) >r phantom&spec r> 2all? ; inline @@ -520,7 +520,7 @@ M: loc lazy-store swap lazy-load ; : output-vregs ( -- seq seq ) - +output+ +clobber+ [ get [ get ] map ] 2apply ; + +output+ +clobber+ [ get [ get ] map ] bi@ ; : clash? ( seq -- ? ) phantoms append [ diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor index 4527d2044d..5ac49ffa2f 100755 --- a/core/hashtables/hashtables.factor +++ b/core/hashtables/hashtables.factor @@ -156,7 +156,7 @@ M: hashtable clone M: hashtable equal? over hashtable? [ - 2dup [ assoc-size ] 2apply number= + 2dup [ assoc-size ] bi@ number= [ assoc= ] [ 2drop f ] if ] [ 2drop f ] if ; diff --git a/core/heaps/heaps-tests.factor b/core/heaps/heaps-tests.factor index 0b3123c87b..77560c7444 100755 --- a/core/heaps/heaps-tests.factor +++ b/core/heaps/heaps-tests.factor @@ -66,8 +66,8 @@ IN: heaps.tests dup heap-data clone swap ] keep 3 /i [ 2dup >r delete-random r> heap-delete ] times heap-data - [ [ entry-key ] map ] 2apply - [ natural-sort ] 2apply ; + [ [ entry-key ] map ] bi@ + [ natural-sort ] bi@ ; 11 [ [ t ] swap [ 2^ delete-test sequence= ] curry unit-test diff --git a/core/inference/class/class.factor b/core/inference/class/class.factor index 7764fd4fd1..ed36ca4890 100755 --- a/core/inference/class/class.factor +++ b/core/inference/class/class.factor @@ -26,8 +26,8 @@ C: literal-constraint M: literal-constraint equal? over literal-constraint? [ 2dup - [ literal-constraint-literal ] 2apply eql? >r - [ literal-constraint-value ] 2apply = r> and + [ literal-constraint-literal ] bi@ eql? >r + [ literal-constraint-value ] bi@ = r> and ] [ 2drop f ] if ; diff --git a/core/inference/inference-tests.factor b/core/inference/inference-tests.factor index 1cc1548a3d..84014512aa 100755 --- a/core/inference/inference-tests.factor +++ b/core/inference/inference-tests.factor @@ -224,7 +224,7 @@ DEFER: do-crap* MATH: xyz M: fixnum xyz 2array ; M: float xyz - [ 3 ] 2apply swapd >r 2array swap r> 2array swap ; + [ 3 ] bi@ swapd >r 2array swap r> 2array swap ; [ [ xyz ] infer ] [ inference-error? ] must-fail-with diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index b78f7667a6..9920d8d25c 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -117,7 +117,7 @@ io.encodings.utf8 ; [ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test -[ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] 2apply move-file ] unit-test +[ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] bi@ move-file ] unit-test [ t ] [ "quux-test.txt" temp-file exists? ] unit-test [ ] [ "quux-test.txt" temp-file delete-file ] unit-test diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index 0babb14fa7..457313724c 100755 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -60,8 +60,8 @@ $nl { $subsection keep } { $subsection 2keep } { $subsection 3keep } -{ $subsection 2apply } -"A pair of utility words built from " { $link 2apply } ":" +{ $subsection bi@ } +"A pair of utility words built from " { $link bi@ } ":" { $subsection both? } { $subsection either? } "A looping combinator:" @@ -376,7 +376,7 @@ HELP: 3keep { $values { "quot" "a quotation with stack effect " { $snippet "( x y z -- )" } } { "x" object } { "y" object } { "z" object } } { $description "Call a quotation with three values on the stack, restoring the values when the quotation returns." } ; -HELP: 2apply +HELP: bi@ { $values { "quot" "a quotation with stack effect " { $snippet "( obj -- )" } } { "x" object } { "y" object } } { $description "Applies the quotation to " { $snippet "x" } ", then to " { $snippet "y" } "." } ; diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index cbabeb6bfa..e2e0c0171a 100755 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -199,6 +199,3 @@ GENERIC: construct-boa ( ... class -- tuple ) : do-primitive ( number -- ) "Improper primitive call" throw ; PRIVATE> - -! Deprecated -: 2apply bi@ ; inline diff --git a/core/math/intervals/intervals-tests.factor b/core/math/intervals/intervals-tests.factor index 5a3fe777b6..f6317e7475 100755 --- a/core/math/intervals/intervals-tests.factor +++ b/core/math/intervals/intervals-tests.factor @@ -169,7 +169,7 @@ IN: math.intervals.tests : random-interval ( -- interval ) 1000 random dup 2 1000 random + + - 1 random zero? [ [ neg ] 2apply swap ] when + 1 random zero? [ [ neg ] bi@ swap ] when 4 random { { 0 [ [a,b] ] } { 1 [ [a,b) ] } @@ -197,7 +197,7 @@ IN: math.intervals.tests 0 pick interval-contains? over first { / /i } member? and [ 3drop t ] [ - [ >r [ random-element ] 2apply ! 2dup . . + [ >r [ random-element ] bi@ ! 2dup . . r> first execute ] 3keep second execute interval-contains? ] if ; @@ -214,7 +214,7 @@ IN: math.intervals.tests : comparison-test random-interval random-interval random-comparison - [ >r [ random-element ] 2apply r> first execute ] 3keep + [ >r [ random-element ] bi@ r> first execute ] 3keep second execute dup incomparable eq? [ 2drop t ] [ diff --git a/core/math/intervals/intervals.factor b/core/math/intervals/intervals.factor index d1c458065f..cc51060f63 100755 --- a/core/math/intervals/intervals.factor +++ b/core/math/intervals/intervals.factor @@ -67,7 +67,7 @@ C: interval : (interval-op) ( p1 p2 quot -- p3 ) 2over >r >r - >r [ first ] 2apply r> call + >r [ first ] bi@ r> call r> r> [ second ] both? 2array ; inline : interval-op ( i1 i2 quot -- i3 ) @@ -108,7 +108,7 @@ C: interval : interval-intersect ( i1 i2 -- i3 ) 2dup and [ - [ interval>points ] 2apply swapd + [ interval>points ] bi@ swapd [ swap endpoint> ] most >r [ swap endpoint< ] most r> make-interval @@ -118,7 +118,7 @@ C: interval : interval-union ( i1 i2 -- i3 ) 2dup and [ - [ interval>points 2array ] 2apply append points>interval + [ interval>points 2array ] bi@ append points>interval ] [ 2drop f ] if ; @@ -131,17 +131,17 @@ C: interval : interval-singleton? ( int -- ? ) interval>points - 2dup [ second ] 2apply and - [ [ first ] 2apply = ] + 2dup [ second ] bi@ and + [ [ first ] bi@ = ] [ 2drop f ] if ; : interval-length ( int -- n ) dup - [ interval>points [ first ] 2apply swap - ] + [ interval>points [ first ] bi@ swap - ] [ drop 0 ] if ; : interval-closure ( i1 -- i2 ) - dup [ interval>points [ first ] 2apply [a,b] ] when ; + dup [ interval>points [ first ] bi@ [a,b] ] when ; : interval-shift ( i1 i2 -- i3 ) #! Inaccurate; could be tighter @@ -163,7 +163,7 @@ C: interval [ min ] interval-op interval-closure ; : interval-interior ( i1 -- i2 ) - interval>points [ first ] 2apply (a,b) ; + interval>points [ first ] bi@ (a,b) ; : interval-division-op ( i1 i2 quot -- i3 ) >r 0 over interval-closure interval-contains? @@ -186,13 +186,13 @@ SYMBOL: incomparable : left-endpoint-< ( i1 i2 -- ? ) [ swap interval-subset? ] 2keep [ nip interval-singleton? ] 2keep - [ interval-from ] 2apply = + [ interval-from ] bi@ = and and ; : right-endpoint-< ( i1 i2 -- ? ) [ interval-subset? ] 2keep [ drop interval-singleton? ] 2keep - [ interval-to ] 2apply = + [ interval-to ] bi@ = and and ; : (interval<) over interval-from over interval-from endpoint< ; diff --git a/core/optimizer/def-use/def-use-tests.factor b/core/optimizer/def-use/def-use-tests.factor index d5e8e2d75d..f22cce9fa8 100755 --- a/core/optimizer/def-use/def-use-tests.factor +++ b/core/optimizer/def-use/def-use-tests.factor @@ -99,7 +99,7 @@ namespaces assocs kernel sequences math tools.test words ; ] unit-test : regression-2 ( x y -- x.y ) - [ p1 ] 2apply [ + [ p1 ] bi@ [ [ rot [ 2swap [ swapd * -rot p2 +@ ] 2keep ] diff --git a/core/optimizer/math/math.factor b/core/optimizer/math/math.factor index 349cf88f17..abe48ec272 100755 --- a/core/optimizer/math/math.factor +++ b/core/optimizer/math/math.factor @@ -113,7 +113,7 @@ generic.standard system ; : post-process ( class interval node -- classes intervals ) dupd won't-overflow? [ >r dup { f integer } member? [ drop fixnum ] when r> ] when - [ dup [ 1array ] when ] 2apply ; + [ dup [ 1array ] when ] bi@ ; : math-output-interval-1 ( node word -- interval ) dup [ @@ -147,7 +147,7 @@ generic.standard system ; ] each : intervals ( node -- i1 i2 ) - node-in-d first2 [ value-interval* ] 2apply ; + node-in-d first2 [ value-interval* ] bi@ ; : math-output-interval-2 ( node word -- interval ) dup [ diff --git a/core/parser/parser.factor b/core/parser/parser.factor index f8836217b5..36e5decd05 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -475,7 +475,7 @@ SYMBOL: interactive-vocabs : removed-definitions ( -- definitions ) new-definitions old-definitions - [ get first2 union ] 2apply diff ; + [ get first2 union ] bi@ diff ; : smudged-usage ( -- usages referenced removed ) removed-definitions filter-moved keys [ diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor index 6c557d873d..d294f95be6 100755 --- a/core/prettyprint/prettyprint.factor +++ b/core/prettyprint/prettyprint.factor @@ -114,7 +114,7 @@ SYMBOL: -> : remove-breakpoints ( quot pos -- quot' ) over quotation? [ - 1+ cut [ (remove-breakpoints) ] 2apply + 1+ cut [ (remove-breakpoints) ] bi@ [ -> ] swap 3append ] [ drop diff --git a/core/quotations/quotations.factor b/core/quotations/quotations.factor index 693e337959..c0f15a9388 100755 --- a/core/quotations/quotations.factor +++ b/core/quotations/quotations.factor @@ -12,7 +12,7 @@ M: curry call dup 3 slot swap 4 slot call ; M: compose call dup 3 slot swap 4 slot slip call ; M: wrapper equal? - over wrapper? [ [ wrapped ] 2apply = ] [ 2drop f ] if ; + over wrapper? [ [ wrapped ] bi@ = ] [ 2drop f ] if ; UNION: callable quotation curry compose ; diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index c545a9baee..3a30824084 100755 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -169,13 +169,13 @@ unit-test [ f ] [ { "a" "b" "c" } { "a" "b" "c" } mismatch ] unit-test -[ V{ } V{ } ] [ { "a" "b" } { "a" "b" } drop-prefix [ >vector ] 2apply ] unit-test +[ V{ } V{ } ] [ { "a" "b" } { "a" "b" } drop-prefix [ >vector ] bi@ ] unit-test -[ V{ "C" } V{ "c" } ] [ { "a" "b" "C" } { "a" "b" "c" } drop-prefix [ >vector ] 2apply ] unit-test +[ V{ "C" } V{ "c" } ] [ { "a" "b" "C" } { "a" "b" "c" } drop-prefix [ >vector ] bi@ ] unit-test [ -1 1 "abc" ] must-fail -[ V{ "a" "b" } V{ } ] [ { "X" "a" "b" } { "X" } drop-prefix [ >vector ] 2apply ] unit-test +[ V{ "a" "b" } V{ } ] [ { "X" "a" "b" } { "X" } drop-prefix [ >vector ] bi@ ] unit-test [ -1 ] [ "ab" "abc" <=> ] unit-test [ 1 ] [ "abc" "ab" <=> ] unit-test diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 111cf74ea2..1f2a6c5501 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -300,9 +300,9 @@ M: immutable-sequence clone-like like ; : change-nth ( i seq quot -- ) [ >r nth r> call ] 3keep drop set-nth ; inline -: min-length ( seq1 seq2 -- n ) [ length ] 2apply min ; inline +: min-length ( seq1 seq2 -- n ) [ length ] bi@ min ; inline -: max-length ( seq1 seq2 -- n ) [ length ] 2apply max ; inline +: max-length ( seq1 seq2 -- n ) [ length ] bi@ max ; inline (2each) each-integer ; inline : 2reverse-each ( seq1 seq2 quot -- ) - >r [ ] 2apply r> 2each ; inline + >r [ ] bi@ r> 2each ; inline : 2reduce ( seq1 seq2 identity quot -- result ) >r -rot r> 2each ; inline @@ -460,7 +460,7 @@ M: sequence <=> [ -rot 2nth-unsafe <=> ] [ [ length ] compare ] if* ; : sequence= ( seq1 seq2 -- ? ) - 2dup [ length ] 2apply number= + 2dup [ length ] bi@ number= [ mismatch not ] [ 2drop f ] if ; inline : move ( to from seq -- ) @@ -620,12 +620,12 @@ M: sequence <=> [ drop nip ] [ 2drop first ] [ >r drop first2 r> call ] - [ >r drop first3 r> 2apply ] + [ >r drop first3 r> bi@ ] } dispatch ] [ drop >r >r halves r> r> - [ [ binary-reduce ] 2curry 2apply ] keep + [ [ binary-reduce ] 2curry bi@ ] keep call ] if ; inline diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor index ab2ce21010..5f81b17187 100755 --- a/core/sorting/sorting.factor +++ b/core/sorting/sorting.factor @@ -32,7 +32,7 @@ DEFER: sort ] if ; inline : merge ( sorted1 sorted2 quot -- result ) - >r [ [ ] 2apply ] 2keep r> + >r [ [ ] bi@ ] 2keep r> rot length rot length + [ (merge) ] keep underlying ; inline diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor index 419a30dda4..9be1d5fc64 100755 --- a/core/splitting/splitting.factor +++ b/core/splitting/splitting.factor @@ -56,7 +56,7 @@ INSTANCE: groups sequence ] if ; : last-split1 ( seq subseq -- before after ) - [ ] 2apply split1 [ reverse ] 2apply + [ ] bi@ split1 [ reverse ] bi@ dup [ swap ] when ; : (split) ( separators n seq -- ) diff --git a/core/vectors/vectors-tests.factor b/core/vectors/vectors-tests.factor index d990f5f31c..18aa0f3fa7 100755 --- a/core/vectors/vectors-tests.factor +++ b/core/vectors/vectors-tests.factor @@ -77,7 +77,7 @@ IN: vectors.tests [ f ] [ V{ 1 2 3 4 } dup clone - [ underlying ] 2apply eq? + [ underlying ] bi@ eq? ] unit-test [ 0 ] [ diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor index f111b5bc74..886417b715 100755 --- a/core/vocabs/vocabs.factor +++ b/core/vocabs/vocabs.factor @@ -94,7 +94,7 @@ TUPLE: vocab-link name ; M: vocab-link equal? over vocab-link? - [ [ vocab-link-name ] 2apply = ] [ 2drop f ] if ; + [ [ vocab-link-name ] bi@ = ] [ 2drop f ] if ; M: vocab-link hashcode* vocab-link-name hashcode* ; diff --git a/extra/benchmark/raytracer/raytracer.factor b/extra/benchmark/raytracer/raytracer.factor index dbd1f5131b..3ec8cb4245 100755 --- a/extra/benchmark/raytracer/raytracer.factor +++ b/extra/benchmark/raytracer/raytracer.factor @@ -133,7 +133,7 @@ DEFER: create ( level c r -- scene ) pick 1 = [ nip ] [ create-group ] if ; : ss-point ( dx dy -- point ) - [ oversampling /f ] 2apply 0.0 3float-array ; + [ oversampling /f ] bi@ 0.0 3float-array ; : ss-grid ( -- ss-grid ) oversampling [ oversampling [ ss-point ] with map ] map ; @@ -150,7 +150,7 @@ DEFER: create ( level c r -- scene ) : pixel-grid ( -- grid ) size reverse [ size [ - [ size 0.5 * - ] 2apply swap size + [ size 0.5 * - ] bi@ swap size 3float-array ] with map ] map ; diff --git a/extra/benchmark/reverse-complement/reverse-complement-tests.factor b/extra/benchmark/reverse-complement/reverse-complement-tests.factor index c8d4714802..c66de87cb5 100755 --- a/extra/benchmark/reverse-complement/reverse-complement-tests.factor +++ b/extra/benchmark/reverse-complement/reverse-complement-tests.factor @@ -5,7 +5,7 @@ io.files kernel ; [ "c071aa7e007a9770b2fb4304f55a17e5" ] [ "extra/benchmark/reverse-complement/reverse-complement-test-in.txt" "extra/benchmark/reverse-complement/reverse-complement-test-out.txt" - [ resource-path ] 2apply + [ resource-path ] bi@ reverse-complement "extra/benchmark/reverse-complement/reverse-complement-test-out.txt" diff --git a/extra/benchmark/spectral-norm/spectral-norm.factor b/extra/benchmark/spectral-norm/spectral-norm.factor index 42bae7d0d1..7eddeefc1b 100644 --- a/extra/benchmark/spectral-norm/spectral-norm.factor +++ b/extra/benchmark/spectral-norm/spectral-norm.factor @@ -7,7 +7,7 @@ IN: benchmark.spectral-norm : fast-truncate >fixnum >float ; inline : eval-A ( i j -- n ) - [ >float ] 2apply + [ >float ] bi@ dupd + dup 1+ * 2 /f fast-truncate + 1+ recip ; inline diff --git a/extra/bitfields/bitfields.factor b/extra/bitfields/bitfields.factor index 175f66f4a6..114809377b 100644 --- a/extra/bitfields/bitfields.factor +++ b/extra/bitfields/bitfields.factor @@ -63,7 +63,7 @@ M: check< summary drop "Number exceeds upper bound" ; [ range>accessor ] map ; : clear-range ( range -- num ) - first2 dupd + [ 2^ 1- ] 2apply bitnot bitor ; + first2 dupd + [ 2^ 1- ] bi@ bitnot bitor ; : range>setter ( range -- quot ) [ diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor index efa7216699..4ea20629c1 100644 --- a/extra/boids/boids.factor +++ b/extra/boids/boids.factor @@ -80,7 +80,7 @@ VAR: separation-radius ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: relative-position ( self other -- v ) swap [ boid-pos ] 2apply v- ; +: relative-position ( self other -- v ) swap [ boid-pos ] bi@ v- ; : relative-angle ( self other -- angle ) over boid-vel -rot relative-position angle-between ; diff --git a/extra/builder/benchmark/benchmark.factor b/extra/builder/benchmark/benchmark.factor index 2f38462976..9e5e932831 100644 --- a/extra/builder/benchmark/benchmark.factor +++ b/extra/builder/benchmark/benchmark.factor @@ -19,11 +19,11 @@ IN: builder.benchmark 2array ; : compare-tables ( old new -- table ) - [ passing-benchmarks ] 2apply + [ passing-benchmarks ] bi@ [ benchmark-difference ] with map ; : benchmark-deltas ( -- table ) - "../benchmarks" "benchmarks" [ eval-file ] 2apply + "../benchmarks" "benchmarks" [ eval-file ] bi@ compare-tables sort-values ; diff --git a/extra/builder/util/util.factor b/extra/builder/util/util.factor index 55ff38d408..92b9af41ef 100644 --- a/extra/builder/util/util.factor +++ b/extra/builder/util/util.factor @@ -88,7 +88,7 @@ USING: bootstrap.image bootstrap.image.download io.streams.null ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: longer? ( seq seq -- ? ) [ length ] 2apply > ; +: longer? ( seq seq -- ? ) [ length ] bi@ > ; : maybe-tail* ( seq n -- seq ) 2dup longer? diff --git a/extra/calendar/calendar.factor b/extra/calendar/calendar.factor index 0a808f53bd..6c29c0d1ac 100755 --- a/extra/calendar/calendar.factor +++ b/extra/calendar/calendar.factor @@ -185,7 +185,7 @@ M: number +second ( timestamp n -- timestamp ) [ month>> +month ] keep [ year>> +year ] keep ; inline -: +slots [ 2apply + ] curry 2keep ; inline +: +slots [ bi@ + ] curry 2keep ; inline PRIVATE> @@ -244,9 +244,9 @@ M: timestamp <=> ( ts1 ts2 -- n ) [ >gmt tuple-slots ] compare ; : (time-) ( timestamp timestamp -- n ) - [ >gmt ] 2apply - [ [ >date< julian-day-number ] 2apply - 86400 * ] 2keep - [ >time< >r >r 3600 * r> 60 * r> + + ] 2apply - + ; + [ >gmt ] bi@ + [ [ >date< julian-day-number ] bi@ - 86400 * ] 2keep + [ >time< >r >r 3600 * r> 60 * r> + + ] bi@ - + ; M: timestamp time- #! Exact calendar-time difference diff --git a/extra/calendar/format/format.factor b/extra/calendar/format/format.factor index b0bd7c464f..26ed873fd3 100755 --- a/extra/calendar/format/format.factor +++ b/extra/calendar/format/format.factor @@ -182,7 +182,7 @@ M: timestamp year. ( timestamp -- ) [ [ month>> month-abbreviations nth write ] keep bl [ day>> number>string 2 32 pad-left write ] keep bl - dup now [ year>> ] 2apply = [ + dup now [ year>> ] bi@ = [ [ hour>> write-00 ] keep ":" write minute>> write-00 ] [ diff --git a/extra/cocoa/dialogs/dialogs.factor b/extra/cocoa/dialogs/dialogs.factor index ea77c496a2..606526a240 100644 --- a/extra/cocoa/dialogs/dialogs.factor +++ b/extra/cocoa/dialogs/dialogs.factor @@ -26,7 +26,7 @@ IN: cocoa.dialogs [ -> filenames CF>string-array ] [ drop f ] if ; : split-path ( path -- dir file ) - "/" last-split1 [ ] 2apply ; + "/" last-split1 [ ] bi@ ; : save-panel ( path -- paths ) dup diff --git a/extra/crypto/rsa/rsa.factor b/extra/crypto/rsa/rsa.factor index ffb2a64b76..ccf17da4e8 100644 --- a/extra/crypto/rsa/rsa.factor +++ b/extra/crypto/rsa/rsa.factor @@ -24,7 +24,7 @@ C: rsa : modulus-phi ( numbits -- n phi ) #! Loop until phi is not divisible by the public key. dup rsa-primes [ * ] 2keep - [ 1- ] 2apply * + [ 1- ] bi@ * dup public-key gcd nip 1 = [ rot drop ] [ diff --git a/extra/crypto/sha1/sha1.factor b/extra/crypto/sha1/sha1.factor index af3671e7d9..8f3d3e6ecc 100755 --- a/extra/crypto/sha1/sha1.factor +++ b/extra/crypto/sha1/sha1.factor @@ -124,5 +124,5 @@ SYMBOLS: h0 h1 h2 h3 h4 A B C D E w K ; : byte-array>sha1-interleave ( string -- seq ) [ zero? ] left-trim dup length odd? [ 1 tail ] when - seq>2seq [ byte-array>sha1 ] 2apply + seq>2seq [ byte-array>sha1 ] bi@ swap 2seq>seq ; diff --git a/extra/documents/documents.factor b/extra/documents/documents.factor index 60ae592d4c..14f0dc41ac 100755 --- a/extra/documents/documents.factor +++ b/extra/documents/documents.factor @@ -12,7 +12,7 @@ IN: documents : =line ( n loc -- newloc ) second 2array ; -: lines-equal? ( loc1 loc2 -- ? ) [ first ] 2apply number= ; +: lines-equal? ( loc1 loc2 -- ? ) [ first ] bi@ number= ; TUPLE: document locs ; @@ -46,7 +46,7 @@ TUPLE: document locs ; 2over = [ 3drop ] [ - >r [ first ] 2apply 1+ dup r> each + >r [ first ] bi@ 1+ dup r> each ] if ; inline : start/end-on-line ( from to line# -- n1 n2 ) @@ -85,7 +85,7 @@ TUPLE: document locs ; : (set-doc-range) ( newlines from to lines -- ) [ prepare-insert ] 3keep - >r [ first ] 2apply 1+ r> + >r [ first ] bi@ 1+ r> replace-slice ; : set-doc-range ( string from to document -- ) diff --git a/extra/faq/faq.factor b/extra/faq/faq.factor index d7624466f7..c6d9cd04d2 100644 --- a/extra/faq/faq.factor +++ b/extra/faq/faq.factor @@ -91,7 +91,7 @@ C: faq : faq-sections, ( question-lists -- ) unclip question-list-seq length 1+ dupd [ question-list-seq length + ] accumulate nip - 0 -rot [ pick question-list>html [ , nl, ] 2apply 1+ ] 2each drop ; + 0 -rot [ pick question-list>html [ , nl, ] bi@ 1+ ] 2each drop ; : faq>html ( faq -- div ) "div" [ diff --git a/extra/fry/fry-docs.factor b/extra/fry/fry-docs.factor index 739e7d012c..84d02d529d 100755 --- a/extra/fry/fry-docs.factor +++ b/extra/fry/fry-docs.factor @@ -69,7 +69,7 @@ $nl { { $link curry } { $snippet ": curry '[ , @ ] ;" } } { { $link with } { $snippet ": with swapd '[ , _ @ ] ;" } } { { $link compose } { $snippet ": compose '[ @ @ ] ;" } } - { { $link 2apply } { $snippet ": 2apply tuck '[ , @ , @ ] call ;" } } + { { $link bi@ } { $snippet ": bi@ tuck '[ , @ , @ ] call ;" } } } ; ARTICLE: "fry.philosophy" "Fried quotation philosophy" diff --git a/extra/help/lint/lint.factor b/extra/help/lint/lint.factor index b65e44fda4..01e08473c6 100755 --- a/extra/help/lint/lint.factor +++ b/extra/help/lint/lint.factor @@ -59,7 +59,7 @@ IN: help.lint : check-see-also ( word element -- ) nip \ $see-also swap elements [ - 1 tail dup prune [ length ] 2apply assert= + 1 tail dup prune [ length ] bi@ assert= ] each ; : vocab-exists? ( name -- ? ) diff --git a/extra/http/http.factor b/extra/http/http.factor index 69c0ba2c9f..6ff4829b48 100755 --- a/extra/http/http.factor +++ b/extra/http/http.factor @@ -106,7 +106,7 @@ IN: http : query>assoc ( query -- assoc ) dup [ "&" split [ - "=" split1 [ dup [ url-decode ] when ] 2apply + "=" split1 [ dup [ url-decode ] when ] bi@ ] H{ } map>assoc ] when ; diff --git a/extra/icfp/2006/2006.factor b/extra/icfp/2006/2006.factor index 1740e8a523..e88301c7f8 100755 --- a/extra/icfp/2006/2006.factor +++ b/extra/icfp/2006/2006.factor @@ -51,14 +51,14 @@ SYMBOL: open-arrays : binary-op ( quot -- ? ) >r get-cba r> - swap >r >r [ reg-val ] 2apply swap r> call r> + swap >r >r [ reg-val ] bi@ swap r> call r> set-reg f ; inline : op1 ( opcode -- ? ) [ swap arr-val ] binary-op ; : op2 ( opcode -- ? ) - get-cba >r [ reg-val ] 2apply r> reg-val set-arr f ; + get-cba >r [ reg-val ] bi@ r> reg-val set-arr f ; : op3 ( opcode -- ? ) [ + >32bit ] binary-op ; diff --git a/extra/inverse/inverse.factor b/extra/inverse/inverse.factor index d524180471..1b7badd94a 100755 --- a/extra/inverse/inverse.factor +++ b/extra/inverse/inverse.factor @@ -151,10 +151,10 @@ MACRO: undo ( quot -- ) [undo] ; \ - [ + ] [ - ] define-math-inverse \ * [ / ] [ / ] define-math-inverse \ / [ * ] [ / ] define-math-inverse -\ ^ [ recip ^ ] [ [ log ] 2apply / ] define-math-inverse +\ ^ [ recip ^ ] [ [ log ] bi@ / ] define-math-inverse \ ? 2 [ - [ assert-literal ] 2apply + [ assert-literal ] bi@ [ swap >r over = r> swap [ 2drop f ] [ = [ t ] [ fail ] if ] if ] 2curry ] define-pop-inverse diff --git a/extra/io/encodings/utf16/utf16.factor b/extra/io/encodings/utf16/utf16.factor index e8ca04af35..fbc296e57c 100755 --- a/extra/io/encodings/utf16/utf16.factor +++ b/extra/io/encodings/utf16/utf16.factor @@ -78,7 +78,7 @@ M: utf16le decode-char swap BIN: 11111111 bitand ; : stream-write2 ( stream char1 char2 -- ) - rot [ stream-write1 ] curry 2apply ; + rot [ stream-write1 ] curry bi@ ; : char>utf16be ( stream char -- ) dup HEX: FFFF > [ diff --git a/extra/io/nonblocking/nonblocking.factor b/extra/io/nonblocking/nonblocking.factor index b345a98e88..85319ad8ef 100755 --- a/extra/io/nonblocking/nonblocking.factor +++ b/extra/io/nonblocking/nonblocking.factor @@ -161,5 +161,5 @@ TUPLE: datagram-port addr packet packet-addr ; : check-datagram-send ( packet addrspec port -- ) dup check-datagram-port - datagram-port-addr [ class ] 2apply assert= + datagram-port-addr [ class ] bi@ assert= class byte-array assert= ; diff --git a/extra/io/sockets/impl/impl.factor b/extra/io/sockets/impl/impl.factor index 77e8e098b1..8480fcd856 100755 --- a/extra/io/sockets/impl/impl.factor +++ b/extra/io/sockets/impl/impl.factor @@ -64,8 +64,8 @@ M: inet6 inet-ntop ( data addrspec -- str ) M: inet6 inet-pton ( str addrspec -- data ) drop "::" split1 - [ [ ":" split [ hex> dup 0 ? ] map ] [ f ] if* ] 2apply - 2dup [ length ] 2apply + 8 swap - 0 swap 3append + [ [ ":" split [ hex> dup 0 ? ] map ] [ f ] if* ] bi@ + 2dup [ length ] bi@ + 8 swap - 0 swap 3append [ 2 >be ] map concat >byte-array ; M: inet6 address-size drop 16 ; diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 3b493d2fe4..b0b0ba456a 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -49,7 +49,7 @@ M: unix-io touch-file ( path -- ) close ; M: unix-io move-file ( from to -- ) - [ normalize-pathname ] 2apply rename io-error ; + [ normalize-pathname ] bi@ rename io-error ; M: unix-io delete-file ( path -- ) normalize-pathname unlink io-error ; @@ -69,7 +69,7 @@ M: unix-io delete-directory ( path -- ) ] with-disposal ; M: unix-io copy-file ( from to -- ) - [ normalize-pathname ] 2apply + [ normalize-pathname ] bi@ [ (copy-file) ] [ swap file-info file-info-permissions chmod io-error ] 2bi ; diff --git a/extra/io/windows/ce/backend/backend.factor b/extra/io/windows/ce/backend/backend.factor index f51521dfcc..152e76a6c7 100755 --- a/extra/io/windows/ce/backend/backend.factor +++ b/extra/io/windows/ce/backend/backend.factor @@ -46,5 +46,5 @@ M: windows-ce-io (init-stdio) ( -- ) 1 _getstdfilex _fileno 2 _getstdfilex _fileno ] if [ f ] 3apply - rot -rot [ ] 2apply + rot -rot [ ] bi@ ] with-variable ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 64c4684e15..27917cedfa 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -135,14 +135,14 @@ M: windows-io (file-appender) ( path -- stream ) open-append ; M: windows-io move-file ( from to -- ) - [ normalize-pathname ] 2apply MoveFile win32-error=0/f ; + [ normalize-pathname ] bi@ MoveFile win32-error=0/f ; M: windows-io delete-file ( path -- ) normalize-pathname DeleteFile win32-error=0/f ; M: windows-io copy-file ( from to -- ) dup parent-directory make-directories - [ normalize-pathname ] 2apply 0 CopyFile win32-error=0/f ; + [ normalize-pathname ] bi@ 0 CopyFile win32-error=0/f ; M: windows-io make-directory ( path -- ) normalize-pathname diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index 61fef7959c..7be406d37a 100755 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -72,7 +72,7 @@ TUPLE: segment number color radius ; : sub-tunnel ( from to sements -- segments ) #! return segments between from and to, after clamping from and to to #! valid values - [ sequence-index-range [ clamp-to-range ] curry 2apply ] keep ; + [ sequence-index-range [ clamp-to-range ] curry bi@ ] keep ; : nearer-segment ( segment segment oint -- segment ) #! return whichever of the two segments is nearer to the oint diff --git a/extra/koszul/koszul.factor b/extra/koszul/koszul.factor index 71cbb1d951..f286690d37 100755 --- a/extra/koszul/koszul.factor +++ b/extra/koszul/koszul.factor @@ -57,7 +57,7 @@ SYMBOL: terms terms get [ [ swap +@ ] assoc-each ] bind ; : alt+ ( x y -- x+y ) - [ >alt ] 2apply [ (alt+) (alt+) ] with-terms ; + [ >alt ] bi@ [ (alt+) (alt+) ] with-terms ; ! Multiplication : alt*n ( vec n -- vec ) @@ -79,7 +79,7 @@ SYMBOL: terms ] curry each ; : duplicates? ( seq -- ? ) - dup prune [ length ] 2apply > ; + dup prune [ length ] bi@ > ; : (wedge) ( n basis1 basis2 -- n basis ) append dup duplicates? [ @@ -90,7 +90,7 @@ SYMBOL: terms ] if ; : wedge ( x y -- x.y ) - [ >alt ] 2apply [ + [ >alt ] bi@ [ swap [ [ 2swap [ @@ -200,7 +200,7 @@ DEFER: (d) ] with map ; : bigraded-betti ( u-generators z-generators -- seq ) - [ basis graded ] 2apply tensor bigraded-ker/im-d + [ basis graded ] bi@ tensor bigraded-ker/im-d [ [ [ first ] map ] map ] keep [ [ second ] map 2 head* { 0 0 } prepend ] map 1 tail dup first length 0 add @@ -278,7 +278,7 @@ DEFER: (d) ] with map ; : bigraded-laplacian ( u-generators z-generators quot -- seq ) - >r [ basis graded ] 2apply tensor bigraded-triples r> + >r [ basis graded ] bi@ tensor bigraded-triples r> [ [ first3 ] swap compose map ] curry map ; inline : bigraded-laplacian-betti ( u-generators z-generators -- seq ) diff --git a/extra/lazy-lists/lazy-lists.factor b/extra/lazy-lists/lazy-lists.factor index 07cd34b4df..52cca64b2f 100644 --- a/extra/lazy-lists/lazy-lists.factor +++ b/extra/lazy-lists/lazy-lists.factor @@ -52,7 +52,7 @@ M: cons nil? ( cons -- bool ) TUPLE: lazy-cons car cdr ; : lazy-cons ( car cdr -- promise ) - [ promise ] 2apply \ lazy-cons construct-boa + [ promise ] bi@ \ lazy-cons construct-boa T{ promise f f t f } clone [ set-promise-value ] keep ; diff --git a/extra/levenshtein/levenshtein.factor b/extra/levenshtein/levenshtein.factor index 07e16fb862..98b376593c 100644 --- a/extra/levenshtein/levenshtein.factor +++ b/extra/levenshtein/levenshtein.factor @@ -17,7 +17,7 @@ SYMBOL: d SYMBOL: costs : init-d ( str1 str2 -- ) - [ length 1+ ] 2apply 2dup d set + [ length 1+ ] bi@ 2dup d set [ 0 over ->d ] each [ dup 0 ->d ] each ; inline @@ -39,7 +39,7 @@ SYMBOL: costs [ 2dup init-d 2dup compute-costs - [ length ] 2apply [ + [ length ] bi@ [ [ levenshtein-step ] curry each ] with each levenshtein-result diff --git a/extra/lint/lint.factor b/extra/lint/lint.factor index a220eece01..dcf52f723a 100644 --- a/extra/lint/lint.factor +++ b/extra/lint/lint.factor @@ -71,7 +71,7 @@ def-hash get-global [ ! Remove set-alien-cell, etc. [ - drop [ accessor-words swap seq-diff ] keep [ length ] 2apply = + drop [ accessor-words swap seq-diff ] keep [ length ] bi@ = ] assoc-subset ! Remove trivial defs @@ -148,7 +148,7 @@ GENERIC: run-lint ( obj -- obj ) : filter-symbols ( alist -- alist ) [ nip first dup def-hash get at - [ first ] 2apply literalize = not + [ first ] bi@ literalize = not ] assoc-subset ; M: sequence run-lint ( seq -- seq ) diff --git a/extra/match/match.factor b/extra/match/match.factor index fef925431d..2c6923a6ba 100755 --- a/extra/match/match.factor +++ b/extra/match/match.factor @@ -32,10 +32,10 @@ SYMBOL: _ { [ 2dup = ] [ 2drop t ] } { [ 2dup [ _ eq? ] either? ] [ 2drop t ] } { [ 2dup [ sequence? ] both? ] [ - 2dup [ length ] 2apply = + 2dup [ length ] bi@ = [ [ (match) ] 2all? ] [ 2drop f ] if ] } { [ 2dup [ tuple? ] both? ] - [ [ tuple>array ] 2apply [ (match) ] 2all? ] } + [ [ tuple>array ] bi@ [ (match) ] 2all? ] } { [ t ] [ 2drop f ] } } cond ; diff --git a/extra/math/complex/complex.factor b/extra/math/complex/complex.factor index 236d9df7a0..588f34d3fc 100755 --- a/extra/math/complex/complex.factor +++ b/extra/math/complex/complex.factor @@ -8,11 +8,11 @@ math.functions.private sequences parser ; M: real real-part ; M: real imaginary-part drop 0 ; -M: complex absq >rect [ sq ] 2apply + ; +M: complex absq >rect [ sq ] bi@ + ; : 2>rect ( x y -- xr yr xi yi ) - [ [ real-part ] 2apply ] 2keep - [ imaginary-part ] 2apply ; inline + [ [ real-part ] bi@ ] 2keep + [ imaginary-part ] bi@ ; inline M: complex number= 2>rect number= [ number= ] [ 2drop f ] if ; diff --git a/extra/math/functions/functions.factor b/extra/math/functions/functions.factor index 85e07fe73f..dcbccb4316 100755 --- a/extra/math/functions/functions.factor +++ b/extra/math/functions/functions.factor @@ -101,7 +101,7 @@ M: real absq sq ; >r - abs r> < ; : ~rel ( x y epsilon -- ? ) - >r [ - abs ] 2keep [ abs ] 2apply + r> * < ; + >r [ - abs ] 2keep [ abs ] bi@ + r> * < ; : ~ ( x y epsilon -- ? ) { @@ -124,7 +124,7 @@ M: real absq sq ; : arg ( z -- arg ) >float-rect swap fatan2 ; inline : >polar ( z -- abs arg ) - >float-rect [ [ sq ] 2apply + fsqrt ] 2keep swap fatan2 ; + >float-rect [ [ sq ] bi@ + fsqrt ] 2keep swap fatan2 ; inline : cis ( arg -- z ) dup fcos swap fsin rect> ; inline diff --git a/extra/math/polynomials/polynomials.factor b/extra/math/polynomials/polynomials.factor index 000d97f2a6..d6ac71e629 100644 --- a/extra/math/polynomials/polynomials.factor +++ b/extra/math/polynomials/polynomials.factor @@ -13,10 +13,10 @@ IN: math.polynomials : p= ( p p -- ? ) pextend = ; @@ -24,7 +24,7 @@ PRIVATE> : ptrim ( p -- p ) dup singleton? [ [ zero? ] right-trim ] unless ; -: 2ptrim ( p p -- p p ) [ ptrim ] 2apply ; +: 2ptrim ( p p -- p p ) [ ptrim ] bi@ ; : p+ ( p p -- p ) pextend v+ ; : p- ( p p -- p ) pextend v- ; : n*p ( n p -- n*p ) n*v ; @@ -32,7 +32,7 @@ PRIVATE> ! convolution : pextend-conv ( p p -- p p ) #! extend to: p_m + p_n - 1 - 2dup [ length ] 2apply + 1- 2pad-right [ >vector ] 2apply ; + 2dup [ length ] bi@ + 1- 2pad-right [ >vector ] bi@ ; : p* ( p p -- p ) #! Multiply two polynomials. @@ -46,13 +46,13 @@ PRIVATE> : p/mod-setup ( p p -- p p n ) 2ptrim - 2dup [ length ] 2apply - + 2dup [ length ] bi@ - dup 1 < [ drop 1 ] when [ over length + 0 pad-left pextend ] keep 1+ ; : /-last ( seq seq -- a ) #! divide the last two numbers in the sequences - [ peek ] 2apply / ; + [ peek ] bi@ / ; : (p/mod) 2dup /-last @@ -74,7 +74,7 @@ PRIVATE> ] if ; : pgcd ( p p -- p q ) - swap V{ 0 } clone V{ 1 } clone 2swap (pgcd) [ >array ] 2apply ; + swap V{ 0 } clone V{ 1 } clone 2swap (pgcd) [ >array ] bi@ ; : pdiff ( p -- p' ) #! Polynomial derivative. diff --git a/extra/math/quaternions/quaternions.factor b/extra/math/quaternions/quaternions.factor index d61afd17c3..f121e4a0d1 100755 --- a/extra/math/quaternions/quaternions.factor +++ b/extra/math/quaternions/quaternions.factor @@ -14,7 +14,7 @@ IN: math.quaternions : ** conjugate * ; inline -: 2q ( u v -- u' u'' v' v'' ) [ first2 ] 2apply ; inline +: 2q ( u v -- u' u'' v' v'' ) [ first2 ] bi@ ; inline : q*a ( u v -- a ) 2q swapd ** >r * r> - ; inline diff --git a/extra/math/ratios/ratios.factor b/extra/math/ratios/ratios.factor index 5d07bd046f..3c430111ff 100755 --- a/extra/math/ratios/ratios.factor +++ b/extra/math/ratios/ratios.factor @@ -7,7 +7,7 @@ USING: kernel kernel.private math math.functions math.private ; dup numerator swap denominator ; inline : 2>fraction ( a/b c/d -- a c b d ) - [ >fraction ] 2apply swapd ; inline + [ >fraction ] bi@ swapd ; inline r /i r> fraction> ] if ; diff --git a/extra/math/statistics/statistics.factor b/extra/math/statistics/statistics.factor index 4c60363be0..f7295604cd 100644 --- a/extra/math/statistics/statistics.factor +++ b/extra/math/statistics/statistics.factor @@ -46,13 +46,13 @@ IN: math.statistics : ((r)) ( mean(x) mean(y) {x} {y} -- (r) ) ! finds sigma((xi-mean(x))(yi-mean(y)) - 0 [ [ >r pick r> swap - ] 2apply * + ] 2reduce 2nip ; + 0 [ [ >r pick r> swap - ] bi@ * + ] 2reduce 2nip ; : (r) ( mean(x) mean(y) {x} {y} sx sy -- r ) * recip >r [ ((r)) ] keep length 1- / r> * ; : [r] ( {{x,y}...} -- mean(x) mean(y) {x} {y} sx sy ) - first2 [ [ [ mean ] 2apply ] 2keep ] 2keep [ std ] 2apply ; + first2 [ [ [ mean ] bi@ ] 2keep ] 2keep [ std ] bi@ ; : r ( {{x,y}...} -- r ) [r] (r) ; diff --git a/extra/maze/maze.factor b/extra/maze/maze.factor index 14a493cec5..5d7bb9a1a2 100644 --- a/extra/maze/maze.factor +++ b/extra/maze/maze.factor @@ -22,7 +22,7 @@ SYMBOL: visited : random-neighbour ( cell -- newcell ) choices random ; : vertex ( pair -- ) - first2 [ 0.5 + line-width * ] 2apply glVertex2d ; + first2 [ 0.5 + line-width * ] bi@ glVertex2d ; : (draw-maze) ( cell -- ) dup vertex diff --git a/extra/money/money.factor b/extra/money/money.factor index 4058ee9e6a..4584daf592 100644 --- a/extra/money/money.factor +++ b/extra/money/money.factor @@ -23,9 +23,9 @@ TUPLE: not-a-decimal ; : parse-decimal ( str -- ratio ) "." split1 >r dup "-" head? [ drop t "0" ] [ f swap ] if r> - [ dup empty? [ drop "0" ] when ] 2apply + [ dup empty? [ drop "0" ] when ] bi@ dup length - >r [ string>number dup [ not-a-decimal ] unless ] 2apply r> + >r [ string>number dup [ not-a-decimal ] unless ] bi@ r> 10 swap ^ / + swap [ neg ] when ; : DECIMAL: diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index ed82d2478e..ac62fb08f9 100755 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -113,7 +113,7 @@ TUPLE: no-method arguments generic ; ] curry assoc-map ; : sorted-methods ( alist -- alist' ) - [ [ first ] 2apply classes< ] topological-sort ; + [ [ first ] bi@ classes< ] topological-sort ; : niceify-method [ dup \ f eq? [ drop f ] when ] map ; diff --git a/extra/opengl/demo-support/demo-support.factor b/extra/opengl/demo-support/demo-support.factor index 61d3be0e15..84515305c8 100755 --- a/extra/opengl/demo-support/demo-support.factor +++ b/extra/opengl/demo-support/demo-support.factor @@ -38,7 +38,7 @@ M: demo-gadget pref-dim* ( gadget -- dim ) : demo-gadget-frustum ( -- -x x -y y near far ) FOV-RATIO NEAR-PLANE FOV / v*n - first2 [ -+ ] 2apply NEAR-PLANE FAR-PLANE ; + first2 [ -+ ] bi@ NEAR-PLANE FAR-PLANE ; : demo-gadget-set-matrices ( gadget -- ) GL_PROJECTION glMatrixMode diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor index 08e3cb204b..36d24e1300 100755 --- a/extra/opengl/opengl.factor +++ b/extra/opengl/opengl.factor @@ -8,9 +8,9 @@ math.parser opengl.gl opengl.glu combinators arrays sequences splitting words byte-arrays assocs combinators.lib ; IN: opengl -: coordinates [ first2 ] 2apply ; +: coordinates [ first2 ] bi@ ; -: fix-coordinates [ first2 [ >fixnum ] 2apply ] 2apply ; +: fix-coordinates [ first2 [ >fixnum ] bi@ ] bi@ ; : gl-color ( color -- ) first4 glColor4d ; inline @@ -85,7 +85,7 @@ MACRO: all-enabled-client-state ( seq quot -- ) : unit-circle dup [ sin ] map swap [ cos ] map ; -: adjust-points [ [ 1 + 0.5 * ] map ] 2apply ; +: adjust-points [ [ 1 + 0.5 * ] map ] bi@ ; : scale-points 2array flip [ v* ] with map [ v+ ] with map ; diff --git a/extra/parser-combinators/parser-combinators.factor b/extra/parser-combinators/parser-combinators.factor index bf06708e09..d6aacf9645 100755 --- a/extra/parser-combinators/parser-combinators.factor +++ b/extra/parser-combinators/parser-combinators.factor @@ -35,7 +35,7 @@ C: parse-result ] if ; : string= ( str1 str2 ignore-case -- ? ) - [ [ >upper ] 2apply ] when sequence= ; + [ [ >upper ] bi@ ] when sequence= ; : string-head? ( str head ignore-case -- ? ) 2over shorter? [ @@ -327,7 +327,7 @@ LAZY: <(+)> ( parser -- parser ) nonempty-list-of { } succeed <|> ; LAZY: surrounded-by ( parser start end -- parser' ) - [ token ] 2apply swapd pack ; + [ token ] bi@ swapd pack ; : exactly-n ( parser n -- parser' ) swap [ flatten ] <@ ; diff --git a/extra/peg/parsers/parsers.factor b/extra/peg/parsers/parsers.factor index 7a82418c27..49035ea43c 100755 --- a/extra/peg/parsers/parsers.factor +++ b/extra/peg/parsers/parsers.factor @@ -70,7 +70,7 @@ MEMO: pack ( begin body end -- parser ) >r >r hide r> r> hide 3seq [ first ] action ; : surrounded-by ( parser begin end -- parser' ) - [ token ] 2apply swapd pack ; + [ token ] bi@ swapd pack ; : 'digit' ( -- parser ) [ digit? ] satisfy [ digit> ] action ; diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 247a64eac2..d6d573da79 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -11,7 +11,7 @@ USE: prettyprint TUPLE: parse-result remaining ast ; TUPLE: parser id compiled ; -M: parser equal? [ id>> ] 2apply = ; +M: parser equal? [ id>> ] bi@ = ; C: parser SYMBOL: ignore diff --git a/extra/project-euler/009/009.factor b/extra/project-euler/009/009.factor index f09643d290..690fed9012 100644 --- a/extra/project-euler/009/009.factor +++ b/extra/project-euler/009/009.factor @@ -31,7 +31,7 @@ IN: project-euler.009 : abc ( p q -- triplet ) [ 2dup * , ! a = p * q - [ sq ] 2apply 2dup - 2 / , ! b = (p² - q²) / 2 + [ sq ] bi@ 2dup - 2 / , ! b = (p² - q²) / 2 + 2 / , ! c = (p² + q²) / 2 ] { } make natural-sort ; diff --git a/extra/project-euler/014/014.factor b/extra/project-euler/014/014.factor index 02c5dbb9d3..32b1aa5549 100644 --- a/extra/project-euler/014/014.factor +++ b/extra/project-euler/014/014.factor @@ -39,7 +39,7 @@ IN: project-euler.014 dup even? [ 2 / ] [ 3 * 1+ ] if ; : longest ( seq seq -- seq ) - 2dup [ length ] 2apply > [ drop ] [ nip ] if ; + 2dup [ length ] bi@ > [ drop ] [ nip ] if ; PRIVATE> diff --git a/extra/project-euler/026/026.factor b/extra/project-euler/026/026.factor index 3ad1908aa6..f1f546ec1c 100644 --- a/extra/project-euler/026/026.factor +++ b/extra/project-euler/026/026.factor @@ -58,7 +58,7 @@ PRIVATE> : max-period ( seq -- elt n ) dup [ period-length ] map dup supremum - over index [ swap nth ] curry 2apply ; + over index [ swap nth ] curry bi@ ; PRIVATE> diff --git a/extra/project-euler/027/027.factor b/extra/project-euler/027/027.factor index 2bc7894684..2d99204bf3 100644 --- a/extra/project-euler/027/027.factor +++ b/extra/project-euler/027/027.factor @@ -60,7 +60,7 @@ IN: project-euler.027 : max-consecutive ( seq -- elt n ) dup [ first2 consecutive-primes ] map dup supremum - over index [ swap nth ] curry 2apply ; + over index [ swap nth ] curry bi@ ; PRIVATE> diff --git a/extra/project-euler/033/033.factor b/extra/project-euler/033/033.factor index 6f29c3519e..35b1c87e7a 100644 --- a/extra/project-euler/033/033.factor +++ b/extra/project-euler/033/033.factor @@ -33,10 +33,10 @@ IN: project-euler.033 10 99 [a,b] dup cartesian-product [ first2 < ] subset ; : safe? ( ax xb -- ? ) - [ 10 /mod ] 2apply -roll = rot zero? not and nip ; + [ 10 /mod ] bi@ -roll = rot zero? not and nip ; : ax/xb ( ax xb -- z/f ) - 2dup safe? [ [ 10 /mod ] 2apply 2nip / ] [ 2drop f ] if ; + 2dup safe? [ [ 10 /mod ] bi@ 2nip / ] [ 2drop f ] if ; : curious? ( m n -- ? ) 2dup / [ ax/xb ] dip = ; diff --git a/extra/project-euler/044/044.factor b/extra/project-euler/044/044.factor index 62e516e4b0..bc8aec8bde 100644 --- a/extra/project-euler/044/044.factor +++ b/extra/project-euler/044/044.factor @@ -31,7 +31,7 @@ IN: project-euler.044 dup 3 * 1- * 2 / ; : sum-and-diff? ( m n -- ? ) - 2dup + -rot - [ pentagonal? ] 2apply and ; + 2dup + -rot - [ pentagonal? ] bi@ and ; PRIVATE> diff --git a/extra/project-euler/079/079.factor b/extra/project-euler/079/079.factor index 30c46de0a0..b4cbd6dbcb 100644 --- a/extra/project-euler/079/079.factor +++ b/extra/project-euler/079/079.factor @@ -35,7 +35,7 @@ IN: project-euler.079 ] { } make ; : find-source ( seq -- elt ) - dup values swap keys [ prune ] 2apply seq-diff + dup values swap keys [ prune ] bi@ seq-diff dup empty? [ "Topological sort failed" throw ] [ first ] if ; : remove-source ( seq elt -- seq ) diff --git a/extra/random-tester/random/random.factor b/extra/random-tester/random/random.factor index 163de69a59..11f2e60d1a 100755 --- a/extra/random-tester/random/random.factor +++ b/extra/random-tester/random/random.factor @@ -54,7 +54,7 @@ IN: random-tester ] if ; : random-ratio ( -- ratio ) - 1000000000 dup [ random ] 2apply 1+ / 50% [ neg ] when dup [ drop random-ratio ] unless 10% [ drop 0 ] when ; + 1000000000 dup [ random ] bi@ 1+ / 50% [ neg ] when dup [ drop random-ratio ] unless 10% [ drop 0 ] when ; : random-float ( -- float ) 50% [ random-ratio ] [ special-floats get random ] if diff --git a/extra/regexp/regexp.factor b/extra/regexp/regexp.factor index b57724d1db..fa36a7c6f8 100755 --- a/extra/regexp/regexp.factor +++ b/extra/regexp/regexp.factor @@ -16,7 +16,7 @@ SYMBOL: ignore-case? : char-between?-quot ( ch1 ch2 -- quot ) ignore-case? get - [ [ ch>upper ] 2apply [ >r >r ch>upper r> r> between? ] ] + [ [ ch>upper ] bi@ [ >r >r ch>upper r> r> between? ] ] [ [ between? ] ] if 2curry ; diff --git a/extra/regexp2/regexp2.factor b/extra/regexp2/regexp2.factor index e62eb76cb1..1f2bbde171 100644 --- a/extra/regexp2/regexp2.factor +++ b/extra/regexp2/regexp2.factor @@ -16,7 +16,7 @@ SYMBOL: ignore-case? : char-between?-quot ( ch1 ch2 -- quot ) ignore-case? get - [ [ ch>upper ] 2apply [ >r >r ch>upper r> r> between? ] ] + [ [ ch>upper ] bi@ [ >r >r ch>upper r> r> between? ] ] [ [ between? ] ] if 2curry ; diff --git a/extra/reports/noise/noise.factor b/extra/reports/noise/noise.factor index 2614a774dd..7e9496c90d 100755 --- a/extra/reports/noise/noise.factor +++ b/extra/reports/noise/noise.factor @@ -9,7 +9,7 @@ IN: reports.noise { -nrot 5 } { -roll 4 } { -rot 3 } - { 2apply 1 } + { bi@ 1 } { 2curry 1 } { 2drop 1 } { 2dup 1 } diff --git a/extra/roman/roman.factor b/extra/roman/roman.factor index 7466883c5f..a3e61dd889 100644 --- a/extra/roman/roman.factor +++ b/extra/roman/roman.factor @@ -23,7 +23,7 @@ TUPLE: roman-range-error n ; ] if ; : roman<= ( ch1 ch2 -- ? ) - [ 1string roman-digits index ] 2apply >= ; + [ 1string roman-digits index ] bi@ >= ; : roman>n ( ch -- n ) 1string roman-digits index roman-values nth ; @@ -57,7 +57,7 @@ PRIVATE> ( str1 str2 -- m n ) - [ roman> ] 2apply ; + [ roman> ] bi@ ; : binary-roman-op ( str1 str2 quot -- str3 ) >r 2roman> r> call >roman ; inline diff --git a/extra/semantic-db/semantic-db-tests.factor b/extra/semantic-db/semantic-db-tests.factor index 257133c67f..c523053740 100644 --- a/extra/semantic-db/semantic-db-tests.factor +++ b/extra/semantic-db/semantic-db-tests.factor @@ -60,7 +60,7 @@ test-db [ "charlie" create-node* "charlie" set "gertrude" create-node* "gertrude" set [ t ] [ "adam" get "bob" get parent-child* integer? ] unit-test - { { "eve" "bob" } { "eve" "fran" } { "bob" "gertrude" } { "bob" "fran" } { "fran" "charlie" } } [ first2 [ get ] 2apply parent-child ] each + { { "eve" "bob" } { "eve" "fran" } { "bob" "gertrude" } { "bob" "fran" } { "fran" "charlie" } } [ first2 [ get ] bi@ parent-child ] each [ { "bob" "fran" } ] [ "eve" get children [ node-content ] map ] unit-test [ { "adam" "eve" } ] [ "bob" get parents [ node-content ] map ] unit-test [ "fran" { "charlie" } ] [ "fran" get get-node-hierarchy dup tree-id node-content swap tree-children [ tree-id node-content ] map ] unit-test diff --git a/extra/serialize/serialize.factor b/extra/serialize/serialize.factor index 2865b1fd6c..ac247057f4 100755 --- a/extra/serialize/serialize.factor +++ b/extra/serialize/serialize.factor @@ -24,7 +24,7 @@ C: id M: id hashcode* obj>> hashcode* ; -M: id equal? over id? [ [ obj>> ] 2apply eq? ] [ 2drop f ] if ; +M: id equal? over id? [ [ obj>> ] bi@ eq? ] [ 2drop f ] if ; : add-object ( obj -- ) #! Add an object to the sequence of already serialized diff --git a/extra/shufflers/shufflers.factor b/extra/shufflers/shufflers.factor index 172db1def1..b11668a53e 100644 --- a/extra/shufflers/shufflers.factor +++ b/extra/shufflers/shufflers.factor @@ -20,7 +20,7 @@ IN: shufflers : put-effect ( word -- ) dup word-name "-" split1 - [ >array [ 1string ] map ] 2apply + [ >array [ 1string ] map ] bi@ "declared-effect" set-word-prop ; : in-shuffle ( -- ) in get ".shuffle" append set-in ; diff --git a/extra/sudoku/sudoku.factor b/extra/sudoku/sudoku.factor index db5fb75617..764c4d92f0 100644 --- a/extra/sudoku/sudoku.factor +++ b/extra/sudoku/sudoku.factor @@ -18,7 +18,7 @@ SYMBOL: board : cell-contains? ( n x y i -- ? ) 3 /mod pair+ board> = ; : box-contains? ( n x y -- ? ) - [ 3 /i 3 * ] 2apply + [ 3 /i 3 * ] bi@ 9 [ >r 3dup r> cell-contains? ] contains? >r 3drop r> ; diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index d1c4b148a5..99af06b80f 100755 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -35,7 +35,7 @@ linkname magic version uname gname devmajor devminor prefix ; : header-checksum ( seq -- x ) 148 cut-slice 8 tail-slice - [ sum ] 2apply + 256 + ; + [ sum ] bi@ + 256 + ; TUPLE: checksum-error ; TUPLE: malformed-block-error ; diff --git a/extra/tools/completion/completion.factor b/extra/tools/completion/completion.factor index e44c3c401e..16bde2100f 100755 --- a/extra/tools/completion/completion.factor +++ b/extra/tools/completion/completion.factor @@ -40,7 +40,7 @@ unicode.categories ; : score ( full fuzzy -- n ) dup [ - [ [ length ] 2apply - 15 swap [-] 3 /f ] 2keep + [ [ length ] bi@ - 15 swap [-] 3 /f ] 2keep runs [ [ 0 [ pick score-1 max ] reduce nip ] keep length * + @@ -57,7 +57,7 @@ unicode.categories ; : complete ( full short -- score ) [ dupd fuzzy score ] 2keep - [ ] 2apply + [ ] bi@ dupd fuzzy score max ; : completion ( short candidate -- result ) diff --git a/extra/tools/deploy/shaker/strip-cocoa.factor b/extra/tools/deploy/shaker/strip-cocoa.factor index b37e42f323..de8f8740f0 100755 --- a/extra/tools/deploy/shaker/strip-cocoa.factor +++ b/extra/tools/deploy/shaker/strip-cocoa.factor @@ -14,7 +14,7 @@ global [ sent-messages get super-sent-messages get - [ keys [ objc-methods get at dup ] H{ } map>assoc ] 2apply + [ keys [ objc-methods get at dup ] H{ } map>assoc ] bi@ super-message-senders [ intersect ] change message-senders [ intersect ] change diff --git a/extra/ui/gadgets/borders/borders.factor b/extra/ui/gadgets/borders/borders.factor index e58ba343c7..6b548aaf68 100644 --- a/extra/ui/gadgets/borders/borders.factor +++ b/extra/ui/gadgets/borders/borders.factor @@ -24,7 +24,7 @@ M: border pref-dim* ; : scale-rect ( rect vec -- loc dim ) - [ v* ] curry >r rect-bounds r> 2apply ; + [ v* ] curry >r rect-bounds r> bi@ ; : average-rects ( rect1 rect2 weight -- rect ) tuck >r >r scale-rect r> r> { 1 1 } swap v- scale-rect diff --git a/extra/ui/gadgets/editors/editors.factor b/extra/ui/gadgets/editors/editors.factor index def6b99b05..b3ecad6aed 100755 --- a/extra/ui/gadgets/editors/editors.factor +++ b/extra/ui/gadgets/editors/editors.factor @@ -135,7 +135,7 @@ M: editor ungraft* dup editor-caret-color gl-color dup caret-loc origin get v+ swap caret-dim over v+ - [ { 0.5 -0.5 } v+ ] 2apply gl-line + [ { 0.5 -0.5 } v+ ] bi@ gl-line ] when ; : line-translation ( n -- loc ) diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor index 267f6f0f0f..ddcaa4b979 100755 --- a/extra/ui/gadgets/gadgets.factor +++ b/extra/ui/gadgets/gadgets.factor @@ -22,7 +22,7 @@ M: array rect-dim drop { 0 0 } ; : rect-extent ( rect -- loc ext ) rect-bounds over v+ ; : 2rect-extent ( rect rect -- loc1 loc2 ext1 ext2 ) - [ rect-extent ] 2apply swapd ; + [ rect-extent ] bi@ swapd ; : ( loc ext -- rect ) over [v-] ; diff --git a/extra/ui/gadgets/grids/grids-tests.factor b/extra/ui/gadgets/grids/grids-tests.factor index 0792d55135..f20275ff25 100644 --- a/extra/ui/gadgets/grids/grids-tests.factor +++ b/extra/ui/gadgets/grids/grids-tests.factor @@ -25,13 +25,13 @@ IN: ui.gadgets.grids.tests [ { 100 200 } ] [ 100x100 100x100 - [ 1array ] 2apply 2array pref-dim + [ 1array ] bi@ 2array pref-dim ] unit-test [ ] [ 100x100 100x100 - [ 1array ] 2apply 2array layout + [ 1array ] bi@ 2array layout ] unit-test [ { 230 120 } { 100 100 } { 100 100 } ] [ diff --git a/extra/ui/gadgets/scrollers/scrollers.factor b/extra/ui/gadgets/scrollers/scrollers.factor index 99bd1be876..d4a1895894 100755 --- a/extra/ui/gadgets/scrollers/scrollers.factor +++ b/extra/ui/gadgets/scrollers/scrollers.factor @@ -57,7 +57,7 @@ scroller H{ 2dup control-value = [ 2drop ] [ set-control-value ] if ; : rect-min ( rect1 rect2 -- rect ) - >r [ rect-loc ] keep r> [ rect-dim ] 2apply vmin ; + >r [ rect-loc ] keep r> [ rect-dim ] bi@ vmin ; : (scroll>rect) ( rect scroller -- ) [ diff --git a/extra/unicode/breaks/breaks.factor b/extra/unicode/breaks/breaks.factor index dfc7bf2264..4c8c6491ca 100644 --- a/extra/unicode/breaks/breaks.factor +++ b/extra/unicode/breaks/breaks.factor @@ -26,7 +26,7 @@ CATEGORY: grapheme-control Zl Zp Cc Cf ; : process-other-extend ( lines -- set ) [ "#" split1 drop ";" split1 drop trim-blank ] map [ empty? not ] subset - [ ".." split1 [ dup ] unless* [ hex> ] 2apply [a,b] ] map + [ ".." split1 [ dup ] unless* [ hex> ] bi@ [a,b] ] map concat >set ; : other-extend-lines ( -- lines ) @@ -83,7 +83,7 @@ VALUE: grapheme-table grapheme-table nth nth not ; : chars ( i str n -- str[i] str[i+n] ) - swap >r dupd + r> [ ?nth ] curry 2apply ; + swap >r dupd + r> [ ?nth ] curry bi@ ; : find-index ( seq quot -- i ) find drop ; inline : find-last-index ( seq quot -- i ) find-last drop ; inline diff --git a/extra/unicode/case/case.factor b/extra/unicode/case/case.factor index 8129ec17f8..092a247204 100755 --- a/extra/unicode/case/case.factor +++ b/extra/unicode/case/case.factor @@ -100,7 +100,7 @@ SYMBOL: locale ! Just casing locale, or overall? >upper >lower ; : insensitive= ( str1 str2 -- ? ) - [ >case-fold ] 2apply = ; + [ >case-fold ] bi@ = ; : lower? ( string -- ? ) dup >lower = ; diff --git a/extra/unicode/normalize/normalize.factor b/extra/unicode/normalize/normalize.factor index 47637e8330..d62beb1a2c 100644 --- a/extra/unicode/normalize/normalize.factor +++ b/extra/unicode/normalize/normalize.factor @@ -38,7 +38,7 @@ IN: unicode.normalize : (insert) ( seq n quot -- ) over 0 = [ 3drop ] [ - [ >r dup 1- rot [ nth ] curry 2apply r> 2apply > ] 3keep + [ >r dup 1- rot [ nth ] curry bi@ r> bi@ > ] 3keep roll [ 3drop ] [ >r [ dup 1- rot exchange ] 2keep 1- r> (insert) ] if ] if ; inline diff --git a/extra/units/units.factor b/extra/units/units.factor index b92cbb659a..cf53ceaee3 100755 --- a/extra/units/units.factor +++ b/extra/units/units.factor @@ -16,7 +16,7 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ; 1array split1 append ; : 2remove-one ( seq seq obj -- seq seq ) - [ remove-one ] curry 2apply ; + [ remove-one ] curry bi@ ; : symbolic-reduce ( seq seq -- seq seq ) 2dup seq-intersect dup empty? @@ -24,7 +24,7 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ; : ( n top bot -- obj ) symbolic-reduce - [ natural-sort ] 2apply + [ natural-sort ] bi@ dimensioned construct-boa ; : >dimensioned< ( d -- n top bot ) @@ -37,10 +37,10 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ; { dimensioned-top dimensioned-bot } get-slots ; : check-dimensions ( d d -- ) - [ dimensions 2array ] 2apply = + [ dimensions 2array ] bi@ = [ dimensions-not-equal ] unless ; -: 2values [ dimensioned-value ] 2apply ; +: 2values [ dimensioned-value ] bi@ ; : ; : d* ( d d -- d ) - [ dup number? [ scalar ] when ] 2apply - [ [ dimensioned-top ] 2apply append ] 2keep - [ [ dimensioned-bot ] 2apply append ] 2keep + [ dup number? [ scalar ] when ] bi@ + [ [ dimensioned-top ] bi@ append ] 2keep + [ [ dimensioned-bot ] bi@ append ] 2keep 2values * dimension-op> ; : d-neg ( d -- d ) -1 d* ; diff --git a/extra/xmode/catalog/catalog.factor b/extra/xmode/catalog/catalog.factor index c7eaafe887..822b290f88 100755 --- a/extra/xmode/catalog/catalog.factor +++ b/extra/xmode/catalog/catalog.factor @@ -63,7 +63,7 @@ SYMBOL: rule-sets over [ dupd update ] [ nip clone ] if ; : import-keywords ( parent child -- ) - over >r [ rule-set-keywords ] 2apply ?update + over >r [ rule-set-keywords ] bi@ ?update r> set-rule-set-keywords ; : import-rules ( parent child -- )