Refactoring usages of >r, r>, -rot, rot

basis/alien/c-types/c-types.factor

@@ -201,10 +201,10 @@ M: byte-array byte-length length ;
     1 swap malloc-array ; inline
 
 : malloc-byte-array ( byte-array -- alien )
-    dup length dup malloc [ -rot memcpy ] keep ;
+    dup length [ nip malloc dup ] 2keep memcpy ;
 
 : memory>byte-array ( alien len -- byte-array )
-    dup <byte-array> [ -rot memcpy ] keep ;
+    [ nip <byte-array> dup ] 2keep memcpy ;
 
 : byte-array>memory ( byte-array base -- )
     swap dup length memcpy ;

basis/alien/structs/structs-tests.factor

@@ -38,7 +38,7 @@ C-UNION: barx
 [ 120 ] [ "barx" heap-size ] unit-test
 
 "help" vocab [
-    "help" "help" lookup "help" set
+    "print-topic" "help" lookup "help" set
     [ ] [ \ foox-x "help" get execute ] unit-test
     [ ] [ \ set-foox-x "help" get execute ] unit-test
 ] when

basis/cocoa/dialogs/dialogs.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2006, 2007 Slava Pestov
+! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel cocoa cocoa.messages cocoa.classes
 cocoa.application sequences splitting core-foundation ;
@@ -29,6 +29,6 @@ IN: cocoa.dialogs
     "/" split1-last [ <NSString> ] bi@ ;
 
 : save-panel ( path -- paths )
-    <NSSavePanel> dup
-    rot split-path -> runModalForDirectory:file: NSOKButton =
+    [ <NSSavePanel> dup ] dip
+    split-path -> runModalForDirectory:file: NSOKButton =
     [ -> filename CF>string ] [ drop f ] if ;

basis/cocoa/messages/messages.factor

@@ -160,7 +160,7 @@ objc>alien-types get [ swap ] assoc-map
 assoc-union alien>objc-types set-global
 
 : objc-struct-type ( i string -- ctype )
