core: Add the shuffler words but without primitives.

The nipd branch slowed bootstrap by a minute, this patch does not.

sorry about changing the fjsc line endings...

basis/alien/libraries/libraries.factor

@@ -65,7 +65,7 @@ M: library dispose dll>> [ dispose ] when* ;
 : add-library ( name path abi -- )
     3dup add-library? [
         [ 2drop remove-library ]
-        [ [ nip ] dip make-library ]
+        [ nipd make-library ]
         [ 2drop libraries get set-at ] 3tri
     ] [ 3drop ] if ;
 

basis/calendar/parser/parser.factor

@@ -104,7 +104,7 @@ CONSTANT: rfc822-named-zones H{
     read1 CHAR: \s assert=
     read-sp checked-number
     read-sp month-abbreviations index 1 + check-timestamp
-    read-sp checked-number -rot swap
+    read-sp checked-number spin
     read-hh:mm:ss
     " " read-until drop parse-rfc822-gmt-offset <timestamp> ;
 
@@ -120,7 +120,7 @@ CONSTANT: rfc822-named-zones H{
     read1 CHAR: \s assert=
     "-" read-token checked-number
     "-" read-token month-abbreviations index 1 + check-timestamp
-    read-sp checked-number -rot swap
+    read-sp checked-number spin
     read-hh:mm:ss
     " " read-until drop parse-rfc822-gmt-offset <timestamp> ;
 

basis/checksums/ripemd/ripemd.factor

@@ -39,7 +39,7 @@ M: ripemd-160 initialize-checksum-state drop <ripemd-160-state> ;
 : F ( x y z -- out ) bitxor bitxor ;  inline
 : G ( x y z -- out ) pick bitnot swap [ bitand ] 2bi@ bitor ; inline
 : H ( x y z -- out ) [ bitnot bitor ] [ bitxor ] bi* ; inline
-: I ( x y z -- out ) swap over bitnot [ bitand ] 2bi@ bitor ; inline
+: I ( x y z -- out ) tuck bitnot [ bitand ] 2bi@ bitor ; inline
 : J ( x y z -- out ) bitnot bitor bitxor ; inline
 
 CONSTANT: T11 0x00000000

basis/checksums/sha/sha-tests.factor

@@ -84,7 +84,7 @@ CONSTANT: bytes-b B{ 1 2 3 4 5 6 7 8 }
 ERROR: checksums-differ algorithm seq incremental-checksum one-go-checksum ;
 : compare-checksum-calculations ( algorithm seq -- ? )
     2dup [ incremental-checksum ] [ one-go-checksum ] 2bi 2dup = [
-        2drop 2drop t
+        4drop t
     ] [
         checksums-differ
     ] if ;

basis/classes/struct/struct.factor

@@ -135,7 +135,7 @@ PRIVATE>
 M: struct-class boa>object
     swap pad-struct-slots
     [ <struct> ] [ struct-slots ] bi
-    [ [ (writer-quot) call( value struct -- ) ] with 2each ] curry keep ;
+    [ [ (writer-quot) call( value struct -- ) ] with 2each ] keepd ;
 
 M: struct-class initial-value* <struct> t ; inline
 
@@ -262,7 +262,7 @@ M: struct binary-zero? binary-object uchar <c-direct-array> [ 0 = ] all? ; inlin
         [
             [ initial>> ]
             [ (writer-quot) ] bi
-            over [ swapd [ call( value struct -- ) ] curry keep ] [ 2drop ] if
+            over [ swapd [ call( value struct -- ) ] keepd ] [ 2drop ] if
         ] each
     ] [ drop f ] if ;
 

basis/compiler/cfg/linear-scan/assignment/assignment.factor

@@ -102,7 +102,7 @@ RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ]
     } cleave ;
 
 : change-insn-gc-roots ( gc-map-insn quot: ( x -- x ) -- )
-    [ gc-map>> ] dip [ swap gc-roots>> swap map! drop ]
+    [ gc-map>> ] dip [ [ gc-roots>> ] dip map! drop ]
     [ '[ [ _ bi@ ] assoc-map ] change-derived-roots drop ] 2bi ; inline
 
 : spill-required? ( live-interval root-leaders n -- ? )

basis/compiler/cfg/stacks/local/local-tests.factor

@@ -146,7 +146,7 @@ IN: compiler.cfg.stacks.local.tests
 : my-new-key4 ( a i j -- i/j )
     2over
     slot
-    swap over
+    tuck
     ! a i el j el
     [
         ! a i el j

basis/compiler/cfg/stacks/stacks.factor

@@ -21,7 +21,7 @@ IN: compiler.cfg.stacks
     } apply-passes ;
 
 : create-locs ( loc-class seq -- locs )
-    [ swap new swap >>n ] with map <reversed> ;
+    [ [ new ] dip >>n ] with map <reversed> ;
 
 : stack-locs ( loc-class n -- locs )
     <iota> create-locs ;

basis/compiler/cfg/value-numbering/simd/simd.factor

@@ -85,8 +85,8 @@ M: ##gather-int-vector-2 rewrite rewrite-gather-vector-2 ;
 : rewrite-gather-vector-4 ( insn -- insn/f )
     dup { [ src1>> ] [ src2>> ] [ src3>> ] [ src4>> ] } cleave [ vreg>insn ] 4 napply
     {
-        { [ 4 ndup [ literal-insn? ] 4 napply and and and ] [ fold-gather-vector-4 ] }
-        [ 5 ndrop f ]
+        { [ 4dup [ literal-insn? ] 4 napply and and and ] [ fold-gather-vector-4 ] }
+        [ 5drop f ]
     } cond ;
 
 M: ##gather-vector-4 rewrite rewrite-gather-vector-4 ;

basis/compiler/tests/alien.factor

@@ -151,7 +151,7 @@ unit-test
 
 : multi_ffi_test_18 ( w x y z w' x' y' z' -- int int )
     [ int "f-stdcall" "ffi_test_18" { int int int int } f alien-invoke ]
-    4 ndip
+    4dip
     int "f-stdcall" "ffi_test_18" { int int int int } f alien-invoke
     gc ;
 
@@ -917,11 +917,11 @@ FUNCTION: void* bug1021_test_1 ( void* s, int x )
     ] [ 2drop ] if ; inline recursive
 
 : run-test ( alien -- seq )
-    100 33 <array> swap over
+    100 33 <array> tuck
     [
         pick swapd
         bug1021_test_1
-        -rot swap 2 fixnum+fast
+        spin 2 fixnum+fast
         set-slot
     ] curry curry 0 each-to100 ;
 

basis/compiler/tree/propagation/simd/simd.factor

@@ -124,7 +124,7 @@ vector>vector-intrinsics [ { byte-array } "default-output-classes" set-word-prop
 
 : inline-unless-intrinsic ( word -- )
     dup '[
-        _ swap over "intrinsic" word-prop
+        _ tuck "intrinsic" word-prop
         "always-inline-simd-intrinsics" get not swap and
         ! word node intrinsic
         [ try-intrinsic [ drop f ] [ def>> ] if ]

basis/compression/snappy/snappy.factor

@@ -29,4 +29,4 @@ PRIVATE>
     [ snappy_uncompressed_length check-snappy ] keep
     size_t deref
     n>outs
-    [ snappy_uncompress check-snappy ] 2keep drop >byte-array ;
+    [ snappy_uncompress check-snappy ] keepd >byte-array ;

basis/compression/zlib/zlib.factor

@@ -37,7 +37,7 @@ ERROR: zlib-failed n string ;
         [ <byte-vector> dup underlying>> ] keep ulong <ref>
     ] keep [
         dup length compression.zlib.ffi:compress zlib-error
-    ] 2keep drop ulong deref >>length B{ } like ;
+    ] keepd ulong deref >>length B{ } like ;
 
 : (uncompress) ( length byte-array -- byte-array )
     [
@@ -53,15 +53,13 @@ ERROR: zlib-failed n string ;
 
 
 : zlib-inflate-init ( -- z_stream_s )
-    z_stream <struct> ZLIB_VERSION over byte-length [
-        inflateInit_ zlib-error
-    ] 3keep 2drop  ;
+    z_stream <struct>
+    dup ZLIB_VERSION over byte-length inflateInit_ zlib-error ;
 
 ! window can be 0, 15, 32, 47 (others?)
 : zlib-inflate-init2 ( window -- z_stream_s )
-    [ z_stream <struct> ] dip ZLIB_VERSION pick byte-length [
-        inflateInit2_ zlib-error
-    ] 4keep 3drop  ;
+    [ z_stream <struct> dup ] dip
+    ZLIB_VERSION pick byte-length inflateInit2_ zlib-error ;
 
 : zlib-inflate-end ( z_stream -- )
     inflateEnd zlib-error ;
@@ -73,6 +71,4 @@ ERROR: zlib-failed n string ;
     inflate zlib-error ;
 
 : zlib-inflate-get-header ( z_stream -- gz_header )
-    gz_header <struct> [
-        inflateGetHeader zlib-error
-    ] keep ;
+    gz_header <struct> [ inflateGetHeader zlib-error ] keep ;

basis/cpu/ppc/assembler/assembler.factor

@@ -1949,8 +1949,8 @@ tri* 134 1 63 x-insn ;
 : CLRLDI.   ( ra rs  n -- ) 0 swap RLDICL. ;
 : CLRRDI    ( ra rs  n -- ) 0 swap 63 swap - RLDICR ;
 : CLRRDI.   ( ra rs  n -- ) 0 swap 63 swap - RLDICR. ;
-: CLRLSLDI  ( ra rs  b n -- ) swap over - RLDIC ;
-: CLRLSLDI. ( ra rs  b n -- ) swap over - RLDIC. ;
+: CLRLSLDI  ( ra rs  b n -- ) tuck - RLDIC ;
+: CLRLSLDI. ( ra rs  b n -- ) tuck - RLDIC. ;
 
 ! E.7.2 Operations on Words
 : EXTLWI    ( ra rs  n b -- ) swap 0 1 - RLWINM ;

basis/cpu/x86/assembler/assembler.factor

@@ -147,7 +147,7 @@ M: register displacement, drop ;
 : 1-operand ( operand reg,rex.w,opcode -- )
     ! The 'reg' is not really a register, but a value for the
     ! 'reg' field of the mod-r/m byte.
-    first3 [ [ over ] dip prefix-1 ] dip opcode, swap addressing ;
+    first3 [ overd prefix-1 ] dip opcode, swap addressing ;
 
 : immediate-operand-size-bit ( dst imm reg,rex.w,opcode -- imm dst reg,rex.w,opcode )
     over integer? [ first3 0b1 opcode-or 3array ] when ;

basis/cpu/x86/x86.factor

@@ -409,7 +409,7 @@ M: x86 %convert-integer ( dst src c-type -- )
             { c:int    [ 32 %alien-signed-getter ] }
             { c:uint   [ 32 [ 2drop ] %alien-integer-getter ] }
         } case
