: spin swap rot ;

core/bit-arrays/bit-arrays.factor

@@ -20,7 +20,7 @@ IN: bit-arrays
 
 : (set-bits) ( bit-array n -- )
     over length bits>cells -rot [
-        swap rot 4 * set-alien-unsigned-4
+        spin 4 * set-alien-unsigned-4
     ] 2curry each ; inline
 
 PRIVATE>

core/combinators/combinators.factor

@@ -63,7 +63,7 @@ M: sequence hashcode*
     next-power-of-2 swap [ nip clone ] curry map ;
 
 : distribute-buckets ( assoc initial quot -- buckets )
-    swap rot [ length <buckets> ] keep
+    spin [ length <buckets> ] keep
     [ >r 2dup r> dup first roll call (distribute-buckets) ] each
     nip ; inline
 

core/kernel/kernel-docs.factor

@@ -26,6 +26,7 @@ $nl
 { $subsection swapd }
 { $subsection rot }
 { $subsection -rot }
+{ $subsection spin }
 { $subsection roll }
 { $subsection -roll }
 "Sometimes an additional storage area is needed to hold objects. The " { $emphasis "retain stack" } " is an auxilliary stack for this purpose. Objects can be moved between the data and retain stacks using the following two words:"
@@ -37,7 +38,9 @@ $nl
 { $code
     ": foo ( m ? n -- m+n/n )"
     "    >r [ r> + ] [ drop r> ] if ; ! This is OK"
-} ;
+}
+"An alternative to using " { $link >r } " and " { $link r> } " is the following:"
+{ $subsection dip } ;
 
 ARTICLE: "basic-combinators" "Basic combinators"
 "The following pair of words invoke words and quotations reflectively:"
@@ -159,6 +162,7 @@ HELP: tuck  ( x y -- y x y )         $shuffle ;
 HELP: over  ( x y -- x y x )         $shuffle ;
 HELP: pick  ( x y z -- x y z x )     $shuffle ;
 HELP: swap  ( x y -- y x )           $shuffle ;
+HELP: spin                           $shuffle ;
 HELP: roll                           $shuffle ;
 HELP: -roll                          $shuffle ;
 
@@ -541,6 +545,14 @@ HELP: 3compose
     "However, " { $link 3compose } " runs in constant time, and the compiler is able to compile code which calls composed quotations."
 } ;
 
+HELP: dip
+{ $values { "obj" object } { "quot" quotation } }
+{ $description "Calls " { $snippet "quot" } " with " { $snippet "obj" } " hidden on the retain stack." }
+{ $notes "The following are equivalent:"
+    { $code ">r foo bar r>" }
+    { $code "[ foo bar ] dip" }
+} ;
+
 HELP: while
 { $values { "pred" "a quotation with stack effect " { $snippet "( -- ? )" } } { "body" "a quotation" } { "tail" "a quotation" } }
 { $description "Repeatedly calls " { $snippet "pred" } ". If it yields " { $link f } ", iteration stops, otherwise " { $snippet "quot" } " is called. After iteration stops, " { $snippet "tail" } " is called." }

core/kernel/kernel.factor

@@ -6,6 +6,8 @@ IN: kernel
 : version ( -- str ) "0.92" ; foldable
 
 ! Stack stuff
+: spin ( x y z -- z y x ) swap rot ; inline
+
 : roll ( x y z t -- y z t x ) >r rot r> swap ; inline
 
 : -roll ( x y z t -- t x y z ) swap >r -rot r> ; inline
@@ -49,7 +51,7 @@ DEFER: if
 
 : 3slip ( quot x y z -- x y z ) >r >r >r call r> r> r> ; inline
 
-: dip ( obj callable -- obj ) swap slip ; inline
+: dip ( obj quot -- obj ) swap slip ; inline
 
 : keep ( x quot -- x ) over slip ; inline
 

core/sequences/sequences.factor

