Code cleanup: refactoring usages of rot and -rot to use newer idioms instead

basis/alien/parser/parser.factor

@@ -0,0 +1,19 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien alien.c-types arrays assocs effects grouping kernel
+parser sequences splitting words fry locals ;
+IN: alien.parser
+
+: parse-arglist ( parameters return -- types effect )
+    [ 2 group unzip [ "," ?tail drop ] map ]
+    [ [ { } ] [ 1array ] if-void ]
+    bi* <effect> ;
+
+: function-quot ( return library function types -- quot )
+    '[ _ _ _ _ alien-invoke ] ;
+
+:: define-function ( return library function parameters -- )
+    function create-in dup reset-generic
+    return library function
+    parameters return parse-arglist [ function-quot ] dip
+    define-declared ;

basis/alien/structs/fields/fields.factor

@@ -52,25 +52,21 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ;
         [ (>>offset) ] [ type>> heap-size + ] 2bi
     ] reduce ;
 
-: define-struct-slot-word ( spec word quot -- )
+: define-struct-slot-word ( word quot spec -- )
-    rot offset>> prefix define-inline ;
+    offset>> prefix define-inline ;
 
 : define-getter ( type spec -- )
     [ set-reader-props ] keep
-    [ ]
     [ reader>> ]
     [
         type>>
         [ c-getter ] [ c-type-boxer-quot ] bi append
-    ] tri
+    ]
-    define-struct-slot-word ;
+    [ ] tri define-struct-slot-word ;
 
 : define-setter ( type spec -- )
     [ set-writer-props ] keep
-    [ ]
+    [ writer>> ] [ type>> c-setter ] [ ] tri define-struct-slot-word ;
-    [ writer>> ]
-    [ type>> c-setter ] tri
-    define-struct-slot-word ;
 
 : define-field ( type spec -- )
     [ define-getter ] [ define-setter ] 2bi ;

basis/alien/syntax/syntax-docs.factor

@@ -1,6 +1,6 @@
 IN: alien.syntax
-USING: alien alien.c-types alien.structs alien.syntax.private
+USING: alien alien.c-types alien.parser alien.structs
-help.markup help.syntax ;
+alien.syntax.private help.markup help.syntax ;
 
 HELP: DLL"
 { $syntax "DLL\" path\"" }
@@ -54,12 +54,6 @@ HELP: TYPEDEF:
 { $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } " if ." }
 { $notes "This word differs from " { $link typedef } " in that it runs at parse time, to ensure correct ordering of operations when loading source files. Words defined in source files are compiled before top-level forms are run, so if a source file defines C binding words and uses " { $link typedef } ", the type alias won't be available at compile time." } ;
 
-HELP: TYPEDEF-IF:
-{ $syntax "TYPEDEF-IF: word old new" }
-{ $values { "word" "a word with stack effect " { $snippet "( -- ? )" } } { "old" "a C type" } { "new" "a C type" } }
-{ $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } " if " { $snippet "word" } " evaluates to a true value." }
-{ $notes "This word differs from " { $link typedef } " in that it runs at parse time, to ensure correct ordering of operations when loading source files. Words defined in source files are compiled before top-level forms are run, so if a source file defines C binding words and uses " { $link typedef } ", the type alias won't be available at compile time." } ;
-
 HELP: C-STRUCT:
 { $syntax "C-STRUCT: name pairs... ;" }
 { $values { "name" "a new C type name" } { "pairs" "C type / field name string pairs" } }
@@ -88,7 +82,7 @@ HELP: typedef
 { $description "Alises the C type " { $snippet "old" } " under the name " { $snippet "new" } "." }
 { $notes "Using this word in the same source file which defines C bindings can cause problems, because words are compiled before top-level forms are run. Use the " { $link POSTPONE: TYPEDEF: } " word instead." } ;
 
