diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index bbd7df910..3e3c4a93a 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -433,7 +433,7 @@ M: quotation ' array>> ' quotation type-number object tag-number [ emit ! array - f ' emit ! compiled>> + f ' emit ! compiled 0 emit ! xt 0 emit ! code ] emit-object diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index 3d17009e3..8ee120012 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -211,7 +211,7 @@ TUPLE: my-tuple ; { tuple vector } 3 slot { word } declare dup 1 slot 0 fixnum-bitand { [ ] } dispatch ; -[ t ] [ \ dispatch-alignment-regression compiled>> ] unit-test +[ t ] [ \ dispatch-alignment-regression optimized>> ] unit-test [ vector ] [ dispatch-alignment-regression ] unit-test diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index bb1cb2eab..c5bbe4a6c 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -9,7 +9,7 @@ IN: optimizer.tests GENERIC: xyz ( obj -- obj ) M: array xyz xyz ; -[ t ] [ \ xyz compiled>> ] unit-test +[ t ] [ \ xyz optimized>> ] unit-test ! Test predicate inlining : pred-test-1 @@ -94,7 +94,7 @@ TUPLE: pred-test ; ! regression GENERIC: void-generic ( obj -- * ) : breakage ( -- * ) "hi" void-generic ; -[ t ] [ \ breakage compiled>> ] unit-test +[ t ] [ \ breakage optimized>> ] unit-test [ breakage ] must-fail ! regression @@ -119,7 +119,7 @@ GENERIC: void-generic ( obj -- * ) ! compiling with a non-literal class failed : -regression ( class -- tuple ) ; -[ t ] [ \ -regression compiled>> ] unit-test +[ t ] [ \ -regression optimized>> ] unit-test GENERIC: foozul ( a -- b ) M: reversed foozul ; @@ -228,7 +228,7 @@ USE: binary-search.private : node-successor-f-bug ( x -- * ) [ 3 throw ] [ empty-compound ] compose [ 3 throw ] if ; -[ t ] [ \ node-successor-f-bug compiled>> ] unit-test +[ t ] [ \ node-successor-f-bug optimized>> ] unit-test [ ] [ [ new ] build-tree optimize-tree drop ] unit-test @@ -242,7 +242,7 @@ USE: binary-search.private ] if ] if ; -[ t ] [ \ lift-throw-tail-regression compiled>> ] unit-test +[ t ] [ \ lift-throw-tail-regression optimized>> ] unit-test [ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test [ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test @@ -271,7 +271,7 @@ HINTS: recursive-inline-hang array ; : recursive-inline-hang-1 ( -- a ) { } recursive-inline-hang ; -[ t ] [ \ recursive-inline-hang-1 compiled>> ] unit-test +[ t ] [ \ recursive-inline-hang-1 optimized>> ] unit-test DEFER: recursive-inline-hang-3 diff --git a/basis/compiler/tests/peg-regression.factor b/basis/compiler/tests/peg-regression.factor index a0262fdc8..56a4021ee 100644 --- a/basis/compiler/tests/peg-regression.factor +++ b/basis/compiler/tests/peg-regression.factor @@ -22,5 +22,5 @@ pipeline = "hello" => [[ ast>pipeline-expr ]] USE: tools.test -[ t ] [ \ expr compiled>> ] unit-test -[ t ] [ \ ast>pipeline-expr compiled>> ] unit-test +[ t ] [ \ expr optimized>> ] unit-test +[ t ] [ \ ast>pipeline-expr optimized>> ] unit-test diff --git a/basis/compiler/tests/redefine1.factor b/basis/compiler/tests/redefine1.factor index 1b349d229..b5835de5f 100644 --- a/basis/compiler/tests/redefine1.factor +++ b/basis/compiler/tests/redefine1.factor @@ -23,36 +23,36 @@ M: integer method-redefine-test 3 + ; : hey ( -- ) ; : there ( -- ) hey ; -[ t ] [ \ hey compiled>> ] unit-test -[ t ] [ \ there compiled>> ] unit-test +[ t ] [ \ hey optimized>> ] unit-test +[ t ] [ \ there optimized>> ] unit-test [ ] [ "IN: compiler.tests : hey ( -- ) 3 ;" eval ] unit-test -[ f ] [ \ hey compiled>> ] unit-test -[ f ] [ \ there compiled>> ] unit-test +[ f ] [ \ hey optimized>> ] unit-test +[ f ] [ \ there optimized>> ] unit-test [ ] [ "IN: compiler.tests : hey ( -- ) ;" eval ] unit-test -[ t ] [ \ there compiled>> ] unit-test +[ t ] [ \ there optimized>> ] unit-test : good ( -- ) ; : bad ( -- ) good ; : ugly ( -- ) bad ; -[ t ] [ \ good compiled>> ] unit-test -[ t ] [ \ bad compiled>> ] unit-test -[ t ] [ \ ugly compiled>> ] unit-test +[ t ] [ \ good optimized>> ] unit-test +[ t ] [ \ bad optimized>> ] unit-test +[ t ] [ \ ugly optimized>> ] unit-test [ f ] [ \ good compiled-usage assoc-empty? ] unit-test [ ] [ "IN: compiler.tests : good ( -- ) 3 ;" eval ] unit-test -[ f ] [ \ good compiled>> ] unit-test -[ f ] [ \ bad compiled>> ] unit-test -[ f ] [ \ ugly compiled>> ] unit-test +[ f ] [ \ good optimized>> ] unit-test +[ f ] [ \ bad optimized>> ] unit-test +[ f ] [ \ ugly optimized>> ] unit-test [ t ] [ \ good compiled-usage assoc-empty? ] unit-test [ ] [ "IN: compiler.tests : good ( -- ) ;" eval ] unit-test -[ t ] [ \ good compiled>> ] unit-test -[ t ] [ \ bad compiled>> ] unit-test -[ t ] [ \ ugly compiled>> ] unit-test +[ t ] [ \ good optimized>> ] unit-test +[ t ] [ \ bad optimized>> ] unit-test +[ t ] [ \ ugly optimized>> ] unit-test [ f ] [ \ good compiled-usage assoc-empty? ] unit-test diff --git a/basis/compiler/tests/redefine3.factor b/basis/compiler/tests/redefine3.factor index 941d08631..b25b5a1a5 100644 --- a/basis/compiler/tests/redefine3.factor +++ b/basis/compiler/tests/redefine3.factor @@ -14,7 +14,7 @@ M: empty-mixin sheeple drop "wake up" ; : sheeple-test ( -- string ) { } sheeple ; [ "sheeple" ] [ sheeple-test ] unit-test -[ t ] [ \ sheeple-test compiled>> ] unit-test +[ t ] [ \ sheeple-test optimized>> ] unit-test [ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test [ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test @@ -27,6 +27,6 @@ M: empty-mixin sheeple drop "wake up" ; [ ] [ [ array empty-mixin remove-mixin-instance ] with-compilation-unit ] unit-test [ "sheeple" ] [ sheeple-test ] unit-test -[ t ] [ \ sheeple-test compiled>> ] unit-test +[ t ] [ \ sheeple-test optimized>> ] unit-test [ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test [ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor index c1e23c3e1..a6d6c5dfb 100644 --- a/basis/compiler/tests/simple.factor +++ b/basis/compiler/tests/simple.factor @@ -237,6 +237,6 @@ M: f single-combination-test-2 single-combination-test-4 ; 10 [ [ "compiler.tests.foo" forget-vocab ] with-compilation-unit [ t ] [ - "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) compiled>>" eval + "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized>>" eval ] unit-test ] times diff --git a/basis/compiler/tests/spilling.factor b/basis/compiler/tests/spilling.factor index ee8c2f056..4092352fd 100644 --- a/basis/compiler/tests/spilling.factor +++ b/basis/compiler/tests/spilling.factor @@ -47,7 +47,7 @@ IN: compiler.tests [ 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 ] [ 1.0 float-spill-bug ] unit-test -[ t ] [ \ float-spill-bug compiled>> ] unit-test +[ t ] [ \ float-spill-bug optimized>> ] unit-test : float-fixnum-spill-bug ( object -- object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object ) { @@ -132,7 +132,7 @@ IN: compiler.tests [ 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 ] [ 1.0 float-fixnum-spill-bug ] unit-test -[ t ] [ \ float-fixnum-spill-bug compiled>> ] unit-test +[ t ] [ \ float-fixnum-spill-bug optimized>> ] unit-test : resolve-spill-bug ( a b -- c ) [ 1 fixnum+fast ] bi@ dup 10 fixnum< [ @@ -159,7 +159,7 @@ IN: compiler.tests 16 narray ] if ; -[ t ] [ \ resolve-spill-bug compiled>> ] unit-test +[ t ] [ \ resolve-spill-bug optimized>> ] unit-test [ 4 ] [ 1 1 resolve-spill-bug ] unit-test diff --git a/basis/cpu/ppc/assembler/assembler.factor b/basis/cpu/ppc/assembler/assembler.factor index 0bb0d70ee..fbb878a88 100644 --- a/basis/cpu/ppc/assembler/assembler.factor +++ b/basis/cpu/ppc/assembler/assembler.factor @@ -97,10 +97,10 @@ X: XOR 0 316 31 X: XOR. 1 316 31 X1: EXTSB 0 954 31 X1: EXTSB. 1 954 31 -: FMR ( a s -- ) 0 -rot 72 0 63 x-insn ; -: FMR. ( a s -- ) 0 -rot 72 1 63 x-insn ; -: FCTIWZ ( a s -- ) 0 -rot 0 15 63 x-insn ; -: FCTIWZ. ( a s -- ) 0 -rot 1 15 63 x-insn ; +: FMR ( a s -- ) [ 0 ] 2dip 72 0 63 x-insn ; +: FMR. ( a s -- ) [ 0 ] 2dip 72 1 63 x-insn ; +: FCTIWZ ( a s -- ) [ 0 ] 2dip 0 15 63 x-insn ; +: FCTIWZ. ( a s -- ) [ 0 ] 2dip 1 15 63 x-insn ; ! XO-form XO: ADD 0 0 266 31 diff --git a/basis/cpu/ppc/assembler/backend/backend.factor b/basis/cpu/ppc/assembler/backend/backend.factor index a2c3a6c8d..c6a3a9419 100644 --- a/basis/cpu/ppc/assembler/backend/backend.factor +++ b/basis/cpu/ppc/assembler/backend/backend.factor @@ -74,8 +74,8 @@ IN: cpu.ppc.assembler.backend GENERIC# (B) 2 ( dest aa lk -- ) M: integer (B) 18 i-insn ; -M: word (B) 0 -rot (B) rc-relative-ppc-3 rel-word ; -M: label (B) 0 -rot (B) rc-relative-ppc-3 label-fixup ; +M: word (B) [ 0 ] 2dip (B) rc-relative-ppc-3 rel-word ; +M: label (B) [ 0 ] 2dip (B) rc-relative-ppc-3 label-fixup ; GENERIC: BC ( a b c -- ) M: integer BC 0 0 16 b-insn ; diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor index a094fbc54..1f55dcf76 100644 --- a/basis/db/postgresql/postgresql.factor +++ b/basis/db/postgresql/postgresql.factor @@ -55,8 +55,10 @@ M: generator-bind postgresql-bind-conversion ( tuple generate-bind -- object ) [ swap slot-name>> rot set-slot-named ] [ ] bi ; M: postgresql-statement bind-tuple ( tuple statement -- ) - tuck in-params>> - [ postgresql-bind-conversion ] with map + [ nip ] [ + in-params>> + [ postgresql-bind-conversion ] with map + ] 2bi >>bind-params drop ; M: postgresql-result-set #rows ( result-set -- n ) diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor index d2116058d..219116aef 100644 --- a/basis/db/tuples/tuples.factor +++ b/basis/db/tuples/tuples.factor @@ -73,9 +73,10 @@ PRIVATE> ! High level ERROR: no-slots-named class seq ; : check-columns ( class columns -- ) - tuck - [ [ first ] map ] - [ all-slots [ name>> ] map ] bi* diff + [ nip ] [ + [ [ first ] map ] + [ all-slots [ name>> ] map ] bi* diff + ] 2bi [ drop ] [ no-slots-named ] if-empty ; : define-persistent ( class table columns -- ) diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor index 33b892334..2d4a6ff5f 100644 --- a/basis/db/types/types.factor +++ b/basis/db/types/types.factor @@ -42,10 +42,10 @@ ERROR: no-slot ; slot-named dup [ no-slot ] unless offset>> ; : get-slot-named ( name tuple -- value ) - tuck offset-of-slot slot ; + [ nip ] [ offset-of-slot ] 2bi slot ; : set-slot-named ( value name obj -- ) - tuck offset-of-slot set-slot ; + [ nip ] [ offset-of-slot ] 2bi set-slot ; ERROR: not-persistent class ; diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index 73a6b208d..8a5e695a7 100755 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -196,8 +196,8 @@ LOG: httpd-hit NOTICE LOG: httpd-header NOTICE -: log-header ( headers name -- ) - tuck header 2array httpd-header ; +: log-header ( request name -- ) + [ nip ] [ header ] 2bi 2array httpd-header ; : log-request ( request -- ) [ [ method>> ] [ url>> ] bi 2array httpd-hit ] diff --git a/basis/interval-maps/interval-maps.factor b/basis/interval-maps/interval-maps.factor index 34e43ddc7..4fd4592ee 100644 --- a/basis/interval-maps/interval-maps.factor +++ b/basis/interval-maps/interval-maps.factor @@ -31,7 +31,8 @@ PRIVATE> : interval-at* ( key map -- value ? ) [ drop ] [ array>> find-interval ] 2bi - tuck interval-contains? [ third t ] [ drop f f ] if ; + [ nip ] [ interval-contains? ] 2bi + [ third t ] [ drop f f ] if ; : interval-at ( key map -- value ) interval-at* drop ; diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor index c2955d397..a6dacc184 100755 --- a/basis/io/directories/windows/windows.factor +++ b/basis/io/directories/windows/windows.factor @@ -33,13 +33,13 @@ M: windows delete-directory ( path -- ) RemoveDirectory win32-error=0/f ; : find-first-file ( path -- WIN32_FIND_DATA handle ) - "WIN32_FIND_DATA" tuck - FindFirstFile + "WIN32_FIND_DATA" + [ nip ] [ FindFirstFile ] 2bi [ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ; : find-next-file ( path -- WIN32_FIND_DATA/f ) - "WIN32_FIND_DATA" tuck - FindNextFile 0 = [ + "WIN32_FIND_DATA" + [ nip ] [ FindNextFile ] 2bi 0 = [ GetLastError ERROR_NO_MORE_FILES = [ win32-error ] unless drop f diff --git a/basis/io/encodings/ascii/ascii.factor b/basis/io/encodings/ascii/ascii.factor index 0803ba387..d971cf2e6 100644 --- a/basis/io/encodings/ascii/ascii.factor +++ b/basis/io/encodings/ascii/ascii.factor @@ -9,7 +9,8 @@ IN: io.encodings.ascii : decode-if< ( stream encoding max -- character ) nip swap stream-read1 dup - [ tuck > [ >fixnum ] [ drop replacement-char ] if ] [ 2drop f ] if ; inline + [ [ nip ] [ > ] 2bi [ >fixnum ] [ drop replacement-char ] if ] + [ 2drop f ] if ; inline PRIVATE> SINGLETON: ascii diff --git a/basis/io/files/info/unix/freebsd/freebsd.factor b/basis/io/files/info/unix/freebsd/freebsd.factor index 11025e14e..61d7a1d92 100644 --- a/basis/io/files/info/unix/freebsd/freebsd.factor +++ b/basis/io/files/info/unix/freebsd/freebsd.factor @@ -13,7 +13,7 @@ version io-size owner syncreads syncwrites asyncreads asyncwrites ; M: freebsd new-file-system-info freebsd-file-system-info new ; M: freebsd file-system-statfs ( path -- byte-array ) - "statfs" tuck statfs io-error ; + "statfs" [ statfs io-error ] keep ; M: freebsd statfs>file-system-info ( file-system-info statvfs -- file-system-info ) { @@ -40,7 +40,7 @@ M: freebsd statfs>file-system-info ( file-system-info statvfs -- file-system-inf } cleave ; M: freebsd file-system-statvfs ( path -- byte-array ) - "statvfs" tuck statvfs io-error ; + "statvfs" [ statvfs io-error ] keep ; M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info ) { diff --git a/basis/io/files/info/unix/linux/linux.factor b/basis/io/files/info/unix/linux/linux.factor index b447b6e54..5dddca4f9 100644 --- a/basis/io/files/info/unix/linux/linux.factor +++ b/basis/io/files/info/unix/linux/linux.factor @@ -14,7 +14,7 @@ namelen ; M: linux new-file-system-info linux-file-system-info new ; M: linux file-system-statfs ( path -- byte-array ) - "statfs64" tuck statfs64 io-error ; + "statfs64" [ statfs64 io-error ] keep ; M: linux statfs>file-system-info ( struct -- statfs ) { @@ -32,7 +32,7 @@ M: linux statfs>file-system-info ( struct -- statfs ) } cleave ; M: linux file-system-statvfs ( path -- byte-array ) - "statvfs64" tuck statvfs64 io-error ; + "statvfs64" [ statvfs64 io-error ] keep ; M: linux statvfs>file-system-info ( struct -- statfs ) { diff --git a/basis/io/files/info/unix/macosx/macosx.factor b/basis/io/files/info/unix/macosx/macosx.factor index 53992bcb9..cfc13ba01 100644 --- a/basis/io/files/info/unix/macosx/macosx.factor +++ b/basis/io/files/info/unix/macosx/macosx.factor @@ -20,10 +20,10 @@ M: macosx file-systems ( -- array ) M: macosx new-file-system-info macosx-file-system-info new ; M: macosx file-system-statfs ( normalized-path -- statfs ) - "statfs64" tuck statfs64 io-error ; + "statfs64" [ statfs64 io-error ] keep ; M: macosx file-system-statvfs ( normalized-path -- statvfs ) - "statvfs" tuck statvfs io-error ; + "statvfs" [ statvfs io-error ] keep ; M: macosx statfs>file-system-info ( file-system-info byte-array -- file-system-info' ) { diff --git a/basis/io/files/info/unix/netbsd/netbsd.factor b/basis/io/files/info/unix/netbsd/netbsd.factor index 6dc0bb3f8..4f284b5f4 100644 --- a/basis/io/files/info/unix/netbsd/netbsd.factor +++ b/basis/io/files/info/unix/netbsd/netbsd.factor @@ -16,7 +16,7 @@ idx mount-from ; M: netbsd new-file-system-info netbsd-file-system-info new ; M: netbsd file-system-statvfs - "statvfs" tuck statvfs io-error ; + "statvfs" [ statvfs io-error ] keep ; M: netbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info' ) { diff --git a/basis/io/files/info/unix/openbsd/openbsd.factor b/basis/io/files/info/unix/openbsd/openbsd.factor index 62783a968..0fe4c4bec 100644 --- a/basis/io/files/info/unix/openbsd/openbsd.factor +++ b/basis/io/files/info/unix/openbsd/openbsd.factor @@ -14,7 +14,7 @@ owner ; M: openbsd new-file-system-info freebsd-file-system-info new ; M: openbsd file-system-statfs - "statfs" tuck statfs io-error ; + "statfs" [ statfs io-error ] keep ; M: openbsd statfs>file-system-info ( file-system-info statfs -- file-system-info' ) { @@ -41,7 +41,7 @@ M: openbsd statfs>file-system-info ( file-system-info statfs -- file-system-info } cleave ; M: openbsd file-system-statvfs ( normalized-path -- statvfs ) - "statvfs" tuck statvfs io-error ; + "statvfs" [ statvfs io-error ] keep ; M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info' ) { diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index 6eb61a24a..1fe717d5e 100644 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -99,7 +99,7 @@ TUPLE: output-port < buffered-port ; output-port ; : wait-to-write ( len port -- ) - tuck buffer>> buffer-capacity <= + [ nip ] [ buffer>> buffer-capacity <= ] 2bi [ drop ] [ stream-flush ] if ; inline M: output-port stream-write1 diff --git a/basis/io/sockets/windows/nt/nt.factor b/basis/io/sockets/windows/nt/nt.factor index f6a1bcfcb..49a1b2ae6 100644 --- a/basis/io/sockets/windows/nt/nt.factor +++ b/basis/io/sockets/windows/nt/nt.factor @@ -6,7 +6,7 @@ libc math sequences threads system combinators accessors ; IN: io.sockets.windows.nt : malloc-int ( object -- object ) - "int" heap-size malloc tuck 0 set-alien-signed-4 ; inline + "int" heap-size malloc [ nip ] [ 0 set-alien-signed-4 ] 2bi ; inline M: winnt WSASocket-flags ( -- DWORD ) WSA_FLAG_OVERLAPPED ; diff --git a/basis/match/match.factor b/basis/match/match.factor index fee06686b..3846dea3b 100644 --- a/basis/match/match.factor +++ b/basis/match/match.factor @@ -80,7 +80,7 @@ MACRO: match-cond ( assoc -- ) (match-first) drop ; : (match-all) ( seq pattern-seq -- ) - tuck (match-first) swap + [ nip ] [ (match-first) swap ] 2bi [ , [ swap (match-all) ] [ drop ] if* ] [ 2drop ] if* ; diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index ff52c1704..85b4d711a 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -122,11 +122,9 @@ PRIVATE> [ * ] 2keep gcd nip /i ; foldable : mod-inv ( x n -- y ) - tuck gcd 1 = [ - dup 0 < [ + ] [ nip ] if - ] [ - "Non-trivial divisor found" throw - ] if ; foldable + [ nip ] [ gcd 1 = ] 2bi + [ dup 0 < [ + ] [ nip ] if ] + [ "Non-trivial divisor found" throw ] if ; foldable : ^mod ( x y n -- z ) over 0 < [ diff --git a/basis/math/polynomials/polynomials.factor b/basis/math/polynomials/polynomials.factor index 13090b648..5783dfdf4 100644 --- a/basis/math/polynomials/polynomials.factor +++ b/basis/math/polynomials/polynomials.factor @@ -68,7 +68,8 @@ PRIVATE> dup V{ 0 } clone p= [ drop nip ] [ - tuck p/mod [ pick p* swap [ swapd p- ] dip ] dip (pgcd) + [ nip ] [ p/mod ] 2bi + [ pick p* swap [ swapd p- ] dip ] dip (pgcd) ] if ; PRIVATE> diff --git a/basis/math/ratios/ratios.factor b/basis/math/ratios/ratios.factor index 15914e7b0..e44dbd1a7 100644 --- a/basis/math/ratios/ratios.factor +++ b/basis/math/ratios/ratios.factor @@ -24,7 +24,7 @@ M: integer / "Division by zero" throw ] [ dup 0 < [ [ neg ] bi@ ] when - 2dup gcd nip tuck /i [ /i ] dip fraction> + 2dup gcd nip tuck [ /i ] 2bi@ fraction> ] if ; M: ratio hashcode* diff --git a/basis/mime/multipart/multipart.factor b/basis/mime/multipart/multipart.factor index 10ddb926d..1cea70786 100755 --- a/basis/mime/multipart/multipart.factor +++ b/basis/mime/multipart/multipart.factor @@ -54,7 +54,9 @@ ERROR: end-of-stream multipart ; ] if ; : dump-until-separator ( multipart -- multipart ) - dup [ current-separator>> ] [ bytes>> ] bi tuck start [ + dup + [ current-separator>> ] [ bytes>> ] bi + [ nip ] [ start ] 2bi [ cut-slice [ mime-write ] [ over current-separator>> length tail-slice >>bytes ] bi* diff --git a/basis/persistent/hashtables/nodes/leaf/leaf.factor b/basis/persistent/hashtables/nodes/leaf/leaf.factor index 3419e8387..94174d566 100644 --- a/basis/persistent/hashtables/nodes/leaf/leaf.factor +++ b/basis/persistent/hashtables/nodes/leaf/leaf.factor @@ -6,7 +6,8 @@ persistent.hashtables.nodes ; IN: persistent.hashtables.nodes.leaf : matching-key? ( key hashcode leaf-node -- ? ) - tuck hashcode>> eq? [ key>> = ] [ 2drop f ] if ; inline + [ nip ] [ hashcode>> eq? ] 2bi + [ key>> = ] [ 2drop f ] if ; inline M: leaf-node (entry-at) [ matching-key? ] keep and ; diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index b3800babe..95f05c21f 100644 --- a/basis/prettyprint/prettyprint.factor +++ b/basis/prettyprint/prettyprint.factor @@ -248,7 +248,8 @@ GENERIC: declarations. ( obj -- ) M: object declarations. drop ; : declaration. ( word prop -- ) - tuck name>> word-prop [ pprint-word ] [ drop ] if ; + [ nip ] [ name>> word-prop ] 2bi + [ pprint-word ] [ drop ] if ; M: word declarations. { diff --git a/basis/regexp/dfa/dfa.factor b/basis/regexp/dfa/dfa.factor index c3e98ae1e..549669cab 100644 --- a/basis/regexp/dfa/dfa.factor +++ b/basis/regexp/dfa/dfa.factor @@ -72,7 +72,7 @@ IN: regexp.dfa dup [ nfa-traversal-flags>> ] [ dfa-table>> transitions>> keys ] bi - [ tuck [ swap at ] with map concat ] with H{ } map>assoc + [ [ nip ] [ [ swap at ] with map concat ] 2bi ] with H{ } map>assoc >>dfa-traversal-flags drop ; : construct-dfa ( regexp -- ) diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor index 2f397538a..377535ecc 100644 --- a/basis/regexp/parser/parser.factor +++ b/basis/regexp/parser/parser.factor @@ -63,7 +63,7 @@ left-parenthesis pipe caret dash ; : cut-out ( vector n -- vector' vector ) cut rest ; ERROR: cut-stack-error ; : cut-stack ( obj vector -- vector' vector ) - tuck last-index [ cut-stack-error ] unless* cut-out swap ; + [ nip ] [ last-index ] 2bi [ cut-stack-error ] unless* cut-out swap ; : ( obj -- kleene ) possessive-kleene-star boa ; : ( obj -- kleene ) reluctant-kleene-star boa ; diff --git a/basis/regexp/transition-tables/transition-tables.factor b/basis/regexp/transition-tables/transition-tables.factor index 5375d813e..e5c31a54e 100644 --- a/basis/regexp/transition-tables/transition-tables.factor +++ b/basis/regexp/transition-tables/transition-tables.factor @@ -35,7 +35,7 @@ TUPLE: transition-table transitions start-state final-states ; H{ } clone >>final-states ; : maybe-initialize-key ( key hashtable -- ) - 2dup key? [ 2drop ] [ H{ } clone -rot set-at ] if ; + 2dup key? [ 2drop ] [ [ H{ } clone ] 2dip set-at ] if ; : set-transition ( transition hash -- ) #! set the state as a key diff --git a/basis/serialize/serialize.factor b/basis/serialize/serialize.factor index 3ec1e96c7..4a0d3777b 100644 --- a/basis/serialize/serialize.factor +++ b/basis/serialize/serialize.factor @@ -221,8 +221,7 @@ SYMBOL: deserialized (deserialize) (deserialize) 2dup lookup dup [ 2nip ] [ drop - "Unknown word: " -rot - 2array unparse append throw + 2array unparse "Unknown word: " prepend throw ] if ; : deserialize-gensym ( -- word ) diff --git a/basis/syndication/syndication.factor b/basis/syndication/syndication.factor index c82fe4006..9d0419a81 100644 --- a/basis/syndication/syndication.factor +++ b/basis/syndication/syndication.factor @@ -9,7 +9,7 @@ USING: xml.utilities kernel assocs xml.generator math.order IN: syndication : any-tag-named ( tag names -- tag-inside ) - f -rot [ tag-named nip dup ] with find 2drop ; + [ f ] 2dip [ tag-named nip dup ] with find 2drop ; TUPLE: feed title url entries ; diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index 67386c180..dc2cedfef 100755 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -350,7 +350,7 @@ M: editor gadget-text* editor-string % ; dupd editor-select-next mark>caret ; : editor-select ( from to editor -- ) - tuck caret>> set-model mark>> set-model ; + tuck [ mark>> set-model ] [ caret>> set-model ] 2bi* ; : select-elt ( editor elt -- ) [ [ [ editor-caret* ] [ model>> ] bi ] dip prev/next-elt ] [ drop ] 2bi diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor index baf025d11..e5a2b5309 100644 --- a/basis/ui/gadgets/gadgets.factor +++ b/basis/ui/gadgets/gadgets.factor @@ -165,7 +165,9 @@ M: gadget dim-changed in-layout? get [ invalidate ] [ invalidate* ] if ; M: gadget (>>dim) ( dim gadget -- ) - 2dup dim>> = [ 2drop ] [ tuck call-next-method dim-changed ] if ; + 2dup dim>> = + [ 2drop ] + [ [ nip ] [ call-next-method ] 2bi dim-changed ] if ; GENERIC: pref-dim* ( gadget -- dim ) @@ -250,7 +252,7 @@ M: gadget ungraft* drop ; f >>parent drop ; : unfocus-gadget ( child gadget -- ) - tuck focus>> eq? [ f >>focus ] when drop ; + [ nip ] [ focus>> eq? ] 2bi [ f >>focus ] when drop ; SYMBOL: in-layout? @@ -286,10 +288,7 @@ SYMBOL: in-layout? dup unparent over >>parent tuck ((add-gadget)) - tuck graft-state>> second - [ graft ] - [ drop ] - if ; + tuck graft-state>> second [ graft ] [ drop ] if ; : add-gadget ( parent child -- parent ) not-in-layout @@ -316,7 +315,7 @@ SYMBOL: in-layout? : (screen-rect) ( gadget -- loc ext ) dup parent>> [ [ rect-extent ] dip (screen-rect) - [ tuck v+ ] dip vmin [ v+ ] dip + [ [ nip ] [ v+ ] 2bi ] dip [ vmin ] [ v+ ] 2bi* ] [ rect-extent ] if* ; diff --git a/basis/ui/gadgets/incremental/incremental.factor b/basis/ui/gadgets/incremental/incremental.factor index af249bbdc..2b33d2bfe 100644 --- a/basis/ui/gadgets/incremental/incremental.factor +++ b/basis/ui/gadgets/incremental/incremental.factor @@ -23,7 +23,7 @@ M: incremental pref-dim* ] keep orientation>> set-axis ; : update-cursor ( gadget incremental -- ) - tuck next-cursor >>cursor drop ; + [ nip ] [ next-cursor ] 2bi >>cursor drop ; : incremental-loc ( gadget incremental -- ) [ cursor>> ] [ orientation>> ] bi v* diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor index 336d99657..6bcf8b50c 100644 --- a/basis/unicode/breaks/breaks.factor +++ b/basis/unicode/breaks/breaks.factor @@ -96,7 +96,7 @@ PRIVATE> : first-grapheme ( str -- i ) unclip-slice grapheme-class over - [ grapheme-class tuck grapheme-break? ] find drop + [ grapheme-class [ nip ] [ grapheme-break? ] 2bi ] find drop nip swap length or 1+ ; : filter-ignorable ( weights -- weights' ) f swap [ - tuck primary>> zero? and + [ nip ] [ primary>> zero? and ] 2bi [ swap ignorable?>> or ] [ swap completely-ignorable? or not ] 2bi ] filter nip ; diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index c2b5ad4ea..42444261e 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -155,8 +155,8 @@ FUNCTION: int utime ( char* path, utimebuf* buf ) ; : change-file-times ( filename access modification -- ) "utimebuf" - tuck set-utimbuf-modtime - tuck set-utimbuf-actime + [ set-utimbuf-modtime ] keep + [ set-utimbuf-actime ] keep [ utime ] unix-system-call drop ; FUNCTION: int pclose ( void* file ) ; diff --git a/basis/x11/clipboard/clipboard.factor b/basis/x11/clipboard/clipboard.factor index 472488ddc..d3fe0a844 100644 --- a/basis/x11/clipboard/clipboard.factor +++ b/basis/x11/clipboard/clipboard.factor @@ -41,7 +41,7 @@ TUPLE: x-clipboard atom contents ; ] if ; : own-selection ( prop win -- ) - dpy get -rot CurrentTime XSetSelectionOwner drop + [ dpy get ] 2dip CurrentTime XSetSelectionOwner drop flush-dpy ; : set-targets-prop ( evt -- ) diff --git a/basis/x11/windows/windows.factor b/basis/x11/windows/windows.factor index 67ece9d1c..be9f8cf7a 100644 --- a/basis/x11/windows/windows.factor +++ b/basis/x11/windows/windows.factor @@ -37,7 +37,7 @@ IN: x11.windows : set-size-hints ( window -- ) "XSizeHints" USPosition over set-XSizeHints-flags - dpy get -rot XSetWMNormalHints ; + [ dpy get ] 2dip XSetWMNormalHints ; : auto-position ( window loc -- ) { 0 0 } = [ drop ] [ set-size-hints ] if ; diff --git a/basis/xml/data/data.factor b/basis/xml/data/data.factor index 8c024d938..9d84791c1 100644 --- a/basis/xml/data/data.factor +++ b/basis/xml/data/data.factor @@ -62,7 +62,8 @@ M: attrs assoc-like M: attrs clear-assoc f >>alist drop ; M: attrs delete-at - tuck attr@ drop [ swap alist>> delete-nth ] [ drop ] if* ; + [ nip ] [ attr@ drop ] 2bi + [ swap alist>> delete-nth ] [ drop ] if* ; M: attrs clone alist>> clone ; diff --git a/basis/xmode/marker/marker.factor b/basis/xmode/marker/marker.factor index 3e632cc5a..798807f19 100644 --- a/basis/xmode/marker/marker.factor +++ b/basis/xmode/marker/marker.factor @@ -100,7 +100,7 @@ DEFER: get-rules [ ch>upper ] dip rules>> at ?push-all ; : get-rules ( char ruleset -- seq ) - f -rot [ get-char-rules ] keep get-always-rules ; + [ f ] 2dip [ get-char-rules ] keep get-always-rules ; GENERIC: handle-rule-start ( match-count rule -- ) diff --git a/basis/xmode/utilities/utilities.factor b/basis/xmode/utilities/utilities.factor index b5a2f6eb9..871767ccf 100644 --- a/basis/xmode/utilities/utilities.factor +++ b/basis/xmode/utilities/utilities.factor @@ -7,7 +7,7 @@ IN: xmode.utilities : child-tags ( tag -- seq ) children>> [ tag? ] filter ; : map-find ( seq quot -- result elt ) - f -rot + [ f ] 2dip '[ nip @ dup ] find [ [ drop f ] unless ] dip ; inline diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 7f34c3b19..a2eb2d25e 100644 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -188,7 +188,7 @@ M: sequence new-assoc drop ; M: sequence clear-assoc delete-all ; M: sequence delete-at - tuck search-alist nip + [ nip ] [ search-alist nip ] 2bi [ swap delete-nth ] [ drop ] if* ; M: sequence assoc-size length ; diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index 4625c665b..e71379ac1 100644 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -215,7 +215,7 @@ M: anonymous-complement (classes-intersect?) : min-class ( class seq -- class/f ) over [ classes-intersect? ] curry filter [ drop f ] [ - tuck [ class<= ] with all? [ peek ] [ drop f ] if + [ nip ] [ [ class<= ] with all? ] 2bi [ peek ] [ drop f ] if ] if-empty ; GENERIC: (flatten-class) ( class -- ) diff --git a/core/classes/classes.factor b/core/classes/classes.factor index acff3d57e..8145730f4 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -162,7 +162,7 @@ GENERIC: update-methods ( class seq -- ) dup "predicate" word-prop dup length 1 = [ first - tuck "predicating" word-prop = + [ nip ] [ "predicating" word-prop = ] 2bi [ forget ] [ drop ] if ] [ 2drop ] if ; diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index 2470c0087..1261d44a6 100644 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -54,7 +54,7 @@ TUPLE: check-mixin-class class ; #! class-usages of the member, now that it's been added. [ 2drop ] [ [ [ suffix ] change-mixin-class ] 2keep - tuck [ new-class? ] either? [ + [ nip ] [ [ new-class? ] either? ] 2bi [ update-classes/new ] [ update-classes diff --git a/core/compiler/units/units-tests.factor b/core/compiler/units/units-tests.factor index 884207b90..ba990b424 100644 --- a/core/compiler/units/units-tests.factor +++ b/core/compiler/units/units-tests.factor @@ -1,6 +1,6 @@ IN: compiler.units.tests USING: definitions compiler.units tools.test arrays sequences words kernel -accessors ; +accessors namespaces fry ; [ flushed-dependency ] [ f flushed-dependency strongest-dependency ] unit-test [ flushed-dependency ] [ flushed-dependency f strongest-dependency ] unit-test @@ -9,8 +9,22 @@ accessors ; [ flushed-dependency ] [ called-dependency flushed-dependency strongest-dependency ] unit-test [ called-dependency ] [ called-dependency f strongest-dependency ] unit-test -! Non-optimizing compiler bug +! Non-optimizing compiler bugs [ 1 1 ] [ "A" "B" [ [ 1 ] dip ] >>def dup f 2array 1array f modify-code-heap 1 swap execute +] unit-test + +[ "A" "B" ] [ + gensym "a" set + gensym "b" set + [ + "a" get [ "A" ] define + "b" get "a" get '[ _ execute ] define + ] with-compilation-unit + "b" get execute + [ + "a" get [ "B" ] define + ] with-compilation-unit + "b" get execute ] unit-test \ No newline at end of file diff --git a/core/effects/parser/parser.factor b/core/effects/parser/parser.factor index 77bcd7cad..6b7e953b6 100644 --- a/core/effects/parser/parser.factor +++ b/core/effects/parser/parser.factor @@ -9,7 +9,7 @@ DEFER: parse-effect ERROR: bad-effect ; : parse-effect-token ( end -- token/f ) - scan tuck = [ drop f ] [ + scan [ nip ] [ = ] 2bi [ drop f ] [ dup { f "(" "((" } member? [ bad-effect ] [ ":" ?tail [ scan-word { diff --git a/core/generic/generic.factor b/core/generic/generic.factor index 4eb39291a..c16b6a52a 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -36,7 +36,8 @@ PREDICATE: method-spec < pair "methods" word-prop keys sort-classes ; : specific-method ( class generic -- method/f ) - tuck order min-class dup [ swap method ] [ 2drop f ] if ; + [ nip ] [ order min-class ] 2bi + dup [ swap method ] [ 2drop f ] if ; GENERIC: effective-method ( generic -- method ) diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor index 9268340c7..8aa13a5f5 100644 --- a/core/hashtables/hashtables.factor +++ b/core/hashtables/hashtables.factor @@ -104,7 +104,7 @@ M: hashtable clear-assoc ( hash -- ) [ init-hash ] [ array>> [ drop ((empty)) ] change-each ] bi ; M: hashtable delete-at ( key hash -- ) - tuck key@ [ + [ nip ] [ key@ ] 2bi [ [ ((tombstone)) dup ] 2dip set-nth-pair hash-deleted+ ] [ diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 81ed91290..3c915cb07 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -254,7 +254,7 @@ print-use-hook global [ [ ] or ] change-at [ [ lines dup parse-fresh - tuck finish-parsing + [ nip ] [ finish-parsing ] 2bi forget-smudged ] with-source-file ] with-compilation-unit ; diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 061da0566..2a5c0c674 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -138,15 +138,15 @@ INSTANCE: iota immutable-sequence : from-end ( seq n -- seq n' ) [ dup length ] dip - ; inline : (2sequence) ( obj1 obj2 seq -- seq ) - tuck 1 swap set-nth-unsafe - tuck 0 swap set-nth-unsafe ; inline + [ 1 swap set-nth-unsafe ] keep + [ 0 swap set-nth-unsafe ] keep ; inline : (3sequence) ( obj1 obj2 obj3 seq -- seq ) - tuck 2 swap set-nth-unsafe + [ 2 swap set-nth-unsafe ] keep (2sequence) ; inline : (4sequence) ( obj1 obj2 obj3 obj4 seq -- seq ) - tuck 3 swap set-nth-unsafe + [ 3 swap set-nth-unsafe ] keep (3sequence) ; inline PRIVATE> @@ -723,14 +723,14 @@ PRIVATE> 2dup shorter? [ 2drop f ] [ - tuck length head-slice sequence= + [ nip ] [ length head-slice ] 2bi sequence= ] if ; : tail? ( seq end -- ? ) 2dup shorter? [ 2drop f ] [ - tuck length tail-slice* sequence= + [ nip ] [ length tail-slice* ] 2bi sequence= ] if ; : cut-slice ( seq n -- before-slice after-slice )