-    ] [ [ drop ] 2dip %copy ] ?if ;
+    ] [ nipd %copy ] ?if ;
 
 M: x86 %load-memory ( dst base displacement scale offset rep c-type -- )
     (%memory) (%load-memory) ;

basis/csv/csv.factor

@@ -17,7 +17,7 @@ MEMO: field-delimiters ( delimiter -- field-seps quote-seps )
 DEFER: quoted-field,
 
 : maybe-escaped-quote ( delimeter stream quoted? -- delimiter stream sep/f )
-    2over stream-read1 swap over =
+    2over stream-read1 tuck =
     [ nip ] [
         {
             { CHAR: \"    [ [ CHAR: \" , ] when quoted-field, ] }
@@ -42,12 +42,12 @@ DEFER: quoted-field,
 
 : continue-field ( delimiter stream field-seps seq -- sep/f field )
     swap rot stream-read-until [ "\"" glue ] dip
-    swap ?trim [ drop ] 2dip ; inline
+    swap ?trim nipd ; inline
 
 : field ( delimiter stream field-seps quote-seps -- sep/f field )
     pick stream-read-until dup CHAR: \" = [
         drop [ drop quoted-field ] [ continue-field ] if-empty
-    ] [ [ 3drop ] 2dip swap ?trim ] if ;
+    ] [ 3nipd swap ?trim ] if ;
 
 : (stream-read-row) ( delimiter stream field-end quoted-field -- sep/f fields )
     [ [ dup '[ dup _ = ] ] keep ] 3dip
@@ -61,7 +61,7 @@ DEFER: quoted-field,
 PRIVATE>
 
 : stream-read-row ( stream -- row )
-    delimiter get swap over field-delimiters
+    delimiter get tuck field-delimiters
     (stream-read-row) nip ; inline
 
 : read-row ( -- row )

basis/db/postgresql/lib/lib.factor

@@ -118,7 +118,7 @@ M: postgresql-result-null summary ( obj -- str )
 
 : pq-get-string ( handle row column -- obj )
     3dup PQgetvalue utf8 alien>string
-    dup empty? [ [ pq-get-is-null f ] dip ? ] [ [ 3drop ] dip ] if ;
+    dup empty? [ [ pq-get-is-null f ] dip ? ] [ 3nip ] if ;
 
 : pq-get-number ( handle row column -- obj )
     pq-get-string dup [ string>number ] when ;
@@ -135,7 +135,7 @@ M: postgresql-malloc-destructor dispose ( obj -- )
 : pq-get-blob ( handle row column -- obj/f )
     [ PQgetvalue ] 3keep 3dup PQgetlength
     dup 0 > [
-        [ 3drop ] dip
+        3nip
         [
             memory>byte-array >string
             { uint }

basis/formatting/formatting.factor

@@ -37,7 +37,7 @@ ERROR: unknown-format-directive value ;
         [ 10^ * round-to-even >integer number>string ]
         [ 1 + CHAR: 0 pad-head ]
         [ cut* ] tri [ "." glue ] unless-empty
-    ] curry keep neg? [ CHAR: - prefix ] when ;
+    ] keepd neg? [ CHAR: - prefix ] when ;
 
 : format-scientific-mantissa ( x log10x digits -- string rounded-up? )
     [ swap - 10^ * round-to-even >integer number>string ] keep
@@ -55,7 +55,7 @@ ERROR: unknown-format-directive value ;
         [ abs dup integer-log10 ] dip
         [ format-scientific-mantissa ]
         [ drop nip format-scientific-exponent ] 3bi append
-    ] curry keep neg? [ CHAR: - prefix ] when ;
+    ] keepd neg? [ CHAR: - prefix ] when ;
 
 : format-float-fast ( x digits string -- string )
     [ "" -1 ] 2dip "C" format-float ;

basis/fry/fry.factor

@@ -110,7 +110,7 @@ TUPLE: dredge-fry-state
 : in-quot-slices ( n i state -- head tail )
     in-quot>>
     [ <slice> ]
-    [ [ drop ] 2dip swap 1 + tail-slice ] 3bi ; inline
+    [ nipd swap 1 + tail-slice ] 3bi ; inline
 
 : push-head-slice ( head state -- )
     quot>> [ push-all ] [ \ _ swap push ] bi ; inline
@@ -122,7 +122,7 @@ TUPLE: dredge-fry-state
     rot {
         [ nip in-quot-slices ] ! head tail i elt state
         [ [ 2drop swap ] dip push-head-slice ]
-        [ [ drop ] 2dip push-subquot ]
+        [ nipd push-subquot ]
         [ [ 1 + ] [ drop ] [ ] tri* dredge-fry ]
     } 3cleave ; inline recursive
 

basis/furnace/chloe-tags/chloe-tags.factor

@@ -32,7 +32,7 @@ IN: furnace.chloe-tags
     [ [ "/" ?tail drop "/" ] dip present 3append ] when* ;
 
 : a-url ( href rest query value-name -- url )
-    dup [ [ 3drop ] dip value ] [
+    dup [ 3nip value ] [
         drop
         <url>
             swap parse-query-attr >>query

basis/game/input/dinput/dinput.factor

@@ -176,7 +176,7 @@ SYMBOLS: +dinput+ +keyboard-device+ +keyboard-state+
     <alien> DEV_BROADCAST_HDR memory>struct ;
 
 : handle-wm-devicechange ( hWnd uMsg wParam lParam -- )
-    [ 2drop ] 2dip swap {
+    2nipd swap {
         { [ dup DBT_DEVICEARRIVAL = ]         [ drop <DEV_BROADCAST_HDR> device-arrived ] }
         { [ dup DBT_DEVICEREMOVECOMPLETE = ]  [ drop <DEV_BROADCAST_HDR> device-removed ] }
         [ 2drop ]

basis/game/input/gtk/gtk.factor

@@ -98,7 +98,7 @@ M: gtk-game-input-backend read-keyboard
     get-dpy dup XDefaultRootWindow
     { int int int int int int int }
     [ XQueryPointer drop ] with-out-parameters
-    [ 4 ndrop ] 3dip ;
+    [ 4drop ] 3dip ;
 
 M: gtk-game-input-backend read-mouse
     query-pointer

basis/game/input/x11/x11.factor

@@ -90,7 +90,7 @@ M: x11-game-input-backend read-keyboard
     dpy get dup XDefaultRootWindow
     { int int int int int int int }
     [ XQueryPointer drop ] with-out-parameters
-    [ 4 ndrop ] 3dip ;
+    [ 4drop ] 3dip ;
 
 SYMBOL: mouse-reset?
 

basis/grouping/grouping.factor

@@ -61,7 +61,7 @@ M: clumps group@
 <PRIVATE
 
 : map-like ( seq n quot -- seq )
-    2keep drop '[ _ like ] map ; inline
+    keepd '[ _ like ] map ; inline
 
 PRIVATE>
 

basis/heaps/heaps.factor

@@ -60,7 +60,7 @@ M: heap heap-size ( heap -- n )
 
 : data-push ( entry data -- n )
     [ length [ >>index ] keep ]
-    [ [ set-nth ] 2keep drop ] bi ; inline
+    [ [ set-nth ] keepd ] bi ; inline
 
 GENERIC: heap-compare ( entry1 entry2 heap -- ? )
 

basis/help/lint/checks/checks.factor

@@ -83,6 +83,7 @@ SYMBOL: vocab-articles
     ] map ;
 
 : contains-funky-elements? ( element -- ? )
+B
     {
         $shuffle
         $complex-shuffle

basis/inverse/inverse.factor

@@ -259,7 +259,7 @@ DEFER: __
 
 : recover-fail ( try fail -- )
     [ drop call ] [
-        [ nip ] dip dup fail?
+        nipd dup fail?
         [ drop call ] [ nip throw ] if
     ] recover ; inline
 

basis/io/backend/unix/multiplexers/epoll/epoll.factor

@@ -23,7 +23,7 @@ M: epoll-mx dispose* fd>> close-file ;
 : make-event ( fd events -- event )
     epoll-event <struct>
         swap >>events
-        swap over data>> fd<< ;
+        tuck data>> fd<< ;
 
 :: do-epoll-ctl ( fd mx what events -- )
     mx fd>> what fd fd events make-event epoll_ctl io-error ;

basis/io/buffers/buffers.factor

@@ -56,7 +56,7 @@ TYPED: buffer-read-into ( dst n: fixnum buffer: buffer -- count )
         pick c-ptr? [
             memcpy
         ] [
-            -rot swap
+            spin
             [ swap alien-unsigned-1 ]
             [ set-nth-unsafe ] bi-curry*
             [ bi ] 2curry each-integer

basis/io/encodings/utf32/utf32.factor

@@ -20,29 +20,25 @@ utf32 "UTF-32" register-encoding
 
 ! Decoding
 
-: char> ( stream encoding quot -- ch )
-    nip swap 4 swap stream-read dup length {
+: char> ( stream quot -- ch )
+    swap [ 4 ] dip stream-read dup length {
         { 0 [ 2drop f ] }
         { 4 [ swap call ] }
         [ 3drop replacement-char ]
     } case ; inline
 
-M: utf32be decode-char
-    [ be> ] char> ;
+M: utf32be decode-char drop [ be> ] char> ;
 
-M: utf32le decode-char
-    [ le> ] char> ;
+M: utf32le decode-char drop [ le> ] char> ;
 
 ! Encoding
 
-: >char ( char stream encoding quot -- )
-    nip 4 swap curry dip stream-write ; inline
+: >char ( char stream quot -- )
+    4 swap curry dip stream-write ; inline
 
-M: utf32be encode-char
-    [ >be ] >char ;
+M: utf32be encode-char drop [ >be ] >char ;
 
-M: utf32le encode-char
-    [ >le ] >char ;
+M: utf32le encode-char drop [ >le ] >char ;
 
 ! UTF-32
 
@@ -51,7 +47,9 @@ CONSTANT: bom-le B{ 0xff 0xfe 0 0 }
 CONSTANT: bom-be B{ 0 0 0xfe 0xff }
 
 : bom>le/be ( bom -- le/be )
-    dup bom-le sequence= [ drop utf32le ] [
+    dup bom-le sequence= [
+        drop utf32le
+    ] [
         bom-be sequence= [ utf32be ] [ missing-bom ] if
     ] if ;
 

basis/io/files/windows/windows.factor

@@ -388,7 +388,7 @@ M: windows home
     FindStreamInfoStandard
     WIN32_FIND_STREAM_DATA <struct>
     0
-    [ FindFirstStream ] 2keep drop
+    [ FindFirstStream ] keepd
     over -1 <alien> = [
         2drop throw-win32-error
     ] [

basis/io/ports/ports.factor

@@ -89,25 +89,25 @@ M: input-port stream-read-unsafe
 : read-until-loop ( seps port accum -- sep/f )
     2over read-until-step over [
         [ append! ] dip dup [
-            [ 3drop ] dip
+            3nip
         ] [
             drop read-until-loop
         ] if
     ] [
-        [ 4drop ] dip
+        4nip
     ] if ; inline recursive
 
 PRIVATE>
 
 M: input-port stream-read-until
     2dup read-until-step dup [
-        [ 2drop ] 2dip
+        2nipd
     ] [
         over [
             drop
             BV{ } like [ read-until-loop ] keep B{ } like swap
         ] [
-            [ 2drop ] 2dip
+            2nipd
         ] if
     ] if ;
 

basis/io/sockets/secure/openssl/openssl.factor

@@ -238,7 +238,7 @@ SYMBOL: default-secure-context
     ] [ nip (ssl-error) ] if-zero ;
 
 : check-ssl-error ( ssl ret exra-cases/f -- event/f )
-    [ swap over SSL_get_error ] dip
+    [ tuck SSL_get_error ] dip
     {
         { SSL_ERROR_NONE [ drop f ] }
         { SSL_ERROR_WANT_READ [ drop +input+ ] }

basis/io/sockets/unix/unix.factor

@@ -40,11 +40,11 @@ M: unix addrspec-of-family
 ! Client sockets - TCP and Unix domain
 M: object (get-local-address)
     [ handle-fd ] dip empty-sockaddr/size int <ref>
-    [ getsockname io-error ] 2keep drop ;
+    [ getsockname io-error ] keepd ;
 
 M: object (get-remote-address)
     [ handle-fd ] dip empty-sockaddr/size int <ref>
-    [ getpeername io-error ] 2keep drop ;
+    [ getpeername io-error ] keepd ;
 
 : init-client-socket ( fd -- )
     SOL_SOCKET SO_OOBINLINE set-socket-option ;
@@ -94,7 +94,7 @@ M: object (server)
 
 : do-accept ( server addrspec -- fd sockaddr )
     [ handle>> handle-fd ] [ empty-sockaddr/size int <ref> ] bi*
-    [ unix.ffi:accept ] 2keep drop ; inline
+    [ unix.ffi:accept ] keepd ; inline
 
 M: object (accept)
     2dup do-accept over 0 >= [
@@ -133,7 +133,7 @@ M: unix (broadcast)
     recvfrom sockaddr ; inline
 
 : (receive-loop) ( n buf datagram -- count sockaddr )
-    3dup do-receive over 0 > [ [ 3drop ] 2dip ] [
+    3dup do-receive over 0 > [ 3nipd ] [
         2drop [ +input+ wait-for-port ] [ (receive-loop) ] bi
     ] if ; inline recursive
 

basis/io/sockets/windows/windows.factor

@@ -56,11 +56,11 @@ M: win32-socket dispose* ( stream -- )
 
 M: object (get-local-address) ( socket addrspec -- sockaddr )
     [ handle>> ] dip empty-sockaddr/size int <ref>
-    [ getsockname socket-error ] 2keep drop ;
+    [ getsockname socket-error ] keepd ;
 
 M: object (get-remote-address) ( socket addrspec -- sockaddr )
     [ handle>> ] dip empty-sockaddr/size int <ref>
-    [ getpeername socket-error ] 2keep drop ;
+    [ getpeername socket-error ] keepd ;
 
 : bind-socket ( win32-socket sockaddr len -- )
     [ handle>> ] 2dip bind socket-error ;

basis/libc/macosx/macosx.factor

@@ -145,6 +145,6 @@ FUNCTION: int strerror_r ( int errno, char* buf, size_t buflen )
 
 M: macosx strerror ( errno -- str )
     [
-        1024 [ malloc &free ] keep [ strerror_r ] 2keep drop nip
+        1024 [ malloc &free ] keep [ strerror_r ] keepd nip
         alien>native-string
     ] with-destructors ;

basis/libc/windows/windows.factor

@@ -111,6 +111,6 @@ FUNCTION: int strerror_s ( char *buffer, size_t numberOfElements, int errnum )
 M: windows strerror ( errno -- str )
     [
         [ 1024 [ malloc &free ] keep ] dip
-        [ strerror_s drop ] 3keep 2drop
+        [ strerror_s drop ] keepdd
         utf8 alien>string
     ] with-destructors ;

basis/logging/logging.factor

@@ -134,7 +134,7 @@ PRIVATE>
     '[ _ [ _ log-error @ ] recover ] ;
 
 : add-error-logging ( word level -- )
-    [ [ input-logging-quot ] 2keep drop error-logging-quot ]
+    [ [ input-logging-quot ] keepd error-logging-quot ]
     (define-logging) ;
 
 SYNTAX: LOG:

basis/math/combinatorics/combinatorics.factor

@@ -244,7 +244,7 @@ PRIVATE>
     [ drop pick [ combination ] [ 3drop f ] if ] 3bi ; inline
 
 : reduce-combinations ( ... seq k identity quot: ( ... prev elt -- ... next ) -- ... result )
-    [ -rot ] dip each-combination ; inline
+    -rotd each-combination ; inline
 
 : all-subsets ( seq -- subsets )
     dup length [0,b] [ all-combinations ] with map concat ;

basis/math/functions/functions.factor

@@ -359,7 +359,7 @@ M: float truncate
     dup -52 shift 0x7ff bitand 0x3ff -
     ! check for floats without fractional part (>= 2^52)
     dup 52 < [
-        [ drop ] 2dip
+        nipd
         dup 0 < [
             ! the float is between -1.0 and 1.0,
             ! the result could be +/-0.0, but we will

basis/math/matrices/elimination/elimination.factor

@@ -28,7 +28,7 @@ SYMBOL: matrix
     0 swap nth-row [ zero? not ] skip ;
 
 : clear-scale ( col# pivot-row i-row -- n )
-    [ over ] dip nth dup zero? [
+    overd nth dup zero? [
         3drop 0
     ] [
         [ nth dup zero? ] dip swap [

basis/math/partial-dispatch/partial-dispatch.factor

@@ -143,7 +143,7 @@ SYMBOL: fast-math-ops
 
 : math-method* ( word left right -- quot )
     3dup math-op
-    [ [ 3drop ] dip 1quotation ] [ drop math-method ] if ;
+    [ 3nip 1quotation ] [ drop math-method ] if ;
 
 : math-both-known? ( word left right -- ? )
     3dup math-op

basis/math/statistics/statistics.factor

@@ -269,7 +269,7 @@ ALIAS: std sample-std
 <PRIVATE
 : r-sum-diffs ( x-mean y-mean x-seq y-seq -- (r) )
     ! finds sigma((xi-mean(x))(yi-mean(y))
-    0 [ [ [ pick ] dip swap - ] bi@ * + ] 2reduce 2nip ;
+    0 [ [ reach - ] bi@ * + ] 2reduce 2nip ;
 
 : (r) ( x-mean y-mean x-seq y-seq x-std y-std -- r )
     * recip [ [ r-sum-diffs ] keep length 1 - / ] dip * ;
@@ -281,7 +281,7 @@ PRIVATE>
 : pearson-r ( xy-pairs -- r ) r-stats (r) ;
 
 : least-squares ( xy-pairs -- alpha beta )
-    r-stats [ 2dup ] 4 ndip
+    r-stats [ 2dup ] 4dip
     ! stack is x-mean y-mean x-mean y-mean x-seq y-seq x-std y-std
     [ (r) ] 2keep ! stack is mean(x) mean(y) r sx sy
     swap / * ! stack is mean(x) mean(y) beta

basis/math/vectors/simd/intrinsics/intrinsics.factor

@@ -268,16 +268,16 @@ PRIVATE>
 : (simd-vunpack-tail)      ( a   rep -- c )
     [ byte>rep-array ] [ widen-vector-rep [ rep-length ] [ '[ _ >rep-array ] ] bi ] bi
     [ tail-slice ] dip call( a' -- c' ) underlying>> ;
-: (simd-with)              (   n rep -- v )
+: (simd-with)              ( n rep -- v )
     [ rep-length swap '[ _ ] ] [ <rep-array> ] bi replicate-as
     underlying>> ;
 : (simd-gather-2)          ( m n rep -- v ) <rep-array> [ 2 set-firstn-unsafe ] keep underlying>> ;
 : (simd-gather-4)          ( m n o p rep -- v ) <rep-array> [ 4 set-firstn-unsafe ] keep underlying>> ;
 : (simd-select)            ( a n rep -- x ) swapd byte>rep-array nth-unsafe ;
 
-: alien-vector     (       c-ptr n rep -- value )
+: alien-vector     ( c-ptr n rep -- value )
     [ swap <displaced-alien> ] dip rep-size memory>byte-array ;
-: set-alien-vector ( value c-ptr n rep --       )
+: set-alien-vector ( value c-ptr n rep -- )
     [ swap <displaced-alien> swap ] dip rep-size memcpy ;
 
 "compiler.cfg.intrinsics.simd" require

basis/opengl/shaders/shaders.factor

@@ -66,7 +66,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
 : (gl-program) ( shaders quot: ( gl-program -- ) -- program )
     glCreateProgram
     [
-        rot dupd attach-shaders swap call
+        dup roll attach-shaders swap call
     ] [ glLinkProgram ] [ ] tri gl-error ; inline
 
 : <gl-program> ( shaders -- program )

basis/opengl/textures/textures.factor

@@ -290,7 +290,7 @@ TUPLE: single-texture < disposable image dim loc texture-coords texture display-
 : tex-sub-image ( image -- )
     [ GL_TEXTURE_2D 0 0 0 ] dip
     [ dim>> first2 ]
-    [ image-format [ drop ] 2dip ]
+    [ image-format nipd ]
     [ bitmap>> ] tri
     glTexSubImage2D ;
 

basis/peg/peg.factor

@@ -37,7 +37,7 @@ SYMBOL: error-stack
 
 : merge-errors ( -- )
     error-stack get dup length 1 >  [
-        dup pop over pop swap (merge-errors) swap push
+        [ pop ] [ pop swap (merge-errors) ] [ ] tri push
     ] [
         drop
     ] if ;
@@ -144,7 +144,7 @@ TUPLE: peg-head rule-id involved-set eval-set ;
     [ [ setup-growth ] 2keep ] 2dip
     [ dup eval-rule ] dip swap
         dup pick stop-growth? [
-        5 ndrop
+        5drop
     ] [
         over update-m
         (grow-lr)
@@ -347,7 +347,7 @@ TUPLE: satisfy-parser quot ;
     swap [
         drop f
     ] [
-        unclip-slice rot dupd call [
+        unclip-slice dup roll call [
             <parse-result>
         ] [
             2drop f

basis/persistent/vectors/vectors.factor

@@ -95,7 +95,7 @@ M: persistent-vector ppush ( val pvec -- pvec' )
 
 : node-change-nth ( i node quot -- node' )
     [ clone ] dip [
-        [ clone ] dip [ change-nth ] 2keep drop
+        [ clone ] dip [ change-nth ] keepd
     ] curry change-children ; inline
 
 : (new-nth) ( val i node -- node' )

basis/regexp/regexp.factor

@@ -60,7 +60,7 @@ PRIVATE>
 :: next-match ( i string regexp quot: ( i string regexp -- j ) reverse? -- start end ? )
     f f f
     i string reverse? search-range
-    [ [ 3drop ] dip string regexp quot reverse? (next-match) dup ] find 2drop ; inline
+    [ 3nip string regexp quot reverse? (next-match) dup ] find 2drop ; inline
 
 : do-next-match ( i string regexp -- start end ? )
     dup next-match>>
@@ -130,7 +130,7 @@ PRIVATE>
     ] [ 2drop f ] if ;
 
 : re-contains? ( string regexp -- ? )
-    prepare-match-iterator do-next-match [ 2drop ] dip >boolean ;
+    prepare-match-iterator do-next-match 2nip >boolean ;
 
 : re-split ( string regexp -- seq )
     [ <slice-unsafe> ] (re-split) ;

basis/sequences/generalizations/generalizations-tests.factor

@@ -36,12 +36,10 @@ IN: sequences.generalizations.tests
     [ 4 nappend print ] 4 0 mnmap ;
 : nproduce-as-test ( n -- a b )
     [ dup zero? not ]
-    [ [ 2 - ] [ ] [ 1 - ] tri ] { } B{ } 2 nproduce-as
-    [ drop ] 2dip ;
+    [ [ 2 - ] [ ] [ 1 - ] tri ] { } B{ } 2 nproduce-as nipd ;
 : nproduce-test ( n -- a b )
     [ dup zero? not ]
-    [ [ 2 - ] [ ] [ 1 - ] tri ] 2 nproduce
-    [ drop ] 2dip ;
+    [ [ 2 - ] [ ] [ 1 - ] tri ] 2 nproduce nipd ;
 
 { "A1a!
 B2b@

basis/sequences/generalizations/generalizations.factor

@@ -117,7 +117,7 @@ MACRO: (ncollect) ( n -- quot )
     [ { } swap dupn ] keep nproduce-as ; inline
 
 MACRO: nmap-reduce ( map-quot reduce-quot n -- quot )
-    -rot dupd compose [ over ] dip over '[
+    -rot dupd compose overd over '[
         [ [ first ] _ napply @ 1 ] _ nkeep
         _ _ (neach) (each-integer)
     ] ;

basis/sequences/merged/merged.factor

@@ -14,10 +14,10 @@ C: <merged> merged
     [ <merged> ] keep first like ;
 
 : 2merge ( seq1 seq2 -- seq )
-    [ <2merged> ] 2keep drop like ;
+    [ <2merged> ] keepd like ;
 
 : 3merge ( seq1 seq2 seq3 -- seq )
-    [ <3merged> ] 3keep 2drop like ;
+    [ <3merged> ] keepdd like ;
 
 M: merged length
     seqs>> [ [ length ] [ min ] map-reduce ] [ length ] bi * ; inline

basis/sequences/parser/parser.factor

@@ -62,7 +62,7 @@ TUPLE: sequence-parser sequence n ;
 : <safe-slice> ( from to seq -- slice/f )
     3dup {
         [ 2drop 0 < ]
-        [ [ drop ] 2dip length > ]
+        [ nipd length > ]
         [ drop > ]
     } 3|| [ 3drop f ] [ <slice-unsafe> ] if ; inline
 

basis/sequences/unrolled/unrolled.factor

@@ -25,7 +25,7 @@ PRIVATE>
     (unrolled-collect) unrolled-each-integer ; inline
 
 : unrolled-map-integers ( n quot: ( n -- value ) exemplar -- newseq )
-    [ over ] dip [ [ unrolled-collect ] keep ] new-like ; inline
+    overd [ [ unrolled-collect ] keep ] new-like ; inline
 
 ERROR: unrolled-bounds-error
     seq unroll-length ;
@@ -70,7 +70,7 @@ ERROR: unrolled-2bounds-error
     pick unrolled-map-as-unsafe ; inline
 
 : unrolled-2map-unsafe ( xseq yseq len quot: ( x y -- newx ) -- newseq )
-    4 npick unrolled-2map-as-unsafe ; inline
+    reach unrolled-2map-as-unsafe ; inline
 
 PRIVATE>
 
@@ -93,7 +93,7 @@ PRIVATE>
     pick unrolled-map-as ; inline
 
 : unrolled-2map ( xseq yseq len quot: ( x y -- newx ) -- newseq )
-    4 npick unrolled-2map-as ; inline
+    reach unrolled-2map-as ; inline
 
 : unrolled-map-index ( seq len quot: ( x i -- newx ) -- newseq )
     [ dup length <iota> ] 2dip unrolled-2map ; inline

basis/sequences/windowed/windowed.factor

@@ -22,7 +22,7 @@ M: windowed-sequence length
     [ drop 0 ] [ length ] bi clamp ; inline
 
 : in-bounds ( a b sequence -- a' b' sequence )
-    [ nip in-bound ] [ [ nip ] dip in-bound ] [ 2nip ] 3tri ;
+    [ nip in-bound ] [ nipd in-bound ] [ 2nip ] 3tri ;
 
 :: rolling-map ( ... seq n quot: ( ... slice -- ... elt ) -- ... newseq )
     seq length [

basis/shuffle/shuffle-docs.factor

@@ -1,7 +0,0 @@
-USING: help.markup help.syntax ;
-IN: shuffle
-
-HELP: spin  $complex-shuffle ;
-HELP: roll  $complex-shuffle ;
-HELP: -roll $complex-shuffle ;
-HELP: tuck  $complex-shuffle ;

basis/shuffle/shuffle-tests.factor

@@ -3,6 +3,3 @@ USING: shuffle tools.test ;
 { 1 2 3 4 } [ 3 4 1 2 2swap ] unit-test
 
 { 4 2 3 } [ 1 2 3 4 shuffle( a b c d -- d b c ) ] unit-test
-
-{ 2 3 4 1 } [ 1 2 3 4 roll ] unit-test
-{ 1 2 3 4 } [ 2 3 4 1 -roll ] unit-test

basis/shuffle/shuffle.factor

@@ -14,12 +14,6 @@ MACRO: shuffle-effect ( effect -- quot )
 SYNTAX: shuffle(
     ")" parse-effect suffix! \ shuffle-effect suffix! ;
 
-: tuck ( x y -- y x y ) swap over ; inline deprecated
-
 : spin ( x y z -- z y x ) swap rot ; inline deprecated
 
-: roll ( x y z t -- y z t x ) [ rot ] dip swap ; inline deprecated
-
-: -roll ( x y z t -- t x y z ) swap [ -rot ] dip ; inline deprecated
-
 : 2swap ( x y z t -- z t x y ) 2 2 mnswap ; inline

basis/stack-checker/known-words/known-words.factor

@@ -61,23 +61,34 @@ IN: stack-checker.known-words
     } cond ;
 
 {
-    { drop  ( x       --                 ) }
-    { 2drop ( x y     --                 ) }
-    { 3drop ( x y z   --                 ) }
-    { 4drop ( w x y z --                 ) }
-    { dup   ( x       -- x x             ) }
-    { 2dup  ( x y     -- x y x y         ) }
-    { 3dup  ( x y z   -- x y z x y z     ) }
-    { 4dup  ( w x y z -- w x y z w x y z ) }
-    { rot   ( x y z   -- y z x           ) }
-    { -rot  ( x y z   -- z x y           ) }
-    { dupd  ( x y     -- x x y           ) }
-    { swapd ( x y z   -- y x z           ) }
-    { nip   ( x y     -- y               ) }
-    { 2nip  ( x y z   -- z               ) }
-    { over  ( x y     -- x y x           ) }
-    { pick  ( x y z   -- x y z x         ) }
-    { swap  ( x y     -- y x             ) }
+    { drop  ( x         --                 ) }
+    { 2drop ( x y       --                 ) }
+    { 3drop ( x y z     --                 ) }
+    { 4drop ( w x y z   --                 ) }
+    { dup   ( x         -- x x             ) }
+    { 2dup  ( x y       -- x y x y         ) }
+    { 3dup  ( x y z     -- x y z x y z     ) }
+    { 4dup  ( w x y z   -- w x y z w x y z ) }
+    { rot   ( x y z     -- y z x           ) }
+    { -rot  ( x y z     -- z x y           ) }
+    { roll  ( w x y z   -- x y z w         ) }
+    { -roll ( w x y z   -- z w x y         ) }
+    { reach ( w x y z   -- w x y z w       ) }
+    { dupd  ( x y       -- x x y           ) }
+    { swapd ( x y z     -- y x z           ) }
+    { nip   ( x y       -- y               ) }
+    { 2nip  ( x y z     -- z               ) }
+    { 3nip  ( w x y z   -- z               ) }
+    { 4nip  ( v w x y z -- z               ) }
+    { nipd  ( x y z     -- y z             ) }
+    { 2nipd ( w x y z   -- y z             ) }
+    { 3nipd ( v w x y z -- y z             ) }
+    { over  ( x y       -- x y x           ) }
+    { overd ( x y z     -- x y x z         ) }
+    { pick  ( x y z     -- x y z x         ) }
+    { pickd ( w x y z   -- w x y w z       ) }
+    { swap  ( x y       -- y x             ) }
+    { tuck  ( x y       -- y x y           ) }
 } [ "shuffle" set-word-prop ] assoc-each
 
 : check-declaration ( declaration -- declaration )

basis/stack-checker/stack-checker-tests.factor

@@ -453,7 +453,7 @@ DEFER: eee'
 
 ! ensure that polymorphic checking works on recursive combinators
 : (recursive-reduce) ( identity i seq quot: ( prev elt -- next ) n -- result )
-    [ pick ] dip swap over < [
+    pickd tuck < [
         [ [ [ nth-unsafe ] dip call ] 3keep [ 1 + ] 2dip ] dip
         (recursive-reduce)
     ] [ 4drop ] if ; inline recursive

basis/tools/deploy/backend/backend.factor

@@ -20,7 +20,7 @@ ERROR: can't-deploy-library-file library ;
 
 : copy-library ( dir library -- )
     dup find-library-file
-    [ swap over file-name append-path copy-file ]
+    [ tuck file-name append-path copy-file ]
     [ can't-deploy-library-file ] ?if ;
 
 : copy-libraries ( manifest name dir -- )

basis/ui/backend/windows/windows.factor

@@ -458,7 +458,7 @@ SYMBOL: nc-buttons
 : handle-wm-buttonup ( hWnd uMsg wParam lParam -- )
     mouse-captured get [ release-capture ] when
     pick message>button drop dup nc-buttons get member? [
-        nc-buttons get remove! drop 4drop
+        nc-buttons get remove! 5drop
     ] [
         drop prepare-mouse send-button-up
     ] if ;

basis/unicode/normalize/normalize.factor

@@ -137,7 +137,7 @@ DEFER: compose-iter
 
 : try-noncombining ( state char -- state )
     [ drop ] [ [ char>> ] dip combine-chars ] 2bi
-    [ >>char to f >>last-class compose-iter ] when* ; inline
+    [ >>char to f >>last-class compose-iter ] when* ; inline recursive
 
 : compose-iter ( state -- state )
     dup current [

basis/windows/directx/dinput/constants/constants.factor

@@ -71,7 +71,7 @@ M: array array-base-type first ;
 >>
 
 MACRO: <DIDATAFORMAT> ( dwFlags dwDataSize struct rgodf-array -- alien )
-    [ DIDATAFORMAT heap-size DIOBJECTDATAFORMAT heap-size ] 4 ndip
+    [ DIDATAFORMAT heap-size DIOBJECTDATAFORMAT heap-size ] 4dip
     [ nip length ] [ make-DIOBJECTDATAFORMAT-array-quot ] 2bi
     '[ _ _ _ _ _ @ DIDATAFORMAT <struct-boa> ] ;
 

basis/windows/iphlpapi/iphlpapi.factor

@@ -387,7 +387,7 @@ FUNCTION: DWORD GetNetworkParams ( PFIXED_INFO pFixedInfo, PULONG pOutBufLen )
 
 : get-fixed-info ( -- FIXED_INFO )
     FIXED_INFO <struct> dup byte-length ulong <ref>
-    [ GetNetworkParams n>win32-error-check ] 2keep drop ;
+    [ GetNetworkParams n>win32-error-check ] keepd ;
 
 : dns-server-ips ( -- sequence )
     get-fixed-info DnsServerList>> [

basis/xml/tests/xmltest/canonxml.html

@@ -1,44 +1,44 @@
-<HTML>
-<TITLE>Canonical XML</TITLE>
-<BODY>
-<H1>Canonical XML</H1>
-<P>
-This document defines a subset of XML called canonical XML.
-The intended use of canonical XML is in testing XML processors,
-as a representation of the result of parsing an XML document.
-<P>
-Every well-formed XML document has a unique structurally equivalent
-canonical XML document.  Two structurally equivalent XML
-documents have a byte-for-byte identical canonical XML document.
-Canonicalizing an XML document requires only information that an XML
-processor is required to make available to an application.
-<P>
-A canonical XML document conforms to the following grammar:
-<PRE>
-CanonXML    ::= Pi* element Pi*
-element     ::= Stag (Datachar | Pi | element)* Etag
-Stag        ::= '&lt;'  Name Atts '&gt;'
-Etag        ::= '&lt;/' Name '&gt;'
-Pi          ::= '&lt;?' Name ' ' (((Char - S) Char*)? - (Char* '?&gt;' Char*)) '?&gt;'
-Atts        ::= (' ' Name '=' '"' Datachar* '"')*
-Datachar    ::= '&amp;amp;' | '&amp;lt;' | '&amp;gt;' | '&amp;quot;'
-                 | '&amp;#9;'| '&amp;#10;'| '&amp;#13;'
-                 | (Char - ('&amp;' | '&lt;' | '&gt;' | '"' | #x9 | #xA | #xD))
-Name        ::= (see XML spec)
-Char        ::= (see XML spec)
-S           ::= (see XML spec)
-</PRE>
-<P>
-Attributes are in lexicographical order (in Unicode bit order).
-<P>
-A canonical XML document is encoded in UTF-8.
-<P>
-Ignorable white space is considered significant and is treated equivalently
-to data.
-<P>
-<ADDRESS>
-<A HREF="mailto:jjc@jclark.com">James Clark</A>
-</ADDRESS>
-
-</BODY>
+<HTML>
+<TITLE>Canonical XML</TITLE>
+<BODY>
+<H1>Canonical XML</H1>
+<P>
+This document defines a subset of XML called canonical XML.
+The intended use of canonical XML is in testing XML processors,
+as a representation of the result of parsing an XML document.
+<P>
+Every well-formed XML document has a unique structurally equivalent
+canonical XML document.  Two structurally equivalent XML
+documents have a byte-for-byte identical canonical XML document.
+Canonicalizing an XML document requires only information that an XML
+processor is required to make available to an application.
+<P>
+A canonical XML document conforms to the following grammar:
+<PRE>
+CanonXML    ::= Pi* element Pi*
+element     ::= Stag (Datachar | Pi | element)* Etag
+Stag        ::= '&lt;'  Name Atts '&gt;'
+Etag        ::= '&lt;/' Name '&gt;'
+Pi          ::= '&lt;?' Name ' ' (((Char - S) Char*)? - (Char* '?&gt;' Char*)) '?&gt;'
+Atts        ::= (' ' Name '=' '"' Datachar* '"')*
+Datachar    ::= '&amp;amp;' | '&amp;lt;' | '&amp;gt;' | '&amp;quot;'
+                 | '&amp;#9;'| '&amp;#10;'| '&amp;#13;'
+                 | (Char - ('&amp;' | '&lt;' | '&gt;' | '"' | #x9 | #xA | #xD))
+Name        ::= (see XML spec)
+Char        ::= (see XML spec)
+S           ::= (see XML spec)
+</PRE>
+<P>
+Attributes are in lexicographical order (in Unicode bit order).
+<P>
+A canonical XML document is encoded in UTF-8.
+<P>
+Ignorable white space is considered significant and is treated equivalently
+to data.
+<P>
+<ADDRESS>
+<A HREF="mailto:jjc@jclark.com">James Clark</A>
+</ADDRESS>
+
+</BODY>
 </HTML>

basis/xml/tests/xmltest/readme.html

@@ -1,60 +1,60 @@
-<HTML>
-<TITLE>XML Test Cases</TITLE>
-<BODY>
-<H1>XML Test Cases version 1998-11-18</H1>
-<P>
-Copyright (C) 1998 James Clark.  All rights reserved.  Permission is
-granted to copy and modify this collection in any way for internal use
-within a company or organization.  Permission is granted to
-redistribute the file <code>xmltest.zip</code> containing this
-collection to third parties provided that no modifications of any kind
-are made to this file.  Note that permission to distribute the
-collection in any other form is not granted.
-<P>
-The collection is structured into three directories:
-<DL>
-<DT><CODE>not-wf</CODE>
-<DD>this contains cases that are not well-formed XML documents
-<DT><CODE>valid</CODE>
-<DD>this contains cases that are valid XML documents
-<DT><CODE>invalid</CODE>
-<DD>this contains cases that are well-formed XML documents
-but are not valid XML documents
-</DL>
-<P>
-The <CODE>not-wf</CODE> and <CODE>valid</CODE> directories each have
-three subdirectories:
-<DL>
-<DT>
-<CODE>sa</CODE>
-<DD>
-this contains cases that are standalone (as defined in XML) and do not
-have references to external general entities
-<DT>
-<CODE>ext-sa</CODE>
-<DD>
-this contains case that are standalone and have references to external
-general entities
-<DT>
-<CODE>not-sa</CODE>
-<DD>
-this contains cases that are not standalone
-</DL>
-<P>
-In each directory, files with a <CODE>.xml</CODE> extension are the
-XML document test cases, and files with a <CODE>.ent</CODE> extension
-are external entities referenced by the test cases.
-<P>
-Within the <CODE>valid</CODE> directory, each of these three
-subdirectories has an <CODE>out</CODE> subdirectory which contains an
-equivalent <A HREF="canonxml.html">canonical XML</A> document for each
-of the cases.
-<P>
-<P>
-Bug reports and contributions of new test cases are welcome.
-<P>
-<ADDRESS>
-<A HREF="mailto:jjc@jclark.com">James Clark</A>
-</ADDRESS>
-</BODY>
-</HTML>
+<HTML>
+<TITLE>XML Test Cases</TITLE>
+<BODY>
+<H1>XML Test Cases version 1998-11-18</H1>
+<P>
+Copyright (C) 1998 James Clark.  All rights reserved.  Permission is
+granted to copy and modify this collection in any way for internal use
+within a company or organization.  Permission is granted to
+redistribute the file <code>xmltest.zip</code> containing this
+collection to third parties provided that no modifications of any kind
+are made to this file.  Note that permission to distribute the
+collection in any other form is not granted.
+<P>
+The collection is structured into three directories:
+<DL>
+<DT><CODE>not-wf</CODE>
+<DD>this contains cases that are not well-formed XML documents
+<DT><CODE>valid</CODE>
+<DD>this contains cases that are valid XML documents
+<DT><CODE>invalid</CODE>
+<DD>this contains cases that are well-formed XML documents
+but are not valid XML documents
+</DL>
+<P>
+The <CODE>not-wf</CODE> and <CODE>valid</CODE> directories each have
+three subdirectories:
+<DL>
+<DT>
+<CODE>sa</CODE>
+<DD>
+this contains cases that are standalone (as defined in XML) and do not
+have references to external general entities
+<DT>
+<CODE>ext-sa</CODE>
+<DD>
+this contains case that are standalone and have references to external
+general entities
+<DT>
+<CODE>not-sa</CODE>
+<DD>
+this contains cases that are not standalone
+</DL>
+<P>
+In each directory, files with a <CODE>.xml</CODE> extension are the
+XML document test cases, and files with a <CODE>.ent</CODE> extension
+are external entities referenced by the test cases.
+<P>
+Within the <CODE>valid</CODE> directory, each of these three
+subdirectories has an <CODE>out</CODE> subdirectory which contains an
+equivalent <A HREF="canonxml.html">canonical XML</A> document for each
+of the cases.
+<P>
+<P>
+Bug reports and contributions of new test cases are welcome.
+<P>
+<ADDRESS>
+<A HREF="mailto:jjc@jclark.com">James Clark</A>
+</ADDRESS>
+</BODY>
+</HTML>

basis/xml/tokenize/tokenize.factor

@@ -87,7 +87,7 @@ HINTS: next* { spot } ;
     [ blank? not ] skip-until ;
 
 : next-matching ( pos ch str -- pos' )
-    [ over ] dip nth eq? [ 1 + ] [ drop 0 ] if ; inline
+    overd nth eq? [ 1 + ] [ drop 0 ] if ; inline
 
 : string-matcher ( str -- quot: ( pos char -- pos ? ) )
     dup length 1 - '[ _ next-matching dup _ > ] ; inline

basis/xmode/catalog/catalog.factor

@@ -117,7 +117,7 @@ DEFER: finalize-rule-set
     [ file-name ] dip
     modes
     [ nip [ 2dup ] dip suitable-mode? ] assoc-find
-    2drop [ 2drop ] dip ;
+    2drop 2nip ;
 
 : find-mode ( file-name first-line -- mode )
     ?find-mode "text" or ; inline

core/alien/strings/strings.factor

@@ -38,7 +38,7 @@ M: c-ptr string>alien drop ;
     drop [ length ] keep over [
         1 + (byte-array) [
             [
-                [ [ string-nth-fast ] 2keep drop ]
+                [ [ string-nth-fast ] keepd ]
                 [ set-nth-unsafe ] bi*
             ] 2curry each-integer
         ] keep

core/assocs/assocs.factor

@@ -37,7 +37,7 @@ M: assoc assoc-like drop ; inline
         3drop f
     ] [
         3dup nth-unsafe at*
-        [ [ 3drop ] dip ] [ drop [ 1 - ] dip (assoc-stack) ] if
+        [ 3nip ] [ drop [ 1 - ] dip (assoc-stack) ] if
     ] if ; inline recursive
 
 : search-alist ( key alist -- pair/f i/f )
@@ -156,7 +156,7 @@ M: assoc values [ nip ] { } assoc>map ;
     over [ set-at ] with-assoc assoc-each ;
 
 : assoc-union-as ( assoc1 assoc2 exemplar -- union )
-    [ [ [ assoc-size ] bi@ + ] dip new-assoc ] 3keep drop
+    [ [ [ assoc-size ] bi@ + ] dip new-assoc ] 2keepd
     [ assoc-union! ] bi@ ;
 
 : assoc-union ( assoc1 assoc2 -- union )

core/classes/tuple/parser/parser.factor

@@ -97,7 +97,7 @@ M: tuple-class boa>object
     swap slots>tuple ;
 
 : check-slot-exists ( class initials slot-spec/f index/f name -- class initials slot-spec index )
-    over [ drop ] [ nip nip nip bad-slot-name ] if ;
+    over [ drop ] [ 3nip bad-slot-name ] if ;
 
 : slot-named-checked ( class initials name slots -- class initials slot-spec )
     over [ slot-named* ] dip check-slot-exists drop ;

core/classes/tuple/tuple.factor

@@ -208,7 +208,7 @@ M: object final-class? drop f ;
     pick [
         [ [ swap nth dup ] dip instance? ] dip swap
         [ drop ] [ nip ] if
-    ] [ [ 3drop ] dip ] if ;
+    ] [ 3nip ] if ;
 
 : apply-slot-permutation ( old-values triples -- new-values )
     [ first3 update-slot ] with map ;

core/effects/effects.factor

@@ -21,7 +21,7 @@ TUPLE: effect
     f f effect boa ; inline
 
 : <variable-effect> ( in-var in out-var out -- effect )
-    swap [ rot ] dip [ ?terminated ] 2dip effect boa ;
+    swap rotd [ ?terminated ] 2dip effect boa ;
 
 : effect-height ( effect -- n )
     [ out>> length ] [ in>> length ] bi - ; inline

core/effects/parser/parser.factor

@@ -45,7 +45,7 @@ PRIVATE>
         { [ effect-closer? ] [ stack-effect-omits-dashes ] }
         { [ row-variable? ] [ parse-effect-var t ] }
         [
-            [ drop ] 2dip standalone-type?
+            nipd standalone-type?
             [ parse-standalone-type ] [ parse-effect-value ] if , t
         ]
     } cond ;

core/generic/generic.factor

@@ -191,7 +191,7 @@ GENERIC#: check-combination-effect 1 ( combination effect -- )
 M: object check-combination-effect 2drop ;
 
 : define-generic ( word combination effect -- )
-    [ [ check-combination-effect ] keep swap set-stack-effect ]
+    [ [ check-combination-effect ] keep set-stack-effect ]
     [
         drop
         2dup [ "combination" word-prop ] dip = [ 2drop ] [

core/growable/growable.factor

@@ -20,7 +20,7 @@ M: growable set-nth-unsafe underlying>> set-nth-unsafe ; inline
     [ set-nth-unsafe ] [ [ 1 fixnum+fast ] dip length<< ] 2bi ; inline
 
 : push-all-unsafe ( from to src dst -- )
-    [ over - swap ] 2dip [ pick ] dip [ length integer>fixnum ] keep
+    [ over - swap ] 2dip pickd [ length integer>fixnum ] keep
     [ [ fixnum+fast ] dip length<< ] 2keep <copy> (copy) drop ; inline
 
 PRIVATE>

core/hash-sets/hash-sets.factor

@@ -49,7 +49,7 @@ TUPLE: hash-set
         [ pick or [ probe ] dip (new-key@) ]
         if
     ] [
-        [ [ pick ] dip = ] 2dip rot
+        [ pickd = ] 2dip rot
         [ nip [ drop ] 3dip f ]
         [ [ probe ] dip (new-key@) ]
         if
@@ -125,7 +125,7 @@ M: hash-set ?adjoin
 
 M: hash-set members
     [ array>> 0 swap ] [ cardinality f <array> ] bi [
-        [ [ over ] dip set-nth-unsafe 1 + ] curry each-member
+        [ overd set-nth-unsafe 1 + ] curry each-member
     ] keep nip ;
 
 M: hash-set clone

core/hashtables/hashtables.factor

@@ -73,7 +73,7 @@ TUPLE: hashtable
         [ pick or [ probe ] dip (new-key@) ]
         if
     ] [
-        [ [ pick ] dip = ] 2dip rot
+        [ pickd = ] 2dip rot
         [ nip [ drop ] 3dip f ]
         [ [ probe ] dip (new-key@) ]
         if
@@ -154,7 +154,7 @@ M: hashtable set-at
 
 : collect-pairs ( hash quot: ( key value -- elt ) -- seq )
     [ [ array>> 0 swap ] [ assoc-size f <array> ] bi ] dip swap [
-        [ [ over ] dip set-nth-unsafe 1 + ] curry compose each-pair
+        [ overd set-nth-unsafe 1 + ] curry compose each-pair
     ] keep nip ; inline
 
 PRIVATE>

core/io/encodings/encodings.factor

@@ -44,7 +44,7 @@ CONSTANT: replacement-char 0xfffd
     { string } declare ! aux>> must be f
     [ length ] keep over (byte-array) [
         [
-            [ [ string-nth-fast ] 2keep drop ]
+            [ [ string-nth-fast ] keepd ]
             [ set-nth-unsafe ] bi*
         ] 2curry each-integer
     ] keep ; inline
@@ -53,7 +53,7 @@ CONSTANT: replacement-char 0xfffd
     { byte-array } declare
     [ length ] keep over 0 <string> [
         [
-            [ [ nth-unsafe ] 2keep drop ]
+            [ [ nth-unsafe ] keepd ]
             [
                 pick 127 <=
                 [ set-string-nth-fast ]
@@ -119,17 +119,14 @@ M: decoder stream-read1 ( decoder -- ch )
 : (store-read) ( buf stream encoding n c i -- buf stream encoding n )
     [ rot [ set-nth-unsafe ] keep ] 2curry 3dip ; inline
 
-: (finish-read) ( buf stream encoding n i -- i )
-    2nip 2nip ; inline
-
 : (read-next) ( stream encoding n i -- stream encoding n i c )
     [ 2dup decode-char ] 2dip rot ; inline
 
 : (read-rest) ( buf stream encoding n i -- count )
-    2dup = [ (finish-read) ] [
+    2dup = [ 4nip ] [
         (read-next) [
             swap [ (store-read) ] [ 1 + ] bi (read-rest)
-        ] [ (finish-read) ] if*
+        ] [ 4nip ] if*
     ] if ; inline recursive
 
 M: decoder stream-read-unsafe
@@ -167,11 +164,11 @@ M: decoder stream-read-until
             dup CHAR: \n = [
                 2drop stream-read-until
             ] [
-                [ 2drop ] 2dip
+                2nipd
             ] if
         ] [
             first-unsafe CHAR: \n = [ [ rest ] dip ] when
-            [ 2drop ] 2dip
+            2nipd
         ] if-empty
     ] [
         >decoder< decode-until

core/io/encodings/utf16/utf16.factor

@@ -101,13 +101,13 @@ M: utf16le encode-char ( char stream encoding -- )
     drop char>utf16le ;
 
 : ascii-char>utf16-byte-array ( off n byte-array string -- )
-    [ over ] dip string-nth-fast -rot
+    overd string-nth-fast -rot
     [ 2 fixnum*fast rot fixnum+fast ] dip
     set-nth-unsafe ; inline
 
 : ascii-string>utf16-byte-array ( off string -- byte-array )
     [ length >fixnum [ <iota> ] [ 2 fixnum*fast <byte-array> ] bi ] keep
-    [ [ ascii-char>utf16-byte-array ] 2curry with each ] 2keep drop ; inline
+    [ [ ascii-char>utf16-byte-array ] 2curry with each ] keepd ; inline
 
 : ascii-string>utf16le ( string stream -- )
     [ 0 swap ascii-string>utf16-byte-array ] dip stream-write ; inline

core/io/io.factor

@@ -118,11 +118,11 @@ SYMBOL: error-stream
     stream-exemplar new-sequence ; inline
 
 : resize-if-necessary ( wanted-n got-n seq -- seq' )
-    2over = [ [ 2drop ] dip ] [ resize nip ] if ; inline
+    2over = [ 2nip ] [ resize nip ] if ; inline
 
 : (read-into-new) ( n stream quot -- seq/f )
     [ dup ] 2dip
-    [ 2dup (new-sequence-for-stream) swap ] dip curry keep
+    [ 2dup (new-sequence-for-stream) swap ] dip keepd
     over 0 = [ 3drop f ] [ resize-if-necessary ] if ; inline
 
 : (read-into) ( buf stream quot -- buf-slice/f )
@@ -173,7 +173,7 @@ CONSTANT: each-block-size 65536
 
 : (each-stream-block-slice) ( ... stream quot: ( ... block-slice -- ... ) block-size -- ... )
     [ [ drop ] prepose swap ] dip
-    [ swap (new-sequence-for-stream) ] curry keep
+    [ swap (new-sequence-for-stream) ] keepd
     [ stream-read-partial-into ] 2curry each-morsel drop ; inline
 
 : each-stream-block-slice ( ... stream quot: ( ... block-slice -- ... ) -- ... )
@@ -194,7 +194,7 @@ CONSTANT: each-block-size 65536
 : (stream-contents-by-length) ( stream len -- seq )
     dup rot
     [ (new-sequence-for-stream) ]
-    [ [ stream-read-unsafe ] curry keep resize ] bi ; inline
+    [ [ stream-read-unsafe ] keepd resize ] bi ; inline
 
 : (stream-contents-by-block) ( stream -- seq )
     [ [ ] collector [ each-stream-block ] dip { } like ]
@@ -225,11 +225,11 @@ CONSTANT: each-block-size 65536
 <PRIVATE
 
 : read-loop ( buf stream n i -- count )
-     2dup = [ nip nip nip ] [
+     2dup = [ 3nip ] [
         pick stream-read1 [
             over [ pick set-nth-unsafe ] 2curry 3dip
             1 + read-loop
-        ] [ nip nip nip ] if*
+        ] [ 3nip ] if*
      ] if ; inline recursive
 
 : finalize-read-until ( seq sep/f -- seq/f sep/f )

core/io/streams/byte-array/byte-array.factor

@@ -13,7 +13,7 @@ M: byte-vector stream-tell length ; inline
     512 <byte-vector> swap <encoder> ; inline
 
 : with-byte-writer ( encoding quot -- byte-array )
-    [ <byte-writer> ] dip [ with-output-stream* ] 2keep drop
+    [ <byte-writer> ] dip [ with-output-stream* ] keepd
     dup encoder? [ stream>> ] when >byte-array ; inline
 
 TUPLE: byte-reader { underlying byte-array read-only } { i array-capacity } ;

core/io/streams/c/c.factor

@@ -53,9 +53,9 @@ M: c-reader stream-read1
 : read-until-loop ( handle seps accum -- accum ch )
     pick fgetc dup [
         pick dupd member-eq?
-        [ [ 2drop ] 2dip ] [ suffix! read-until-loop ] if
+        [ 2nipd ] [ suffix! read-until-loop ] if
     ] [
-        [ 2drop ] 2dip
+        2nipd
     ] if ; inline recursive
 
 M: c-reader stream-read-until

core/io/streams/sequence/sequence.factor

@@ -41,7 +41,7 @@ ERROR: not-a-string obj ;
     [ integer>fixnum ]
     [ dup slice? [ [ seq>> ] [ from>> ] bi ] [ 0 ] if ]
     [
-        swap over stream-element-type +byte+ eq?
+        tuck stream-element-type +byte+ eq?
         [ check-byte-array sequence-copy-unsafe ]
         [ check-string sequence-copy-unsafe ] if
     ] tri* ; inline

core/kernel/kernel-docs.factor

@@ -40,6 +40,9 @@ HELP: 2over $shuffle ;
 HELP: pick  $shuffle ;
 HELP: swap  $shuffle ;
 
+HELP: roll  $complex-shuffle ;
+HELP: -roll $complex-shuffle ;
+HELP: tuck  $complex-shuffle ;
 HELP: rot   $complex-shuffle ;
 HELP: -rot  $complex-shuffle ;
 HELP: dupd  $complex-shuffle ;

core/kernel/kernel-tests.factor

@@ -132,7 +132,7 @@ IN: kernel.tests
 
 ! Regression
 : (loop) ( a b c d -- )
-    [ pick ] dip swap [ pick ] dip swap
+    pickd swap pickd swap
     < [ [ 1 + ] 3dip (loop) ] [ 4drop ] if ; inline recursive
 
 : loop ( obj -- )
@@ -201,3 +201,6 @@ IN: kernel.tests
 
 { 1 2 3 1 2 3 } [ 1 2 3 3dup ] unit-test
 { 1 2 3 4 1 2 3 4 } [ 1 2 3 4 4dup ] unit-test
+
+{ 2 3 4 1 } [ 1 2 3 4 roll ] unit-test
+{ 1 2 3 4 } [ 2 3 4 1 -roll ] unit-test

core/kernel/kernel.factor

@@ -116,6 +116,39 @@ DEFER: if
 
 : 4dip ( w x y z quot -- w x y z ) swap [ 3dip ] dip ; inline
 
+! Misfits
+: tuck ( x y -- y x y ) dup -rot ; inline
+
+: spin ( x y z -- z y x ) -rot swap ; inline
+
+: rotd ( w x y z -- x y w z ) [ rot ] dip ; inline
+
+: -rotd ( w x y z -- w z x y ) [ -rot ] dip ; inline
+
+: roll ( w x y z -- x y z w ) rotd swap ; inline
+
+: -roll ( w x y z -- z w x y ) swap -rotd ; inline
+
+: nipd ( x y z -- y z ) [ nip ] dip ; inline
+
+: overd ( x y z -- x y x z ) [ over ] dip ; inline
+
+: pickd ( w x y z -- w x y w z ) [ pick ] dip ; inline
+
+: 2nipd ( w x y z -- y z ) [ 2drop ] 2dip ; inline
+
+: 3nipd ( v w x y z -- y z ) [ 3drop ] 2dip ; inline
+
+: 3nip ( w x y z -- z ) 2nip nip ; inline
+
+: 4nip ( v w x y z -- z ) 2nip 2nip ; inline
+
+: 5nip ( u v w x y z -- z ) 3nip 2nip ; inline
+
+: 5drop ( v w x y z -- ) 4drop drop ; inline
+
+: reach ( w x y z -- w x y z w ) [ pick ] dip swap ; inline
+
 ! Keepers
 : keep ( ..a x quot: ( ..a x -- ..b ) -- ..b x )
     over [ call ] dip ; inline
@@ -129,6 +162,15 @@ DEFER: if
 : 4keep ( ..a w x y z quot: ( ..a w x y z -- ..b ) -- ..b w x y z )
     [ 4dup ] dip 4dip ; inline
 
+: keepd ( ..a x y quot: ( ..a x y -- ..b x ) -- ..b x )
+    2keep drop ; inline
+
+: keepdd ( ..a x y z quot: ( ..a x y z -- ..b x ) -- ..b x )
+    3keep 2drop ; inline
+
+: 2keepd ( ..a x y z quot: ( ..a x y z -- ..b x y ) -- ..b x y )
+    3keep drop ; inline
+
 ! Cleavers
 : bi ( x p q -- )
     [ keep ] dip call ; inline

core/math/math.factor

@@ -245,50 +245,43 @@ GENERIC: prev-float ( m -- n )
 : align ( m w -- n )
     1 - [ + ] keep bitnot bitand ; inline
 
-<PRIVATE
-
-: iterate-prep ( n quot -- i n quot ) [ 0 ] 2dip ; inline
-
-: if-iterate? ( i n true false -- ) [ 2over < ] 2dip if ; inline
-
-: iterate-step ( i n quot -- i n quot )
-    ! Apply quot to i, keep i and quot, hide n.
-    [ nip call ] 3keep ; inline
-
-: iterate-rot ( ? i n quot -- i n quot ? )
-    [ rot ] dip swap ; inline
-
-: iterate-next ( i n quot -- i' n quot ) [ 1 + ] 2dip ; inline
-
-PRIVATE>
-
 : (each-integer) ( ... i n quot: ( ... i -- ... ) -- ... )
-    [ iterate-step iterate-next (each-integer) ]
-    [ 3drop ] if-iterate? ; inline recursive
+    2over < [
+        [ nip call ] 3keep
+        [ 1 + ] 2dip (each-integer)
+    ] [
+        3drop
+    ] if ; inline recursive
 
 : (find-integer) ( ... i n quot: ( ... i -- ... ? ) -- ... i/f )
-    [
-        iterate-step iterate-rot
-        [ 2drop ] [ iterate-next (find-integer) ] if
-    ] [ 3drop f ] if-iterate? ; inline recursive
+    2over < [
+        [ nip call ] 3keep roll
+        [ 2drop ]
+        [ [ 1 + ] 2dip (find-integer) ] if
+    ] [
+        3drop f
+    ] if ; inline recursive
 
 : (all-integers?) ( ... i n quot: ( ... i -- ... ? ) -- ... ? )
-    [
-        iterate-step iterate-rot
-        [ iterate-next (all-integers?) ] [ 3drop f ] if
-    ] [ 3drop t ] if-iterate? ; inline recursive
+    2over < [
+        [ nip call ] 3keep roll
+        [ [ 1 + ] 2dip (all-integers?) ]
+        [ 3drop f ] if
+    ] [
+        3drop t
+    ] if ; inline recursive
 
 : each-integer ( ... n quot: ( ... i -- ... ) -- ... )
-    iterate-prep (each-integer) ; inline
+    [ 0 ] 2dip (each-integer) ; inline
 
 : times ( ... n quot: ( ... -- ... ) -- ... )
     [ drop ] prepose each-integer ; inline
 
 : find-integer ( ... n quot: ( ... i -- ... ? ) -- ... i/f )
-    iterate-prep (find-integer) ; inline
+    [ 0 ] 2dip (find-integer) ; inline
 
 : all-integers? ( ... n quot: ( ... i -- ... ? ) -- ... ? )
-    iterate-prep (all-integers?) ; inline
+    [ 0 ] 2dip (all-integers?) ; inline
 
 : find-last-integer ( ... n quot: ( ... i -- ... ? ) -- ... i/f )
     over 0 < [

core/math/parser/parser.factor

@@ -309,7 +309,7 @@ DEFER: @neg-digit
             { [ dup "bB" member-eq? ] [ 2drop  2 ->radix require-next-digit ] }
             { [ dup "oO" member-eq? ] [ 2drop  8 ->radix require-next-digit ] }
             { [ dup "xX" member-eq? ] [ 2drop 16 ->radix require-next-digit ] }
-            [ [ drop ] 2dip swap call ]
+            [ nipd swap call ]
         } cond
     ] 2curry next-digit ; inline
 

core/sequences/sequences.factor

@@ -90,7 +90,7 @@ M: sequence nth-unsafe nth ; inline
 M: sequence set-nth-unsafe set-nth ; inline
 
 : change-nth-unsafe ( i seq quot -- )
-    [ [ nth-unsafe ] dip call ] 3keep drop set-nth-unsafe ; inline
+    [ [ nth-unsafe ] dip call ] 2keepd set-nth-unsafe ; inline
 
 PRIVATE>
 
@@ -380,7 +380,7 @@ PRIVATE>
 : glue ( seq1 seq2 seq3 -- newseq ) swap 3append ; inline
 
 : change-nth ( ..a i seq quot: ( ..a elt -- ..b newelt ) -- ..b )
-    [ [ nth ] dip call ] 3keep drop set-nth-unsafe ; inline
+    [ [ nth ] dip call ] 2keepd set-nth-unsafe ; inline
 
 : min-length ( seq1 seq2 -- n ) [ length ] bi@ min ; inline
 
@@ -447,7 +447,7 @@ PRIVATE>
     if ; inline
 
 : (accumulate) ( seq identity quot -- identity seq quot )
-    swapd [ curry keep ] curry ; inline
+    swapd [ keepd ] curry ; inline
 
 : (accumulate*) ( seq identity quot -- identity seq quot )
     swapd [ dup ] compose ; inline
@@ -464,7 +464,7 @@ PRIVATE>
     swapd each ; inline
 
 : map-integers ( ... len quot: ( ... i -- ... elt ) exemplar -- ... newseq )
-    [ over ] dip [ [ collect ] keep ] new-like ; inline
+    overd [ [ collect ] keep ] new-like ; inline
 
 : map-as ( ... seq quot: ( ... elt -- ... newelt ) exemplar -- ... newseq )
     [ (each) ] dip map-integers ; inline
@@ -506,7 +506,7 @@ PRIVATE>
     [ (2each) ] dip -rot (each-integer) ; inline
 
 : 2reduce ( ... seq1 seq2 identity quot: ( ... prev elt1 elt2 -- ... next ) -- ... result )
-    [ -rot ] dip 2each ; inline
+    -rotd 2each ; inline
 
 : 2map-as ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... newelt ) exemplar -- ... newseq )
     [ (2each) ] dip map-integers ; inline
@@ -524,7 +524,7 @@ PRIVATE>
     [ (3each) ] dip map-integers ; inline
 
 : 3map ( ... seq1 seq2 seq3 quot: ( ... elt1 elt2 elt3 -- ... newelt ) -- ... newseq )
-    [ pick ] dip swap 3map-as ; inline
+    pickd swap 3map-as ; inline
 
 : find-from ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt )
     [ (find-integer) ] (find-from) ; inline
@@ -793,7 +793,7 @@ PRIVATE>
     2over = [
         4drop
     ] [
-        [ [ pick [ dup dup ] dip + swap ] dip move-unsafe 1 - ] keep
+        [ [ [ ] [ nip + ] [ 2nip ] 3tri ] dip move-unsafe 1 - ] keep
         move-forward
     ] if ;
 
@@ -808,7 +808,7 @@ PRIVATE>
     pick 0 = [
         3drop
     ] [
-        pick over length + over
+        [ ] [ nip length + ] [ 2nip ] 3tri
         [ pick 0 > [ [ length ] keep ] dip (open-slice) ] 2dip
         set-length
     ] if ;
@@ -1089,7 +1089,7 @@ M: repetition sum [ elt>> ] [ length>> ] bi * ; inline
         [ keep swap ] curry [ [ first ] dip call ] 2keep
         [ curry 2dip pick over ] curry
     ] [
-        [ [ 2drop ] [ [ 2drop ] 2dip ] if ] compose
+        [ [ 2drop ] [ 2nipd ] if ] compose
     ] bi* compose 1 each-from drop ; inline
 
 PRIVATE>

core/slots/slots.factor

@@ -212,7 +212,7 @@ M: anonymous-intersection initial-value*
         { [ pinned-alien bootstrap-word over class<= ] [ <bad-alien> t ] }
         { [ quotation bootstrap-word over class<= ] [ [ ] t ] }
         [ dup initial-value* ]
-    } cond [ drop ] 2dip ;
+    } cond nipd ;
 
 GENERIC: make-slot ( desc -- slot-spec )
 

core/strings/strings.factor

@@ -56,7 +56,8 @@ PRIVATE>
 
 M: string equal?
     over string? [
-        2dup [ hashcode ] bi@ eq?
+        ! faster during bootstrap than ``[ hashcode ] bi@``
+        over hashcode over hashcode eq?
         [ sequence= ] [ 2drop f ] if
     ] [
         2drop f

core/words/words.factor

@@ -111,16 +111,17 @@ M: word parent-word drop f ;
     [ changed-effects get add-to-unit ]
     [ dup primitive? [ drop ] [ changed-definition ] if ] bi ;
 
-: set-stack-effect ( effect word -- )
-    2dup "declared-effect" word-prop = [ 2drop ] [
-        [ nip changed-effect ]
-        [ nip subwords [ changed-effect ] each ]
-        [ swap "declared-effect" set-word-prop ]
+: set-stack-effect ( word effect -- )
+    2dup [ "declared-effect" word-prop ] dip =
+    [ 2drop ] [
+        [ drop changed-effect ]
+        [ drop subwords [ changed-effect ] each ]
+        [ "declared-effect" set-word-prop ]
         2tri
     ] if ;
 
 : define-declared ( word def effect -- )
-    [ nip swap set-stack-effect ] [ drop define ] 3bi ;
+    [ nip set-stack-effect ] [ drop define ] 3bi ;
 
 : make-deprecated ( word -- )
     t "deprecated" set-word-prop ;
@@ -200,7 +201,7 @@ M: word reset-word
     ] tri ;
 
 : <word> ( name vocab -- word )
-    2dup [ hashcode ] bi@ hash-combine >fixnum (word) dup new-word ;
+    over hashcode over hashcode hash-combine >fixnum (word) dup new-word ;
 
 : <uninterned-word> ( name -- word )
     f \ <uninterned-word> counter >fixnum (word)

extra/alien/fortran/fortran.factor

@@ -414,7 +414,7 @@ PRIVATE>
 : ((fortran-invoke)) ( return library function parameters -- quot )
     {
         [ 2nip [<fortran-result>] ]
-        [ nip nip nip [fortran-args>c-args] ]
+        [ 3nip [fortran-args>c-args] ]
         [ [fortran-invoke] ]
         [ 2nip [fortran-results>] ]
     } 4 ncleave 4 nappend ;

extra/assocs/extras/extras.factor

@@ -53,7 +53,7 @@ ERROR: key-exists value key assoc ;
     ] if ;
 
 : kv-with ( obj assoc quot -- assoc curried )
-    swapd [ [ -rot ] dip call ] 2curry ; inline
+    swapd [ -rotd call ] 2curry ; inline
 
 <PRIVATE
 
@@ -66,13 +66,13 @@ ERROR: key-exists value key assoc ;
 PRIVATE>
 
 : sequence>assoc! ( assoc seq map-quot: ( x -- ..y ) insert-quot: ( ..y assoc -- ) -- assoc )
-    4 nrot (sequence>assoc) ; inline
+    roll (sequence>assoc) ; inline
 
 : assoc>object ( assoc map-quot insert-quot exemplar -- object )
     clone [ swap curry compose assoc-each ] keep ; inline
 
 : assoc>object! ( assoc seq map-quot: ( x -- ..y ) insert-quot: ( ..y assoc -- ) -- object )
-    4 nrot assoc>object ; inline
+    roll assoc>object ; inline
 
 : sequence>assoc ( seq map-quot insert-quot exemplar -- assoc )
     clone (sequence>assoc) ; inline

extra/bloom-filters/bloom-filters.factor

@@ -127,7 +127,7 @@ PRIVATE>
 
 : relevant-indices ( object bloom-filter -- n quot: ( elt -- n ) )
     [ double-hashcodes ] [ #hashes-and-length ] bi*
-    [ -rot ] dip '[ _ _ combine-hashcodes _ mod ] ; inline
+    -rotd '[ _ _ combine-hashcodes _ mod ] ; inline
 
 PRIVATE>
 

extra/checksums/sodium/sodium.factor

@@ -39,7 +39,7 @@ M: sodium-state get-checksum
     dup output>> [
         dup state>> [
             over output-size>> [ <byte-array> ] keep
-            [ crypto_generichash_final check0 ] 2keep drop
+            [ crypto_generichash_final check0 ] keepd
         ] [ B{ } clone ] if*
         [ >>output ] keep
     ] unless* nip ;

extra/combinators/extras/extras.factor

@@ -40,9 +40,6 @@ MACRO: cleave-array ( quots -- quot )
 : 4tri ( w x y z p q r -- )
     [ [ 4keep ] dip 4keep ] dip call ; inline
 
-: keepd ( ..a x y quot: ( ..a x y -- ..b ) -- ..b x )
-    2keep drop ; inline
-
 : plox ( ... x/f quot: ( ... x -- ... ) -- ... )
     dupd when ; inline
 
@@ -85,10 +82,10 @@ MACRO:: n-falsify ( n -- quot )
 
 ! try the quot, keep the original arg if quot is true
 : ?1arg ( obj quot: ( obj -- ? ) -- obj/f )
-    [ ?1res ] 2keep drop '[ _ ] [ f ] if ; inline
+    [ ?1res ] keepd '[ _ ] [ f ] if ; inline
 
 : ?2arg ( obj1 obj2 quot: ( obj1 obj2 -- ? ) -- obj1/f obj2/f )
-    [ ?2res ] 3keep drop '[ _ _ ] [ f f ] if ; inline
+    [ ?2res ] 2keepd '[ _ _ ] [ f f ] if ; inline
 
 <<
 : alist>quot* ( default assoc -- quot )