Remove some usages of tuck

diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor
index bbd7df91089d858c2fa98c661f516164f876cae5..3e3c4a93aa13cdbee681fd03dcde8cad763e51c9 100644 (file)
--- 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 3d17009e311c695b199de9451ded4a0ded547adc..8ee120012d213501a6cd9ee30c925259112fdb25 100644 (file)
--- 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 bb1cb2eab5079f8a89d56076a137f2e8de09080f..c5bbe4a6c3937693ee0decb15c4f9af875a6690e 100644 (file)
--- 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 <tuple> with a non-literal class failed
 : <tuple>-regression ( class -- tuple ) <tuple> ;
 
-[ t ] [ \ <tuple>-regression compiled>> ] unit-test
+[ t ] [ \ <tuple>-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 a0262fdc819ffebe0b972f85835ba31a20cd5120..56a4021eed3e9f995fba9effb38eee1131651a4a 100644 (file)
--- 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 1b349d2296de31dead616154a71c4353ea979688..b5835de5fd08180769274e89ddc2c5b25ac1d593 100644 (file)
--- 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 941d0863124340351bd3b6eea236bcea7070c3a7..b25b5a1a5e2dabc37744a10a01fb3ed22f057984 100644 (file)
--- 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 c1e23c3e1e482c685ac8ee3eb4ab3ca13a8c6912..a6d6c5dfb9ac8812387a300ad6f85587c3112cee 100644 (file)
--- 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 ee8c2f056a97fecd2611224e24243b6595c63fce..4092352fd5930d154a5f305fe444f522c8e64f2a 100644 (file)
--- 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 0bb0d70ee077bef4a34992164760a5cface81da9..fbb878a888044f01f1b178a55b18b38b98cf7083 100644 (file)
--- 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 a2c3a6c8d519723aa81697732ac8a1070247edef..c6a3a941949dfb0eca459d232c75056500b4a53e 100644 (file)
--- 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 a094fbc542ac3ca1eace837be31a95615f04f38e..1f55dcf769669e587993cb6a8345d4f28be32552 100644 (file)
--- 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 ] [ <low-level-binding> ] 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 d2116058d8d8972f51742a0760861063c2c8e46a..219116aefd0ddfc5ba5f2ec247f9ad2aea07a4b2 100644 (file)
--- 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 33b89233476b5a19d558423366f2db19d051ddb0..2d4a6ff5fb094cbb1e2229416910dd179ce1534c 100644 (file)
--- 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 73a6b208d8167da41ad3ec3334a6edab7d9cc1a1..8a5e695a70a541ad5b746a9ed549f9fbedc091e3 100755 (executable)
--- 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 34e43ddc7583729f804830f35233377e83e5b9cf..4fd4592ee15cae45e85984fdfd19868bfe97a243 100644 (file)
--- a/basis/interval-maps/interval-maps.factor
+++ b/basis/interval-maps/interval-maps.factor
@@ -31,7 +31,8 @@ PRIVATE>
 \r
 : interval-at* ( key map -- value ? )\r
     [ drop ] [ array>> find-interval ] 2bi\r
-    tuck interval-contains? [ third t ] [ drop f f ] if ;\r
+    [ nip ] [ interval-contains? ] 2bi\r
+    [ third t ] [ drop f f ] if ;\r
 \r
 : interval-at ( key map -- value ) interval-at* drop ;\r
 \r

diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor
index c2955d397743e6642a0f2a00180c2d154c73a2d9..a6dacc18411c555edc6c1552a6b46e432166e8a6 100755 (executable)
--- 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" <c-object> tuck
-    FindFirstFile
+    "WIN32_FIND_DATA" <c-object>
+    [ nip ] [ FindFirstFile ] 2bi
     [ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ;
 
 : find-next-file ( path -- WIN32_FIND_DATA/f )
-    "WIN32_FIND_DATA" <c-object> tuck
-    FindNextFile 0 = [
+    "WIN32_FIND_DATA" <c-object>
+    [ 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 0803ba3871be14008780484d1829759e87a525a5..d971cf2e60ad26bd2e064a00e7fa8262d783f9cc 100644 (file)
--- 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 11025e14e60f10515f9300486190fa4d2bf3f9c3..61d7a1d92118ade4effb6fffc4a4bc8bca361e25 100644 (file)
--- 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" <c-object> tuck statfs io-error ;
+    "statfs" <c-object> [ 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" <c-object> tuck statvfs io-error ;
+    "statvfs" <c-object> [ 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 b447b6e54fc4f6576c1a8588e6a825f3209126c5..5dddca4f9d005928402609ee44f0a29f2b3afbf4 100644 (file)
--- 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" <c-object> tuck statfs64 io-error ;
+    "statfs64" <c-object> [ 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" <c-object> tuck statvfs64 io-error ;
+    "statvfs64" <c-object> [ 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 53992bcb952daf9e03752ad7a04e8266e19ff970..cfc13ba015790a0c295f9d5e54e52857e0705ba6 100644 (file)
--- 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" <c-object> tuck statfs64 io-error ;
+    "statfs64" <c-object> [ statfs64 io-error ] keep ;
 
 M: macosx file-system-statvfs ( normalized-path -- statvfs )
-    "statvfs" <c-object> tuck statvfs io-error ;
+    "statvfs" <c-object> [ 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 6dc0bb3f8767c8d6d7b87cd5d5a7d8325b6b9f53..4f284b5f44810a3eedf5963cd92147f01201fc82 100644 (file)
--- 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" <c-object> tuck statvfs io-error ;
+    "statvfs" <c-object> [ 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 62783a968ba52b6c734d37594b993916be1d4476..0fe4c4bec0243341a743fdc25e0d0c9aca6b5e28 100644 (file)
--- 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" <c-object> tuck statfs io-error ;
+    "statfs" <c-object> [ 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" <c-object> tuck statvfs io-error ;
+    "statvfs" <c-object> [ 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 6eb61a24a7e829f8b751677e5e01006f3772cf5f..1fe717d5ee662d46b02ee1e02a93414de33f4f6e 100644 (file)
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -99,7 +99,7 @@ TUPLE: output-port < buffered-port ;
     output-port <buffered-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 f6a1bcfcb0554cd030e2de4ad7c069fa9438238c..49a1b2ae632491bad17de851abf6a25b5eefcd5e 100644 (file)
--- 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 fee06686b8ffe68f39d60b6a71e425716ccedfd9..3846dea3be6317944c30690230c60c36daca12cf 100644 (file)
--- 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 ff52c17047e98c0cac336d9b84d8f6c0bb308bd3..85b4d711ac045e1bf726c8e0828a0ec933e0d087 100644 (file)
--- 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 13090b64866e9314b3ff888f03b0f039789f9815..5783dfdf4125a4ef5ba9c144d1c9aaa577e0ced4 100644 (file)
--- 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 15914e7b05d4d9d91d5138dcf8ef644c29e01927..e44dbd1a757f8e01fe4c5e0d8522185ca7437497 100644 (file)
--- 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 10ddb926dda7191750c3b6418188d7f4dfae4790..1cea707862f8b6326781f2e3c4c9308130ec3930 100755 (executable)
--- 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 3419e8387fc9bb748063b183a81f05fc4230ed21..94174d566704019b34a6c976b27d3546f8791616 100644 (file)
--- 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 b3800babe8fdb3a4ca76038b87931d4db07710af..95f05c21ffbdff0a24b9413ffd26dfa71ce62951 100644 (file)
--- 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 c3e98ae1ec2f66a4ae6424ef39d1747f1531b092..549669cab727328eabd5fd6244d247fb52495160 100644 (file)
--- 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 2f397538a065f257185488be0e2093614c4a4c2c..377535eccd1aac074ac4b39bbfc18472c860bcc5 100644 (file)
--- 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 ;
 
 : <possessive-kleene-star> ( obj -- kleene ) possessive-kleene-star boa ;
 : <reluctant-kleene-star> ( 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 5375d813e1bc719f3f9993674b5d93b7d3616db6..e5c31a54e0e40f4260e439030410069e36b99bc2 100644 (file)
--- 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 3ec1e96c7264d6cce43df3f934cc3397d9602479..4a0d3777b82d0d8dbdc0ac5c9db01d6b7604b983 100644 (file)
--- 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 c82fe4006d3a3b6e734178a2e4aea9f56790aed2..9d0419a81820e59c4f8158441df7cde6330612df 100644 (file)
--- 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 67386c180783ccc7d7b881942f039eb22a8e6a88..dc2cedfef85501bc9a5fe0fb1cefd25a98b8a0ed 100755 (executable)
--- 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 baf025d11625f90d267d9ef8dacd857d584b4b04..e5a2b5309641a7ce1cba789ac9c20ddd907ebc21 100644 (file)
--- 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 af249bbdc8c040ef74a412cf70c264e91f34fa4d..2b33d2bfe10fd38a7adec7a2d6ba811b310cb3c6 100644 (file)
--- 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 336d99657ef063fac3c2663df0c64e7c5da1469e..6bcf8b50ccda03bdf9cadec546cdabee8e2cda51 100644 (file)
--- 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+ ;
 
 <PRIVATE

diff --git a/basis/unicode/collation/collation.factor b/basis/unicode/collation/collation.factor
index 5718ae12a74c0996c4cd0b46db87d0fcbc0c0054..69a8c314f6d8afbd25810fda16c1b61f8b2e4486 100644 (file)
--- a/basis/unicode/collation/collation.factor
+++ b/basis/unicode/collation/collation.factor
@@ -125,7 +125,7 @@ PRIVATE>
 \r
 : filter-ignorable ( weights -- weights' )\r
     f swap [\r
-        tuck primary>> zero? and\r
+        [ nip ] [ primary>> zero? and ] 2bi\r
         [ swap ignorable?>> or ]\r
         [ swap completely-ignorable? or not ] 2bi\r
     ] filter nip ;\r

diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor
index c2b5ad4ea4923319cc5beda18df402b3cf4c6161..42444261e225aaa76f9e6d63a7e0090aa41df241 100644 (file)
--- 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" <c-object>
-    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 472488ddc2bd26e728d211eed599c5f35beabe78..d3fe0a84477a147535b58cd332a62b464a9539cb 100644 (file)
--- 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 67ece9d1c7ec82c2e22b3bc8586a2526f9b67262..be9f8cf7a9769491b91a5849cc4119ae2548e4c6 100644 (file)
--- a/basis/x11/windows/windows.factor
+++ b/basis/x11/windows/windows.factor
@@ -37,7 +37,7 @@ IN: x11.windows
 : set-size-hints ( window -- )
     "XSizeHints" <c-object>
     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 8c024d938e09aab2781c83339a78ed15a674d9fd..9d84791c1f93eb3b119f95bde2e4e9bb4148ae5d 100644 (file)
--- 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 <attrs> ;

diff --git a/basis/xmode/marker/marker.factor b/basis/xmode/marker/marker.factor
index 3e632cc5afc587765e8c8e17aba7fd234c197f9f..798807f19807f7f1841c07ce67a14b370ff4983f 100644 (file)
--- 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 b5a2f6eb98eeacc068575c6b44ef4a31c1d0131a..871767ccf5d8168289229917b382909e6d1c58a4 100644 (file)
--- 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 7f34c3b19da946108c50f06c87eb8fd398308557..a2eb2d25ec639611ccaf80cf73892808d973e23c 100644 (file)
--- a/core/assocs/assocs.factor
+++ b/core/assocs/assocs.factor
@@ -188,7 +188,7 @@ M: sequence new-assoc drop <vector> ;
 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 4625c665bf229bc79a56fdf1ce2950693c80002c..e71379ac1a679dcec33a5ed94ddcd0fafc4799e5 100644 (file)
--- 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 )\r
     over [ classes-intersect? ] curry filter\r
     [ drop f ] [\r
-        tuck [ class<= ] with all? [ peek ] [ drop f ] if\r
+        [ nip ] [ [ class<= ] with all? ] 2bi [ peek ] [ drop f ] if\r
     ] if-empty ;\r
 \r
 GENERIC: (flatten-class) ( class -- )\r

diff --git a/core/classes/classes.factor b/core/classes/classes.factor
index acff3d57e5f818870906270cefcea8bd48bc9ae7..8145730f401f91c9a28ca0ba02c8aa23e5c3fd4f 100644 (file)
--- 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 2470c0087526e0ccf60c9906208a3b3489e66259..1261d44a6984ebea80e5f3989a3eed75d4f8e18f 100644 (file)
--- 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 884207b90128456556768c2edfbb4b081131466d..ba990b42479fe2c830a27fc02dc7bc2847426d86 100644 (file)
--- 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" <word> [ [ 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 77bcd7cad6f10a26039148d8611f4a1a7e6a3274..6b7e953b6c18ee073ab8c6603adf0e0909db2135 100644 (file)
--- 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 4eb39291a05cf04f6d1c1cd294e1add41f244720..c16b6a52a12e3bdf1494c7db0283a9a91f87d99a 100644 (file)
--- 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 9268340c792e4cf735b90f9765e1fbd97a58b3bc..8aa13a5f5eeb09c2f150aadbef0f630f440db4d3 100644 (file)
--- 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 81ed91290c1236035943716d6d047d6874701b1d..3c915cb07de56f62a6883449316f6b424989f05e 100644 (file)
--- 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 061da056693c57f10089a15acba12190ee637d2c..2a5c0c674cc612a6ec2d8ca83dc82d622a8bbbab 100644 (file)
--- 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 )