-    2dup CHAR: = -rot index-from swap subseq
+    [ CHAR: = ] 2keep index-from swap subseq
     dup c-types get key? [
         "Warning: no such C type: " write dup print
         drop "void*"

basis/cocoa/windows/windows.factor

@@ -34,5 +34,6 @@ IN: cocoa.windows
     dup 0 -> setReleasedWhenClosed: ;
 
 : window-content-rect ( window -- rect )
-    NSWindow over -> frame rot -> styleMask
+    [ NSWindow ] dip
+    [ -> frame ] [ -> styleMask ] bi
     -> contentRectForFrameRect:styleMask: ;

basis/core-foundation/fsevents/fsevents.factor

@@ -4,7 +4,7 @@ USING: alien alien.c-types alien.strings alien.syntax kernel
 math sequences namespaces make assocs init accessors
 continuations combinators core-foundation
 core-foundation.run-loop core-foundation.run-loop.thread
-io.encodings.utf8 destructors ;
+io.encodings.utf8 destructors locals arrays ;
 IN: core-foundation.fsevents
 
 : kFSEventStreamCreateFlagUseCFTypes 2 ; inline
@@ -105,15 +105,14 @@ FUNCTION: CFStringRef FSEventStreamCopyDescription ( FSEventStreamRef streamRef
     "FSEventStreamContext" <c-object>
     [ set-FSEventStreamContext-info ] keep ;
 
-: <FSEventStream> ( callback info paths latency flags -- event-stream )
-    >r >r >r >r >r
+:: <FSEventStream> ( callback info paths latency flags -- event-stream )
     f ! allocator
-    r> ! callback
-    r> make-FSEventStreamContext
-    r> <CFStringArray> ! paths
+    callback
+    info make-FSEventStreamContext
+    paths <CFStringArray>
     FSEventStreamEventIdSinceNow ! sinceWhen
-    r> ! latency
-    r> ! flags
+    latency
+    flags
     FSEventStreamCreate ;
 
 : kCFRunLoopCommonModes ( -- string )
@@ -161,13 +160,11 @@ SYMBOL: event-stream-callbacks
 : remove-event-source-callback ( id -- )
     event-stream-callbacks get delete-at ;
 
-: >event-triple ( n eventPaths eventFlags eventIds -- triple )
-    [
-        >r >r >r dup dup
-        r> void*-nth utf8 alien>string ,
-        r> int-nth ,
-        r> longlong-nth ,
-    ] { } make ;
+:: >event-triple ( n eventPaths eventFlags eventIds -- triple )
+    n eventPaths void*-nth utf8 alien>string
+    n eventFlags int-nth
+    n eventIds longlong-nth
+    3array ;
 
 : master-event-source-callback ( -- alien )
     "void"

basis/delegate/delegate.factor

@@ -36,7 +36,7 @@ M: tuple-class group-words
 
 : define-consult ( group class quot -- )
     [ register-protocol ]
-    [ rot group-words -rot [ consult-method ] 2curry each ]
+    [ [ group-words ] 2dip [ consult-method ] 2curry each ]
     3bi ;
 
 : CONSULT:

basis/inspector/inspector.factor

@@ -49,10 +49,8 @@ SYMBOL: +editable+
     ] [ keys ] if ;
 
 : describe* ( obj mirror keys -- )
-    rot summary.
-    [
-        drop
-    ] [
+    [ summary. ] 2dip
+    [ drop ] [
         dup enum? [ +sequence+ on ] when
         standard-table-style [
             swap [ -rot describe-row ] curry each-index

basis/io/unix/select/select.factor

@@ -19,7 +19,7 @@ TUPLE: select-mx < mx read-fdset write-fdset ;
         FD_SETSIZE 8 * <bit-array> >>write-fdset ;
 
 : clear-nth ( n seq -- ? )
-    [ nth ] [ f -rot set-nth ] 2bi ;
+    [ nth ] [ [ f ] 2dip set-nth ] 2bi ;
 
 :: check-fd ( fd fdset mx quot -- )
     fd munge fdset clear-nth [ fd mx quot call ] when ; inline

basis/io/unix/sockets/sockets.factor

@@ -114,7 +114,7 @@ SYMBOL: receive-buffer
     ] call ;
 
 M: unix (receive) ( datagram -- packet sockaddr )
-    dup do-receive dup [ rot drop ] [
+    dup do-receive dup [ [ drop ] 2dip ] [
         2drop [ +input+ wait-for-port ] [ (receive) ] bi
     ] if ;
 

basis/math/complex/complex.factor

@@ -14,8 +14,8 @@ M: complex imaginary-part imaginary>> ;
 M: complex absq >rect [ sq ] bi@ + ;
 
 : 2>rect ( x y -- xr yr xi yi )
-    [ [ real-part ] bi@ ] 2keep
-    [ imaginary-part ] bi@ ; inline
+    [ [ real-part ] bi@ ]
+    [ [ imaginary-part ] bi@ ] 2bi ; inline
 
 M: complex hashcode*
     nip >rect [ hashcode ] bi@ bitxor ;
@@ -28,21 +28,21 @@ M: complex equal?
 M: complex number=
     2>rect number= [ number= ] [ 2drop f ] if ;
 
-: *re ( x y -- xr*yr xi*ri ) 2>rect * >r * r> ; inline
-: *im ( x y -- xi*yr xr*yi ) 2>rect >r * swap r> * ; inline
+: *re ( x y -- xr*yr xi*ri ) 2>rect [ * ] 2bi@ ; inline
+: *im ( x y -- xi*yr xr*yi ) 2>rect [ * swap ] dip * ; inline
 
-M: complex + 2>rect + >r + r> (rect>) ;
-M: complex - 2>rect - >r - r> (rect>) ;
-M: complex * 2dup *re - -rot *im + (rect>) ;
+M: complex + 2>rect [ + ] 2bi@ (rect>) ;
+M: complex - 2>rect [ - ] 2bi@ (rect>) ;
+M: complex * [ *re - ] [ *im + ] 2bi (rect>) ;
 
 : complex/ ( x y -- r i m )
-    dup absq >r 2dup *re + -rot *im - r> ; inline
+    [ [ *re + ] [ *im - ] 2bi ] keep absq ; inline
 
-M: complex / complex/ tuck / >r / r> (rect>) ;
+M: complex / complex/ tuck [ / ] 2bi@ (rect>) ;
 
 M: complex abs absq >float fsqrt ;
 
-M: complex sqrt >polar swap fsqrt swap 2.0 / polar> ;
+M: complex sqrt >polar [ fsqrt ] [ 2.0 / ] bi* polar> ;
 
 IN: syntax
 

basis/math/functions/functions.factor

@@ -92,16 +92,6 @@ PRIVATE>
 : 0^ ( x -- z )
     dup zero? [ drop 0./0. ] [ 0 < 1./0. 0 ? ] if ; inline
 
-PRIVATE>
-
-: ^ ( x y -- z )
-    {
-        { [ over zero? ] [ nip 0^ ] }
-        { [ dup integer? ] [ integer^ ] }
-        { [ 2dup real^? ] [ fpow ] }
-        [ ^complex ]
-    } cond ; inline
-
 : (^mod) ( n x y -- z )
     1 swap [
         [ dupd * pick mod ] when [ sq over mod ] dip
@@ -114,6 +104,16 @@ PRIVATE>
         swap [ /mod [ over * swapd - ] dip ] keep (gcd)
     ] if ;
 
+PRIVATE>
+
+: ^ ( x y -- z )
+    {
+        { [ over zero? ] [ nip 0^ ] }
+        { [ dup integer? ] [ integer^ ] }
+        { [ 2dup real^? ] [ fpow ] }
+        [ ^complex ]
+    } cond ; inline
+
 : gcd ( x y -- a d )
     [ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; foldable
 
@@ -177,9 +177,9 @@ M: complex log >polar swap flog swap rect> ;
 GENERIC: cos ( x -- y ) foldable
 
 M: complex cos
-    >float-rect 2dup
-    fcosh swap fcos * -rot
-    fsinh swap fsin neg * rect> ;
+    >float-rect
+    [ [ fcos ] [ fcosh ] bi* * ]
+    [ [ fsin neg ] [ fsinh ] bi* * ] 2bi rect> ;
 
 M: real cos fcos ;
 
@@ -188,9 +188,9 @@ M: real cos fcos ;
 GENERIC: cosh ( x -- y ) foldable
 
 M: complex cosh
-    >float-rect 2dup
-    fcos swap fcosh * -rot
-    fsin swap fsinh * rect> ;
+    >float-rect
+    [ [ fcosh ] [ fcos ] bi* * ]
+    [ [ fsinh ] [ fsin ] bi* * ] 2bi rect> ;
 
 M: real cosh fcosh ;
 
@@ -199,9 +199,9 @@ M: real cosh fcosh ;
 GENERIC: sin ( x -- y ) foldable
 
 M: complex sin
-    >float-rect 2dup
-    fcosh swap fsin * -rot
-    fsinh swap fcos * rect> ;
+    >float-rect
+    [ [ fsin ] [ fcosh ] bi* * ]
+    [ [ fcos ] [ fsinh ] bi* * ] 2bi rect> ;
 
 M: real sin fsin ;
 
@@ -210,9 +210,9 @@ M: real sin fsin ;
 GENERIC: sinh ( x -- y ) foldable
 
 M: complex sinh 
-    >float-rect 2dup
-    fcos swap fsinh * -rot
-    fsin swap fcosh * rect> ;
+    >float-rect
+    [ [ fsinh ] [ fcos ] bi* * ]
+    [ [ fcosh ] [ fsin ] bi* * ] 2bi rect> ;
 
 M: real sinh fsinh ;
 

basis/math/ranges/ranges.factor

@@ -22,9 +22,9 @@ INSTANCE: range immutable-sequence
 
 : twiddle 2dup > -1 1 ? ; inline
 
-: (a, dup roll + -rot ; inline
+: (a, dup [ + ] curry 2dip ; inline
 
-: ,b) dup neg rot + swap ; inline
+: ,b) dup [ - ] curry dip ; inline
 
 : [a,b] ( a b -- range ) twiddle <range> ; inline
 

core/assocs/assocs.factor

@@ -110,8 +110,8 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
     swap [ swapd set-at ] curry assoc-each ;
 
 : assoc-union ( assoc1 assoc2 -- union )
-    2dup [ assoc-size ] bi@ + pick new-assoc
-    [ rot update ] keep [ swap update ] keep ;
+    [ [ [ assoc-size ] bi@ + ] [ drop ] 2bi new-assoc ] 2keep
+    [ dupd update ] bi@ ;
 
 : assoc-combine ( seq -- union )
     H{ } clone [ dupd update ] reduce ;

core/classes/intersection/intersection.factor

@@ -23,7 +23,7 @@ PREDICATE: intersection-class < class
 M: intersection-class update-class define-intersection-predicate ;
 
 : define-intersection-class ( class participants -- )
-    [ f f rot intersection-class define-class ]
+    [ [ f f ] dip intersection-class define-class ]
     [ drop update-classes ]
     2bi ;
 

core/classes/tuple/tuple.factor

@@ -248,7 +248,9 @@ M: tuple-class update-class
     3bi ;
 
 : tuple-class-unchanged? ( class superclass slots -- ? )
-    rot tuck [ superclass = ] [ "slots" word-prop = ] 2bi* and ;
+    [ over ] dip
+    [ [ superclass ] dip = ]
+    [ [ "slots" word-prop ] dip = ] 2bi* and ;
 
 : valid-superclass? ( class -- ? )
     [ tuple-class? ] [ tuple eq? ] bi or ;

core/words/words.factor

@@ -221,7 +221,7 @@ M: word subwords drop f ;
     "( gensym )" f <word> ;
 
 : define-temp ( quot -- word )
-    gensym dup rot define ;
+    [ gensym dup ] dip define ;
 
 : reveal ( word -- )
     dup [ name>> ] [ vocabulary>> ] bi dup vocab-words