-{ POSTPONE: TYPEDEF-IF: POSTPONE: TYPEDEF: typedef } related-words
+{ POSTPONE: TYPEDEF: typedef } related-words
 
 HELP: c-struct?
 { $values { "type" "a string" } { "?" "a boolean" } }

basis/alien/syntax/syntax.factor

@@ -4,26 +4,9 @@ USING: accessors arrays alien alien.c-types alien.structs
 alien.arrays alien.strings kernel math namespaces parser
 sequences words quotations math.parser splitting grouping
 effects prettyprint prettyprint.sections prettyprint.backend
-assocs combinators lexer strings.parser ;
+assocs combinators lexer strings.parser alien.parser ;
 IN: alien.syntax
 
-<PRIVATE
-
-: parse-arglist ( return seq -- types effect )
-    2 group dup keys swap values [ "," ?tail drop ] map
-    rot dup "void" = [ drop { } ] [ 1array ] if <effect> ;
-
-: function-quot ( type lib func types -- quot )
-    [ alien-invoke ] 2curry 2curry ;
-
-: define-function ( return library function parameters -- )
-    [ pick ] dip parse-arglist
-    pick create-in dup reset-generic
-    [ function-quot ] 2dip
-    -rot define-declared ;
-
-PRIVATE>
-
 : DLL" lexer get skip-blank parse-string dlopen parsed ; parsing
 
 : ALIEN: scan string>number <alien> parsed ; parsing
@@ -40,9 +23,6 @@ PRIVATE>
 : TYPEDEF:
     scan scan typedef ; parsing
 
-: TYPEDEF-IF:
-    scan-word execute scan scan rot [ typedef ] [ 2drop ] if ; parsing
-
 : C-STRUCT:
     scan in get
     parse-definition

basis/cpu/x86/assembler/assembler.factor

@@ -300,7 +300,7 @@ PREDICATE: callable < word register? not ;
 
 GENERIC: MOV ( dst src -- )
 M: immediate MOV swap (MOV-I) ;
-M: callable MOV 0 rot (MOV-I) rc-absolute-cell rel-word ;
+M: callable MOV [ 0 ] 2dip (MOV-I) rc-absolute-cell rel-word ;
 M: operand MOV HEX: 88 2-operand ;
 
 : LEA ( dst src -- ) swap HEX: 8d 2-operand ;

basis/dlists/dlists.factor

@@ -93,11 +93,11 @@ M: dlist peek-front ( dlist -- obj )
 
 M: dlist pop-front* ( dlist -- )
     [
-        dup front>> [ empty-dlist ] unless*
+        [
-        dup next>>
+            [ empty-dlist ] unless*
-        f rot (>>next)
+            [ f ] change-next drop
-        f over set-prev-when
+            f over set-prev-when
-        swap (>>front)
+        ] change-front drop
     ] keep
     normalize-back ;
 
@@ -106,11 +106,11 @@ M: dlist peek-back ( dlist -- obj )
 
 M: dlist pop-back* ( dlist -- )
     [
-        dup back>> [ empty-dlist ] unless*
+        [
-        dup prev>>
+            [ empty-dlist ] unless*
-        f rot (>>prev)
+            [ f ] change-prev drop
-        f over set-next-when
+            f over set-next-when
-        swap (>>back)
+        ] change-back drop
     ] keep
     normalize-front ;
 

basis/opengl/gl/extensions/extensions.factor

@@ -1,6 +1,6 @@
-USING: alien alien.syntax alien.syntax.private combinators
+USING: alien alien.syntax alien.parser combinators
 kernel parser sequences system words namespaces hashtables init
-math arrays assocs continuations lexer ;
+math arrays assocs continuations lexer fry locals ;
 IN: opengl.gl.extensions
 
 ERROR: unknown-gl-platform ;
