: 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

@@ -1,140 +1,140 @@
-! Copyright (C) 2005, 2006 Daniel Ehrenberg
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces sequences words io assocs
-quotations strings parser arrays xml.data xml.writer debugger
-splitting ;
-IN: xml.utilities
-
-! * System for words specialized on tag names
-
-TUPLE: process-missing process tag ;
-M: process-missing error.
-    "Tag <" write
-    dup process-missing-tag print-name
-    "> not implemented on process process " write
-    process-missing-process word-name print ;
-
-: run-process ( tag word -- )
-    2dup "xtable" word-prop
-    >r dup name-tag r> at* [ 2nip call ] [
-        drop \ process-missing construct-boa throw
-    ] if ;
-
-: PROCESS:
-    CREATE
-    dup H{ } clone "xtable" set-word-prop
-    dup [ run-process ] curry define-compound ; parsing
-
-: TAG:
-    scan scan-word
-    parse-definition
-    swap "xtable" word-prop
-    rot "/" split [ >r 2dup r> swap set-at ] each 2drop ;
-    parsing
-
-
-! * Common utility functions
-
-: build-tag* ( items name -- tag )
-    "" swap "" <name>
-    swap >r { } r> <tag> ;
-
-: build-tag ( item name -- tag )
-    >r 1array r> build-tag* ;
-
-: build-xml ( tag -- xml )
-    T{ prolog f "1.0" "iso-8859-1" f } { } rot { } <xml> ;
-
-: children>string ( tag -- string )
-    tag-children
-    dup [ string? ] all?
-    [ "XML tag unexpectedly contains non-text children" throw ] unless
-    concat ;
-
-: children-tags ( tag -- sequence )
-    tag-children [ tag? ] subset ;
-
-: first-child-tag ( tag -- tag )
-    tag-children [ tag? ] find nip ;
-
-! * Utilities for searching through XML documents
-! These all work from the outside in, top to bottom.
-
-: with-delegate ( object quot -- object )
-    over clone >r >r delegate r> call r>
-    [ set-delegate ] keep ; inline
-
-GENERIC# xml-each 1 ( quot tag -- ) inline
-M: tag xml-each
-    [ call ] 2keep
-    swap tag-children [ swap xml-each ] curry* each ;
-M: object xml-each
-    call ;
-M: xml xml-each
-    >r delegate r> xml-each ;
-
-GENERIC# xml-map 1 ( quot tag -- tag ) inline
-M: tag xml-map
-    swap clone over >r swap call r> 
-    swap [ tag-children [ swap xml-map ] curry* map ] keep 
-    [ set-tag-children ] keep ;
-M: object xml-map
-    call ;
-M: xml xml-map
-    swap [ swap xml-map ] with-delegate ;
-
-: xml-subset ( quot tag -- seq ) ! quot: tag -- ?
-    V{ } clone rot [
-        swap >r [ swap call ] 2keep rot r>
-        swap [ [ push ] keep ] [ nip ] if
-    ] xml-each nip ;
-
-GENERIC# xml-find 1 ( quot tag -- tag ) inline
-M: tag xml-find
-    [ call ] 2keep swap rot [
-        f swap
-        [ nip over >r swap xml-find r> swap dup ] find
-        2drop ! leaves result of quot
-    ] unless nip ;
-M: object xml-find
-    keep f ? ;
-M: xml xml-find
-    >r delegate r> xml-find ;
-
-GENERIC# xml-inject 1 ( quot tag -- ) inline
-M: tag xml-inject
-    swap [
-        swap [ call ] keep
-        [ xml-inject ] keep
-    ] change-each ;
-M: object xml-inject 2drop ;
-M: xml xml-inject >r delegate >r xml-inject ;
-
-! * Accessing part of an XML document
-
-: get-id ( tag id -- elem ) ! elem=tag.getElementById(id)
-    swap [
-        dup tag?
-        [ "id" swap at over = ]
-        [ drop f ] if
-    ] xml-find nip ;
-
-: (get-tag) ( name elem -- ? )
-    dup tag? [ names-match? ] [ 2drop f ] if ;
-
-: tag-named* ( tag name/string -- matching-tag )
-    assure-name swap [ dupd (get-tag) ] xml-find nip ;
-
-: tags-named* ( tag name/string -- tags-seq )
-    assure-name swap [ dupd (get-tag) ] xml-subset nip ;
-
-: tag-named ( tag name/string -- matching-tag )
-    ! like get-name-tag but only looks at direct children,
-    ! not all the children down the tree.
-    assure-name swap [ (get-tag) ] curry* find nip ;
-
-: tags-named ( tag name/string -- tags-seq )
-    assure-name swap [ (get-tag) ] curry* subset ;
-
-: assert-tag ( name name -- )
-    names-match? [ "Unexpected XML tag found" throw ] unless ;
+! Copyright (C) 2005, 2006 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel namespaces sequences words io assocs
+quotations strings parser arrays xml.data xml.writer debugger
+splitting ;
+IN: xml.utilities
+
+! * System for words specialized on tag names
+
+TUPLE: process-missing process tag ;
+M: process-missing error.
+    "Tag <" write
+    dup process-missing-tag print-name
+    "> not implemented on process process " write
+    process-missing-process word-name print ;
+
+: run-process ( tag word -- )
+    2dup "xtable" word-prop
+    >r dup name-tag r> at* [ 2nip call ] [
+        drop \ process-missing construct-boa throw
+    ] if ;
+
+: PROCESS:
+    CREATE
+    dup H{ } clone "xtable" set-word-prop
+    dup [ run-process ] curry define-compound ; parsing
+
+: TAG:
+    scan scan-word
+    parse-definition
+    swap "xtable" word-prop
+    rot "/" split [ >r 2dup r> swap set-at ] each 2drop ;
+    parsing
+
+
+! * Common utility functions
+
+: build-tag* ( items name -- tag )
+    "" swap "" <name>
+    swap >r { } r> <tag> ;
+
+: build-tag ( item name -- tag )
+    >r 1array r> build-tag* ;
+
+: build-xml ( tag -- xml )
+    T{ prolog f "1.0" "iso-8859-1" f } { } rot { } <xml> ;
+
+: children>string ( tag -- string )
+    tag-children
+    dup [ string? ] all?
+    [ "XML tag unexpectedly contains non-text children" throw ] unless
+    concat ;
+
+: children-tags ( tag -- sequence )
+    tag-children [ tag? ] subset ;
+
+: first-child-tag ( tag -- tag )
+    tag-children [ tag? ] find nip ;
+
+! * Utilities for searching through XML documents
+! These all work from the outside in, top to bottom.
+
+: with-delegate ( object quot -- object )
+    over clone >r >r delegate r> call r>
+    [ set-delegate ] keep ; inline
+
+GENERIC# xml-each 1 ( quot tag -- ) inline
+M: tag xml-each
+    [ call ] 2keep
+    swap tag-children [ swap xml-each ] curry* each ;
+M: object xml-each
+    call ;
+M: xml xml-each
+    >r delegate r> xml-each ;
+
+GENERIC# xml-map 1 ( quot tag -- tag ) inline
+M: tag xml-map
+    swap clone over >r swap call r>
+    swap [ tag-children [ swap xml-map ] curry* map ] keep
+    [ set-tag-children ] keep ;
+M: object xml-map
+    call ;
+M: xml xml-map
+    swap [ swap xml-map ] with-delegate ;
+
+: xml-subset ( quot tag -- seq ) ! quot: tag -- ?
+    V{ } clone rot [
+        swap >r [ swap call ] 2keep rot r>
+        swap [ [ push ] keep ] [ nip ] if
+    ] xml-each nip ;
+
+GENERIC# xml-find 1 ( quot tag -- tag ) inline
+M: tag xml-find
+    [ call ] 2keep spin [
+        f swap
+        [ nip over >r swap xml-find r> swap dup ] find
+        2drop ! leaves result of quot
+    ] unless nip ;
+M: object xml-find
+    keep f ? ;
+M: xml xml-find
+    >r delegate r> xml-find ;
+
+GENERIC# xml-inject 1 ( quot tag -- ) inline
+M: tag xml-inject
+    swap [
+        swap [ call ] keep
+        [ xml-inject ] keep
+    ] change-each ;
+M: object xml-inject 2drop ;
+M: xml xml-inject >r delegate >r xml-inject ;
+
+! * Accessing part of an XML document
+
+: get-id ( tag id -- elem ) ! elem=tag.getElementById(id)
+    swap [
+        dup tag?
+        [ "id" swap at over = ]
+        [ drop f ] if
+    ] xml-find nip ;
+
+: (get-tag) ( name elem -- ? )
+    dup tag? [ names-match? ] [ 2drop f ] if ;
+
+: tag-named* ( tag name/string -- matching-tag )
+    assure-name swap [ dupd (get-tag) ] xml-find nip ;
+
+: tags-named* ( tag name/string -- tags-seq )
+    assure-name swap [ dupd (get-tag) ] xml-subset nip ;
+
+: tag-named ( tag name/string -- matching-tag )
+    ! like get-name-tag but only looks at direct children,
+    ! not all the children down the tree.
+    assure-name swap [ (get-tag) ] curry* find nip ;
+
+: tags-named ( tag name/string -- tags-seq )
+    assure-name swap [ (get-tag) ] curry* subset ;
+
+: assert-tag ( name name -- )
+    names-match? [ "Unexpected XML tag found" throw ] unless ;