@@ -115,7 +115,7 @@ INSTANCE: integer immutable-sequence
     [ tuck nth-unsafe >r nth-unsafe r> ] 3keep tuck
     >r >r set-nth-unsafe r> r> set-nth-unsafe ; inline
 
-: (head) ( seq n -- from to seq ) 0 swap rot ; inline
+: (head) ( seq n -- from to seq ) 0 spin ; inline
 
 : (tail) ( seq n -- from to seq ) over length rot ; inline
 
@@ -270,7 +270,7 @@ PRIVATE>
 : tail* ( seq n -- tailseq ) from-end tail ;
 
 : copy ( src i dst -- )
-    pick length >r 3dup check-copy swap rot 0 r>
+    pick length >r 3dup check-copy spin 0 r>
     (copy) drop ; inline
 
 M: sequence clone-like
@@ -579,7 +579,7 @@ M: sequence <=>
 
 : join ( seq glue -- newseq )
     [
-        2dup joined-length over new-resizable -rot swap
+        2dup joined-length over new-resizable spin
         [ dup pick push-all ] [ pick push-all ] interleave drop
     ] keep like ;
 

core/words/words.factor

@@ -94,8 +94,6 @@ M: compound redefined* ( word -- )
 
 <PRIVATE
 
-: changed-word ( word -- ) dup changed-words get set-at ;
-
 : define ( word def -- )
     over unxref
     over redefined

extra/cocoa/pasteboard/pasteboard.factor

@@ -24,7 +24,7 @@ IN: cocoa.pasteboard
 
 : pasteboard-error ( error -- f )
     "Pasteboard does not hold a string" <NSString>