@@ -30,20 +30,22 @@ reset-gl-function-number-counter
 : gl-function-pointer ( names n -- funptr )
     gl-function-context 2array dup +gl-function-pointers+ get-global at
     [ 2nip ] [
-        >r [ gl-function-address ] map [ ] find nip
+        [
-        dup [ "OpenGL function not available" throw ] unless
+            [ gl-function-address ] map [ ] find nip
-        dup r>
+            dup [ "OpenGL function not available" throw ] unless
+            dup
+        ] dip
         +gl-function-pointers+ get-global set-at
     ] if* ;
 
 : indirect-quot ( function-ptr-quot return types abi -- quot )
-    [ alien-indirect ] 3curry compose ;
+    '[ @  _ _ _ alien-indirect ] ;
 
-: define-indirect ( abi return function-ptr-quot function-name parameters -- )
+:: define-indirect ( abi return function-ptr-quot function-name parameters -- )
-    [ pick ] dip parse-arglist
+    function-name create-in dup reset-generic
-    rot create-in
+    function-ptr-quot return
-    [ swapd roll indirect-quot ] 2dip
+    parameters return parse-arglist [ abi indirect-quot ] dip
-    -rot define-declared ;
+    define-declared ;
 
 : GL-FUNCTION:
     gl-function-calling-convention

basis/ui/cocoa/cocoa.factor

@@ -33,16 +33,13 @@ M: pasteboard set-clipboard-contents
     <clipboard> selection set-global ;
 
 : world>NSRect ( world -- NSRect )
-    dup window-loc>> first2 rot rect-dim first2 <NSRect> ;
+    [ window-loc>> ] [ dim>> ] bi [ first2 ] bi@ <NSRect> ;
 
 : gadget-window ( world -- )
-    [
+    dup <FactorView>
-        dup <FactorView>
+    2dup swap world>NSRect <ViewWindow>
-        dup rot world>NSRect <ViewWindow>
+    [ [ -> release ] [ install-window-delegate ] bi* ] [ <handle> ] 2bi
-        dup install-window-delegate
+    >>handle drop ;
-        over -> release
-        <handle>
-    ] keep (>>handle) ;
 
 M: cocoa-ui-backend set-title ( string world -- )
     handle>> window>> swap <NSString> -> setTitle: ;

basis/ui/cocoa/views/views-tests.factor

@@ -0,0 +1,15 @@
+IN: ui.cocoa.views.tests
+USING: ui.cocoa.views tools.test kernel math.geometry.rect
+namespaces ;
+
+[ t ] [
+    T{ rect
+        { loc { 0 0 } }
+        { dim { 1000 1000 } }
+    } "world" set
+
+    T{ rect
+        { loc { 1.5 2.25 } }
+        { dim { 13.0 14.0 } }
+    } dup "world" get rect>NSRect "world" get NSRect>rect =
+] unit-test

basis/ui/cocoa/views/views.factor

@@ -77,18 +77,22 @@ IN: ui.cocoa.views
     dup event-modifiers swap button ;
 
 : send-button-down$ ( view event -- )
-    [ mouse-event>gesture <button-down> ]
+    [ nip mouse-event>gesture <button-down> ]
-    [ mouse-location rot window send-button-down ] 2bi ;
+    [ mouse-location ]
+    [ drop window ]
+    2tri send-button-down ;
 
 : send-button-up$ ( view event -- )
-    [ mouse-event>gesture <button-up> ] 2keep
+    [ nip mouse-event>gesture <button-up> ]
-    mouse-location rot window send-button-up ;
+    [ mouse-location ]
+    [ drop window ]
+    2tri send-button-up ;
 
 : send-wheel$ ( view event -- )
-    [
+    [ nip [ -> deltaX ] [ -> deltaY ] bi [ sgn neg ] bi@ 2array ]
-        dup -> deltaX sgn neg over -> deltaY sgn neg 2array -rot
+    [ mouse-location ]
-        mouse-location
+    [ drop window ]
-    ] [ drop window ] 2bi send-wheel ;
+    2tri send-wheel ;
 
 : send-action$ ( view event gesture -- junk )
     [ drop window ] dip send-action f ;
