Remove some usages of tuck

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

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
 

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
 

basis/compiler/tests/peg-regression.factor

@@ -22,5 +22,5 @@ pipeline = "hello" => [[ ast>pipeline-expr ]]
 
 USE: tools.test
 
-[ t ] [ \ expr compiled>> ] unit-test
+[ t ] [ \ expr optimized>> ] unit-test
-[ t ] [ \ ast>pipeline-expr compiled>> ] unit-test
+[ t ] [ \ ast>pipeline-expr optimized>> ] unit-test

basis/compiler/tests/redefine1.factor

@@ -23,36 +23,36 @@ M: integer method-redefine-test 3 + ;
 : hey ( -- ) ;
 : there ( -- ) hey ;
 
-[ t ] [ \ hey compiled>> ] unit-test
+[ t ] [ \ hey optimized>> ] unit-test
-[ t ] [ \ there compiled>> ] unit-test
+[ t ] [ \ there optimized>> ] unit-test
 [ ] [ "IN: compiler.tests : hey ( -- ) 3 ;" eval ] unit-test
-[ f ] [ \ hey compiled>> ] unit-test
+[ f ] [ \ hey optimized>> ] unit-test
-[ f ] [ \ there compiled>> ] 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 ] [ \ good optimized>> ] unit-test
-[ t ] [ \ bad compiled>> ] unit-test
+[ t ] [ \ bad optimized>> ] unit-test
-[ t ] [ \ ugly compiled>> ] 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 ] [ \ good optimized>> ] unit-test
-[ f ] [ \ bad compiled>> ] unit-test
+[ f ] [ \ bad optimized>> ] unit-test
-[ f ] [ \ ugly compiled>> ] 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 ] [ \ good optimized>> ] unit-test
-[ t ] [ \ bad compiled>> ] unit-test
+[ t ] [ \ bad optimized>> ] unit-test
-[ t ] [ \ ugly compiled>> ] unit-test
+[ t ] [ \ ugly optimized>> ] unit-test
 
 [ f ] [ \ good compiled-usage assoc-empty? ] unit-test

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

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

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
 

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 ] 2dip 72 0 63 x-insn ;
-: FMR. ( a s -- ) 0 -rot 72 1 63 x-insn ;
+: FMR. ( a s -- ) [ 0 ] 2dip 72 1 63 x-insn ;
-: FCTIWZ ( a s -- ) 0 -rot 0 15 63 x-insn ;
+: FCTIWZ ( a s -- ) [ 0 ] 2dip 0 15 63 x-insn ;
-: FCTIWZ. ( a s -- ) 0 -rot 1 15 63 x-insn ;
+: FCTIWZ. ( a s -- ) [ 0 ] 2dip 1 15 63 x-insn ;
 
 ! XO-form
 XO: ADD 0 0 266 31

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: word (B) [ 0 ] 2dip (B) rc-relative-ppc-3 rel-word ;
-M: label (B) 0 -rot (B) rc-relative-ppc-3 label-fixup ;
+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 ;

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>>
+    [ nip ] [
-    [ postgresql-bind-conversion ] with map
+        in-params>>
+        [ postgresql-bind-conversion ] with map
+    ] 2bi
     >>bind-params drop ;
 
 M: postgresql-result-set #rows ( result-set -- n )

basis/db/tuples/tuples.factor

@@ -73,9 +73,10 @@ PRIVATE>
 ! High level
 ERROR: no-slots-named class seq ;
 : check-columns ( class columns -- )
-    tuck
+    [ nip ] [
-    [ [ first ] map ]
+        [ [ first ] map ]
-    [ all-slots [ name>> ] map ] bi* diff
+        [ all-slots [ name>> ] map ] bi* diff
+    ] 2bi
     [ drop ] [ no-slots-named ] if-empty ;
 
 : define-persistent ( class table columns -- )

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 ;
 

basis/http/server/server.factor

@@ -196,8 +196,8 @@ LOG: httpd-hit NOTICE
 
 LOG: httpd-header NOTICE
 
-: log-header ( headers name -- )
+: log-header ( request name -- )
-    tuck header 2array httpd-header ;
+    [ nip ] [ header ] 2bi 2array httpd-header ;
 
 : log-request ( request -- )
     [ [ method>> ] [ url>> ] bi 2array httpd-hit ]

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 ;
 

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
+    "WIN32_FIND_DATA" <c-object>
-    FindFirstFile
+    [ 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
+    "WIN32_FIND_DATA" <c-object>
-    FindNextFile 0 = [
+    [ nip ] [ FindNextFile ] 2bi 0 = [
         GetLastError ERROR_NO_MORE_FILES = [
             win32-error
         ] unless drop f

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

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 )
     {

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 )
     {

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' )
     {

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' )
     {

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' )
     {

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

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 ;

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* ;

basis/math/functions/functions.factor

@@ -122,11 +122,9 @@ PRIVATE>
     [ * ] 2keep gcd nip /i ; foldable
 
 : mod-inv ( x n -- y )
-    tuck gcd 1 = [
+    [ nip ] [ gcd 1 = ] 2bi
-        dup 0 < [ + ] [ nip ] if
+    [ dup 0 < [ + ] [ nip ] if ]
-    ] [
+    [ "Non-trivial divisor found" throw ] if ; foldable
-        "Non-trivial divisor found" throw
-    ] if ; foldable
 
 : ^mod ( x y n -- z )
     over 0 < [

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>

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*

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*

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 ;
 

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.
     {

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 -- )

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 ;

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

basis/serialize/serialize.factor

@@ -221,8 +221,7 @@ SYMBOL: deserialized
     (deserialize) (deserialize) 2dup lookup
     dup [ 2nip ] [
         drop
-        "Unknown word: " -rot
+        2array unparse "Unknown word: " prepend throw
-        2array unparse append throw
     ] if ;
 
 : deserialize-gensym ( -- word )

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 ;
 

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

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
+    tuck graft-state>> second [ graft ] [ drop  ] if ;
-        [ 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* ;

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*

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

basis/unicode/collation/collation.factor

@@ -125,7 +125,7 @@ PRIVATE>
 
 : 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 ;

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
+    [ set-utimbuf-modtime ] keep
-    tuck set-utimbuf-actime
+    [ set-utimbuf-actime ] keep
     [ utime ] unix-system-call drop ;
 
 FUNCTION: int pclose ( void* file ) ;

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 -- )

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 ;

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> ;

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 -- )
 

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
 

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 ;

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 -- )

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 ;
 

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

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

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 {

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 )
 

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+
     ] [

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 ;

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
+    [ 1 swap set-nth-unsafe ] keep
-    tuck 0 swap set-nth-unsafe ; inline
+    [ 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 )