-    0 swap rot set-void*-nth f ;
+    0 spin set-void*-nth f ;
 
 : ?pasteboard-string ( pboard error -- str/f )
     over pasteboard-string? [

extra/combinators/lib/lib.factor

@@ -120,7 +120,7 @@ MACRO: ifte ( quot quot quot -- )
 
 : preserving ( predicate -- quot )
   dup infer effect-in
-  dup 1+ swap rot
+  dup 1+ spin
   [ , , nkeep , nrot ]
   bake ;
 

extra/delegate/delegate.factor

@@ -27,9 +27,6 @@ M: tuple-class group-words
     dup [ slot-spec-reader ] map
     swap [ slot-spec-writer ] map append ;
 
-: spin ( x y z -- z y x )
-    swap rot ;
-
 : define-consult-method ( word class quot -- )
     pick add <method> spin define-method ;
 

extra/hashtables/lib/lib.factor

@@ -9,7 +9,7 @@ IN: hashtables.lib
 
 ! set-hash with alternative stack effects
 
-: put-hash* ( table key value -- ) swap rot set-at ;
+: put-hash* ( table key value -- ) spin set-at ;
 
 : put-hash ( table key value -- table ) swap pick set-at ;
 

extra/jamshred/tunnel/tunnel.factor

@@ -89,7 +89,7 @@ TUPLE: segment number color radius ;
     rot dup length swap <slice> find-nearest-segment ;
 
 : nearest-segment-backward ( segments oint start -- segment )
-    swapd 1+ 0 swap rot <slice> <reversed> find-nearest-segment ;
+    swapd 1+ 0 spin <slice> <reversed> find-nearest-segment ;
 
 : nearest-segment ( segments oint start-segment -- segment )
     #! find the segment nearest to 'oint', and return it.

extra/koszul/koszul.factor

@@ -199,7 +199,7 @@ DEFER: (d)
 : bigraded-ker/im-d ( bigraded-basis -- seq )
     dup length [
         over first length [
-            >r 2dup r> swap rot (bigraded-ker/im-d)
+            >r 2dup r> spin (bigraded-ker/im-d)
         ] map 2nip
     ] curry* map ;
 
@@ -277,7 +277,7 @@ DEFER: (d)
 : bigraded-triples ( grid -- triples )
     dup length [
         over first length [
-            >r 2dup r> swap rot bigraded-triple
+            >r 2dup r> spin bigraded-triple
         ] map 2nip
     ] curry* map ;
 

extra/math/matrices/elimination/elimination.factor

@@ -84,7 +84,7 @@ SYMBOL: matrix
 : basis-vector ( row col# -- )
     >r clone r>
     [ swap nth neg recip ] 2keep
-    [ 0 swap rot set-nth ] 2keep
+    [ 0 spin set-nth ] 2keep
     >r n*v r>
     matrix get set-nth ;
 

extra/prolog/prolog.factor

@@ -79,6 +79,6 @@ SYMBOL: plchoice
     ] if ;
 
 : binding-resolve ( binds name pat -- binds )
-    tuck lookup-rule dup backtrace? swap rot add-bindings ;
+    tuck lookup-rule dup backtrace? spin add-bindings ;
 
 : is ( binds val var -- binds ) rot [ set-at ] keep ;

extra/space-invaders/space-invaders.factor

@@ -293,7 +293,7 @@ M: invaders-gadget draw-gadget* ( gadget -- )
 
 : plot-bitmap-pixel ( bitmap point color -- )
   #! point is a {x y}. color is a {r g b}.
-  swap rot set-bitmap-pixel ;
+  spin set-bitmap-pixel ;
 
 : within ( n a b -- bool )
   #! n >= a and n <= b

extra/ui/gadgets/grid-lines/grid-lines.factor

@@ -14,8 +14,8 @@ SYMBOL: grid-dim
 
 : grid-line-from/to ( orientation point -- from to )
     half-gap v-
-    [ half-gap swap rot set-axis ] 2keep
-    grid-dim get swap rot set-axis ;
+    [ half-gap spin set-axis ] 2keep
+    grid-dim get spin set-axis ;
 
 : draw-grid-lines ( gaps orientation -- )
     grid get rot grid-positions grid get rect-dim add [

extra/unicode/unicode.factor

@@ -100,7 +100,7 @@ IN: unicode
     [ dup CHAR: A CHAR: Z between? [ HEX: 20 + ] when ] map ;
 
 : replace ( seq old new -- newseq )
-    swap rot [ 2dup = [ drop over ] when ] map 2nip ;
+    spin [ 2dup = [ drop over ] when ] map 2nip ;
 
 : process-names ( data -- names-hash )
     1 swap (process-data)
@@ -382,7 +382,7 @@ SYMBOL: locale ! Just casing locale, or overall?
     ] if ; inline
 
 : insert ( seq quot elt n -- )
-    swap rot >r -rot [ swap set-nth ] 2keep r> (insert) ; inline
+    spin >r -rot [ swap set-nth ] 2keep r> (insert) ; inline
 
 : insertion-sort ( seq quot -- )
     ! quot is a transformation on elements

extra/units/units.factor

@@ -69,7 +69,7 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ;
 : d-sq ( d -- d ) dup d* ;
 
 : d-recip ( d -- d' )
-    >dimensioned< swap rot recip dimension-op> ;
+    >dimensioned< spin recip dimension-op> ;
 
 : d/ ( d d -- d ) d-recip d* ;
 

extra/x/widgets/wm/root/root.factor

@@ -74,7 +74,7 @@ dup XKeyEvent-state swap event>keyname 2array ;
   [ $keymap swap resolve-key-event call ]
 
 "grab-key" !( wm-root modifiers keyname -- wm-root modifiers keyname ) [
-  3dup name>keysym keysym-to-keycode swap rot
+  3dup name>keysym keysym-to-keycode spin
   False GrabModeAsync GrabModeAsync grab-key ]
 
 "set-key-action" !( wm-root modifiers keyname action -- wm-root ) [

extra/xml/utilities/utilities.factor

@@ -91,7 +91,7 @@ M: xml xml-map
 
 GENERIC# xml-find 1 ( quot tag -- tag ) inline
 M: tag xml-find
-    [ call ] 2keep swap rot [
+    [ call ] 2keep spin [
         f swap
         [ nip over >r swap xml-find r> swap dup ] find
         2drop ! leaves result of quot