@@ -103,21 +107,18 @@ IN: ui.cocoa.views
     [ CF>string NSStringPboardType = ] [ t ] if* ;
 
 : valid-service? ( gadget send-type return-type -- ? )
-    over string-or-nil? over string-or-nil? and [
+    over string-or-nil? over string-or-nil? and
-        drop [ gadget-selection? ] [ drop t ] if
+    [ drop [ gadget-selection? ] [ drop t ] if ] [ 3drop f ] if ;
-    ] [
-        3drop f
-    ] if ;
 
 : NSRect>rect ( NSRect world -- rect )
-    [ dup NSRect-x over NSRect-y ] dip
+    [ [ [ NSRect-x ] [ NSRect-y ] bi ] [ dim>> second ] bi* swap - 2array ]
-    rect-dim second swap - 2array
+    [ drop [ NSRect-w ] [ NSRect-h ] bi 2array ]
-    over NSRect-w rot NSRect-h 2array
+    2bi <rect> ;
-    <rect> ;
 
 : rect>NSRect ( rect world -- NSRect )
-    over rect-loc first2 rot rect-dim second swap -
+    [ [ rect-loc first2 ] [ dim>> second ] bi* swap - ]
-    rot rect-dim first2 <NSRect> ;
+    [ drop rect-dim first2 ]
+    2bi <NSRect> ;
 
 CLASS: {
     { +superclass+ "NSOpenGLView" }
@@ -342,7 +343,7 @@ CLASS: {
 
 { "initWithFrame:pixelFormat:" "id" { "id" "SEL" "NSRect" "id" }
     [
-        rot drop
+        [ drop ] 2dip
         SUPER-> initWithFrame:pixelFormat:
         dup dup add-resize-observer
     ]
@@ -351,9 +352,10 @@ CLASS: {
 { "dealloc" "void" { "id" "SEL" }
     [
         drop
-        dup unregister-window
+        [ unregister-window ]
-        dup remove-observer
+        [ remove-observer ]
-        SUPER-> dealloc
+        [ SUPER-> dealloc ]
+        tri
     ]
 } ;
 

basis/ui/freetype/freetype.factor

@@ -97,14 +97,15 @@ SYMBOL: dpi
     dup handle>> init-descent
     dup [ ascent>> ] [ descent>> ] bi - ft-ceil >>height ; inline
 
-: set-char-size ( handle size -- )
+: set-char-size ( open-font size -- open-font )
-    0 swap 6 shift dpi get-global dup FT_Set_Char_Size freetype-error ;
+    [ dup handle>> 0 ] dip
+    6 shift dpi get-global dup FT_Set_Char_Size freetype-error ;
 
-: <font> ( handle -- font )
+: <font> ( font -- open-font )
     font new
         H{ } clone >>widths
         over first2 open-face >>handle
-        dup handle>> rot third set-char-size
+        swap third set-char-size
         init-font ;
 
 M: freetype-renderer open-font ( font -- open-font )
@@ -120,7 +121,7 @@ M: freetype-renderer open-font ( font -- open-font )
     ] cache nip ;
 
 M: freetype-renderer string-width ( open-font string -- w )
-    0 -rot [ char-width + ] with each ;
+    [ 0 ] 2dip [ char-width + ] with each ;
 
 M: freetype-renderer string-height ( open-font string -- h )
     drop height>> ;
@@ -165,8 +166,9 @@ M: freetype-renderer string-height ( open-font string -- h )
     ] with-malloc ;
 
 : glyph-texture-loc ( glyph font -- loc )
-    over glyph-hori-bearing-x ft-floor -rot
+    [ drop glyph-hori-bearing-x ft-floor ]
-    ascent>> swap glyph-hori-bearing-y - ft-floor 2array ;
+    [ ascent>> swap glyph-hori-bearing-y - ft-floor ]
+    2bi 2array ;
 
 : glyph-texture-size ( glyph -- dim )
     [ glyph-bitmap-width next-power-of-2 ]

basis/ui/gadgets/editors/editors.factor

@@ -138,11 +138,8 @@ M: editor ungraft*
     f >>focused?
     relayout-1 ;
 
-: (offset>x) ( font col# str -- x )
-    swap head-slice string-width ;
-
 : offset>x ( col# line# editor -- x )
-    [ editor-line ] keep editor-font* -rot (offset>x) ;
+    [ editor-line ] keep editor-font* spin head-slice string-width ;
 
 : loc>x ( loc editor -- x ) [ first2 swap ] dip offset>x ;
 

basis/ui/gadgets/gadgets-tests.factor

@@ -152,13 +152,6 @@ M: mock-gadget ungraft*
     { { f f } { f t } { t f } { t t } } [ notify-combo ] assoc-each
 ] with-string-writer print
 
-[ { { 10 30 } } ] [
-    <gadget> { 0 1 } >>orientation
-    { { 10 20 } }
-    { { 100 30 } }
-    orient
-] unit-test
-
 \ <gadget> must-infer
 \ unparent must-infer
 \ add-gadget must-infer

basis/ui/gadgets/gadgets.factor

@@ -86,15 +86,12 @@ M: gadget children-on nip children>> ;
 
 : pick-up ( point gadget -- child/f )
     2dup (pick-up) dup
-    [ nip [ rect-loc v- ] keep pick-up ] [ rot 2drop ] if ;
+    [ nip [ rect-loc v- ] keep pick-up ] [ drop nip ] if ;
 
 : max-dim ( dims -- dim ) { 0 0 } [ vmax ] reduce ;
 
 : dim-sum ( seq -- dim ) { 0 0 } [ v+ ] reduce ;
 
-: orient ( gadget seq1 seq2 -- seq )
-    rot orientation>> '[ _ set-axis ] 2map ;
-
 : each-child ( gadget quot -- )
     [ children>> ] dip each ; inline
 

basis/ui/gadgets/grids/grids.factor

@@ -18,14 +18,14 @@ grid
 : <grid> ( children -- grid )
     grid new-grid ;
 
-: grid-child ( grid i j -- gadget ) rot grid>> nth nth ;
+:: grid-child ( grid i j -- gadget ) i j grid grid>> nth nth ;
 
 :: grid-add ( grid child i j -- grid )
     grid i j grid-child unparent
     grid child add-gadget
     child i j grid grid>> nth set-nth ;
 
-: grid-remove ( grid i j -- grid ) <gadget> -rot grid-add ;
+: grid-remove ( grid i j -- grid ) [ <gadget> ] 2dip grid-add ;
 
 : pref-dim-grid ( grid -- dims )
     grid>> [ [ pref-dim ] map ] map ;

basis/ui/gadgets/labelled/labelled.factor

@@ -48,9 +48,10 @@ TUPLE: closable-gadget < frame content ;
     [ closable-gadget? ] find-parent ;
 
 : <closable-gadget> ( gadget title quot -- gadget )
-    closable-gadget new-frame
+    [
-        -rot <title-bar> @top grid-add
+        [ closable-gadget new-frame ] dip
-        swap >>content
+        [ >>content ] [ @center grid-add ] bi
-        dup content>> @center grid-add ;
+    ] 2dip
+    <title-bar> @top grid-add ;
     
 M: closable-gadget focusable-child* content>> ;

basis/ui/gadgets/packs/packs-tests.factor

@@ -1,6 +1,7 @@
 IN: ui.gadgets.packs.tests
 USING: ui.gadgets.packs ui.gadgets.labels ui.gadgets ui.render
-kernel namespaces tools.test math.parser sequences math.geometry.rect ;
+kernel namespaces tools.test math.parser sequences math.geometry.rect
+accessors ;
 
 [ t ] [
     { 0 0 } { 100 100 } <rect> clip set
@@ -11,3 +12,10 @@ kernel namespaces tools.test math.parser sequences math.geometry.rect ;
 
     visible-children [ label? ] all?
 ] unit-test
+
+[ { { 10 30 } } ] [
+    { { 10 20 } }
+    { { 100 30 } }
+    <gadget> { 0 1 } >>orientation
+    orient
+] unit-test

basis/ui/gadgets/packs/packs.factor

@@ -1,28 +1,30 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: sequences ui.gadgets kernel math math.functions
-math.vectors namespaces math.order accessors math.geometry.rect ;
+math.vectors math.order math.geometry.rect namespaces accessors
+fry ;
 IN: ui.gadgets.packs
 
 TUPLE: pack < gadget
-    { align initial: 0 }
+{ align initial: 0 } { fill initial: 0 } { gap initial: { 0 0 } } ;
-    { fill  initial: 0 }
-    { gap   initial: { 0 0 } } ;
 
 : packed-dim-2 ( gadget sizes -- list )
-    [ over rect-dim over v- rot fill>> v*n v+ ] with map ;
+    swap [ dim>> ] [ fill>> ] bi '[ _ over v- _ v*n v+ ] map ;
+
+: orient ( seq1 seq2 gadget -- seq )
+    orientation>> '[ _ set-axis ] 2map ;
 
 : packed-dims ( gadget sizes -- seq )
-    2dup packed-dim-2 swap orient ;
+    [ packed-dim-2 ] [ nip ] [ drop ] 2tri orient ;
 
 : gap-locs ( gap sizes -- seq )
     { 0 0 } [ v+ over v+ ] accumulate 2nip ;
 
 : aligned-locs ( gadget sizes -- seq )
-    [ [ dup align>> swap rect-dim ] dip v- n*v ] with map ;
+    [ [ [ align>> ] [ dim>> ] bi ] dip v- n*v ] with map ;
 
 : packed-locs ( gadget sizes -- seq )
-    over gap>> over gap-locs [ dupd aligned-locs ] dip orient ;
+    [ aligned-locs ] [ [ gap>> ] dip gap-locs ] [ drop ] 2tri orient ;
 
 : round-dims ( seq -- newseq )
     { 0 0 } swap
@@ -45,12 +47,14 @@ TUPLE: pack < gadget
 
 : <shelf> ( -- pack ) { 1 0 } <pack> ;
 
-: gap-dims ( gap sizes -- seeq )
+: gap-dims ( sizes gadget -- seeq )
-    [ dim-sum ] keep length 1 [-] rot n*v v+ ;
+    [ [ dim-sum ] [ length 1 [-] ] bi ] [ gap>> ] bi* n*v v+ ;
 
 : pack-pref-dim ( gadget sizes -- dim )
-    over gap>> over gap-dims [ max-dim ] dip
+    [ nip max-dim ]
-    rot orientation>> set-axis ;
+    [ swap gap-dims ]
+    [ drop orientation>> ]
+    2tri set-axis ;
 
 M: pack pref-dim*
     dup children>> pref-dims pack-pref-dim ;

basis/ui/gadgets/paragraphs/paragraphs.factor

@@ -1,7 +1,8 @@
-! Copyright (C) 2005, 2007 Slava Pestov
+! Copyright (C) 2005, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays ui.gadgets ui.gadgets.labels ui.render kernel math
+USING: accessors arrays ui.gadgets ui.gadgets.labels ui.render
-namespaces sequences math.order math.geometry.rect ;
+kernel math namespaces sequences math.order math.geometry.rect
+locals ;
 IN: ui.gadgets.paragraphs
 
 ! A word break gadget
@@ -46,12 +47,19 @@ SYMBOL: margin
     dup line-height [ max ] change
     y get + max-y [ max ] change ;
 
-: wrap-step ( quot child -- )
+:: wrap-step ( quot child -- )
-    dup pref-dim [
+    child pref-dim
-        over word-break-gadget? [
+    [
-            dup first overrun? [ wrap-line ] when
+        child
-        ] unless drop wrap-pos rot call
+        [
-    ] keep first2 advance-y advance-x ; inline
+            word-break-gadget?
+            [ drop ] [ first overrun? [ wrap-line ] when ] if
+        ]
+        [ wrap-pos quot call ] bi
+    ]
+    [ first advance-x ]
+    [ second advance-y ]
+    tri ; inline
 
 : wrap-dim ( -- dim ) max-x get max-y get 2array ;
 

basis/ui/gadgets/sliders/sliders.factor

@@ -26,10 +26,11 @@ TUPLE: slider < frame elevator thumb saved line ;
 : slider-max*  ( gadget -- n ) model>> range-max-value*    ;
 
 : thumb-dim ( slider -- h )
-    dup slider-page over slider-max 1 max / 1 min
+    [
-    over elevator-length * min-thumb-dim max
+        [ [ slider-page ] [ slider-max 1 max ] bi / 1 min ]
-    over elevator>> rect-dim
+        [ elevator-length ] bi * min-thumb-dim max
-    rot orientation>> v. min ;
+    ]
+    [ [ elevator>> dim>> ] [ orientation>> ] bi v. ] bi min ;
 
 : slider-scale ( slider -- n )
     #! A scaling factor such that if x is a slider co-ordinate,
@@ -109,8 +110,8 @@ elevator H{
 : layout-thumb-dim ( slider -- )
     dup dup thumb-dim (layout-thumb)
     [
-        [ dup rect-dim ] dip
+        [ [ rect-dim ] dip ] [ drop orientation>> ] 2bi set-axis
-        rot orientation>> set-axis [ ceiling ] map
+        [ ceiling ] map
     ] dip (>>dim) ;
 
 : layout-thumb ( slider -- )

basis/ui/gadgets/worlds/worlds.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs continuations kernel math models
-namespaces opengl sequences io combinators math.vectors
+namespaces opengl sequences io combinators fry math.vectors
 ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
 debugger math.geometry.rect ;
 IN: ui.gadgets.worlds
@@ -67,9 +67,7 @@ M: world children-on nip children>> ;
 : draw-world? ( world -- ? )
     #! We don't draw deactivated worlds, or those with 0 size.
     #! On Windows, the latter case results in GL errors.
-    dup active?>>
+    [ active?>> ] [ handle>> ] [ dim>> [ 0 > ] all? ] tri and and ;
-    over handle>>
-    rot rect-dim [ 0 > ] all? and and ;
 
 TUPLE: world-error error world ;
 
@@ -127,5 +125,4 @@ M: world handle-gesture ( gesture gadget -- ? )
     ] [ 2drop f ] if ;
 
 : close-global ( world global -- )
-    dup get-global find-world rot eq?
+    [ get-global find-world eq? ] keep '[ f _ set-global ] when ;
-    [ f swap set-global ] [ drop ] if ;

basis/ui/operations/operations.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions kernel ui.commands
 ui.gestures sequences strings math words generic namespaces make
-hashtables help.markup quotations assocs ;
+hashtables help.markup quotations assocs fry ;
 IN: ui.operations
 
 SYMBOL: +keyboard+
@@ -63,7 +63,7 @@ SYMBOL: operations
         t >>listener? ;
 
 : modify-operations ( operations hook translator -- operations )
-    rot [ modify-operation ] with with map ;
+    '[ [ _ _ ] dip modify-operation ] map ;
 
 : operations>commands ( object hook translator -- pairs )
     [ object-operations ] 2dip modify-operations

basis/ui/render/render.factor

@@ -227,7 +227,7 @@ HOOK: free-fonts font-renderer ( world -- )
     dup string? [
         string-width
     ] [
-        0 -rot [ string-width max ] with each
+        [ 0 ] 2dip [ string-width max ] with each
     ] if ;
 
 : text-dim ( open-font text -- dim )

basis/ui/tools/deploy/deploy.factor

@@ -117,5 +117,7 @@ deploy-gadget "toolbar" f {
     dup com-revert ;
     
 : deploy-tool ( vocab -- )
-    vocab-name dup <deploy-gadget> 10 <border>
+    vocab-name
-    "Deploying \"" rot "\"" 3append open-window ;
+    [ <deploy-gadget> 10 <border> ]
+    [ "Deploying \"" swap "\"" 3append ] bi
+    open-window ;

basis/ui/traverse/traverse.factor

@@ -59,15 +59,15 @@ TUPLE: node value children ;
 DEFER: (gadget-subtree)
 
 : traverse-child ( frompath topath gadget -- )
-    [ -rot ] keep [
+    [ 2nip ] 3keep
-        [ rest-slice ] 2dip traverse-step (gadget-subtree)
+    [ [ rest-slice ] 2dip traverse-step (gadget-subtree) ]
-    ] make-node ;
+    make-node ;
 
 : (gadget-subtree) ( frompath topath gadget -- )
     {
         { [ dup not ] [ 3drop ] }
         { [ pick empty? pick empty? and ] [ 2nip , ] }
-        { [ pick empty? ] [ rot drop traverse-to-path ] }
+        { [ pick empty? ] [ traverse-to-path drop ] }
         { [ over empty? ] [ nip traverse-from-path ] }
         { [ pick first pick first = ] [ traverse-child ] }
         [ traverse-middle ]

basis/ui/windows/windows.factor

@@ -296,8 +296,10 @@ SYMBOL: nc-buttons
     key-modifiers swap message>button
     [ <button-down> ] [ <button-up> ] if ;
 
-: prepare-mouse ( hWnd uMsg wParam lParam -- button coordinate world )
+:: prepare-mouse ( hWnd uMsg wParam lParam -- button coordinate world )
-    [ drop mouse-event>gesture ] dip >lo-hi rot window ;
+    uMsg mouse-event>gesture
+    lParam >lo-hi
+    hWnd window ;
 
 : set-capture ( hwnd -- )
     mouse-captured get [
@@ -435,7 +437,7 @@ M: windows-ui-backend do-events
     style 0 ex-style AdjustWindowRectEx win32-error=0/f ;
 
 : make-RECT ( world -- RECT )
-    dup window-loc>> dup rot rect-dim v+
+    [ window-loc>> dup ] [ rect-dim ] bi v+
     "RECT" <c-object>
     over first over set-RECT-right
     swap second over set-RECT-bottom

basis/ui/x11/x11.factor

@@ -95,8 +95,10 @@ M: world key-up-event
     [ key-up-event>gesture ] dip world-focus propagate-gesture ;
 
 : mouse-event>gesture ( event -- modifiers button loc )
-    dup event-modifiers over XButtonEvent-button
+    [ event-modifiers ]
-    rot mouse-event-loc ;
+    [ XButtonEvent-button ]
+    [ mouse-event-loc ]
+    tri ;
 
 M: world button-down-event
     [ mouse-event>gesture [ <button-down> ] dip ] dip
@@ -222,8 +224,8 @@ M: x-clipboard paste-clipboard
     utf8 encode dup length XChangeProperty drop ;
 
 M: x11-ui-backend set-title ( string world -- )
-    handle>> window>> swap dpy get -rot
+    handle>> window>> swap
-    3dup set-title-old set-title-new ;
+    [ dpy get ] 2dip [ set-title-old ] [ set-title-new ] 3bi ;
 
 M: x11-ui-backend set-fullscreen* ( ? world -- )
     handle>> window>> "XClientMessageEvent" <c-object>