Clean up some usages of tuck, and add Joe's curried cleave/spread/apply combinators...

diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
index 3ad716d847f19a5066fb23b06b8f8e06d0278d55..cb5f2e926d56700e143f207c31930c6b81a008eb 100644 (file)
--- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
+++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
@@ -70,7 +70,7 @@ IN: compiler.cfg.intrinsics.fixnum
     ds-push ;
 
 : emit-fixnum-comparison ( node cc -- )
-    [ '[ _ ^^compare ] ] [ '[ _ ^^compare-imm ] ] bi
+    [  ^^compare ] [ ^^compare-imm ] bi-curry
     emit-fixnum-op ;
 
 : emit-bignum>fixnum ( -- )

diff --git a/basis/compiler/cfg/intrinsics/slots/slots.factor b/basis/compiler/cfg/intrinsics/slots/slots.factor
index bc46e6149c0d81dd8ed536b70b80ba8fa89957c8..0cc6e6f5d0499989ad3d6fb05a1584147b67f2f2 100644 (file)
--- a/basis/compiler/cfg/intrinsics/slots/slots.factor
+++ b/basis/compiler/cfg/intrinsics/slots/slots.factor
@@ -28,15 +28,14 @@ IN: compiler.cfg.intrinsics.slots
     ] [ drop emit-primitive ] if ;
 
 : (emit-set-slot) ( infos -- obj-reg )
-    [ 3inputs [ tuck ] dip ^^offset>slot ]
-    [ second value-tag ]
-    bi* ^^set-slot ;
+    [ 3inputs ^^offset>slot ] [ second value-tag ] bi*
+    pick [ ^^set-slot ] dip ;
 
 : (emit-set-slot-imm) ( infos -- obj-reg )
     ds-drop
-    [ 2inputs tuck ]
+    [ 2inputs ]
     [ [ third literal>> ] [ second value-tag ] bi ] bi*
-    ##set-slot-imm ;
+    pick [ ##set-slot-imm ] dip ;
 
 : emit-set-slot ( node -- )
     dup node-input-infos

diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
index d75d5649cbbc0870f2940ab7656af74af7d2d49f..8d00a14ea2142c69463605ef53404dae56607f19 100644 (file)
--- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor
+++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor
@@ -105,7 +105,7 @@ SYMBOL: spill-counts
     #! If it has been spilled already, reuse spill location.
     over reload-from>>
     [ over vreg>> reg-class>> next-spill-location ] unless*
-    tuck [ >>spill-to ] [ >>reload-from ] 2bi* ;
+    [ >>spill-to ] [ >>reload-from ] bi-curry bi* ;
 
 : split-and-spill ( new existing -- before after )
     dup rot start>> split-interval

diff --git a/basis/compiler/tree/dead-code/simple/simple.factor b/basis/compiler/tree/dead-code/simple/simple.factor
index 886233a08b0324c4836a60bd55ee283b47c39944..c9b73808a12a9e97b70685375193c4489070a822 100755 (executable)
--- a/basis/compiler/tree/dead-code/simple/simple.factor
+++ b/basis/compiler/tree/dead-code/simple/simple.factor
@@ -76,7 +76,7 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
     ] ;
 
 : drop-dead-outputs ( node -- #shuffle )
-    dup out-d>> drop-dead-values tuck in-d>> >>out-d drop ;
+    dup out-d>> drop-dead-values [ in-d>> >>out-d drop ] keep ;
 
 : some-outputs-dead? ( #call -- ? )
     out-d>> [ live-value? not ] any? ;

diff --git a/basis/documents/documents.factor b/basis/documents/documents.factor
index f632b3cf481f4699a816b93327b70342407b3d27..fb1d2b2406600c657249ba3e0ce4cf55c16111ef 100644 (file)
--- a/basis/documents/documents.factor
+++ b/basis/documents/documents.factor
@@ -64,10 +64,9 @@ TUPLE: document < model locs undos redos inside-undo? ;
     ] if ; inline
 
 : start/end-on-line ( from to line# -- n1 n2 )
-    tuck
     [ [ document get ] 2dip start-on-line ]
     [ [ document get ] 2dip end-on-line ]
-    2bi* ;
+    bi-curry bi* ;
 
 : last-line# ( document -- line )
     value>> length 1- ;
@@ -101,7 +100,7 @@ CONSTANT: doc-start { 0 0 }
     [ first2 swap ] dip nth swap ;
 
 : prepare-insert ( new-lines from to lines -- new-lines )
-    tuck [ loc-col/str head-slice ] [ loc-col/str tail-slice ] 2bi*
+    [ loc-col/str head-slice ] [ loc-col/str tail-slice ] bi-curry bi*
     pick append-last over prepend-first ;
 
 : (set-doc-range) ( doc-lines from to lines -- changed-lines )
@@ -162,7 +161,7 @@ PRIVATE>
         over first 0 < [
             2drop { 0 0 }
         ] [
-            [ first2 swap tuck ] dip validate-col 2array
+            [ first2 over ] dip validate-col 2array
         ] if
     ] if ;
 

diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor
index aa1ebf77865cca0dc8f05a2bebbc2986156ddace..37882f8a5743394f0bc1e5a6f30cd2cf71b1730e 100644 (file)
--- a/basis/heaps/heaps.factor
+++ b/basis/heaps/heaps.factor
@@ -82,8 +82,8 @@ M: heap heap-size ( heap -- n )
     data>> first ; inline
 
 : data-exchange ( m n heap -- )
-    [ tuck data-nth [ data-nth ] dip ] 3keep
-    tuck [ data-set-nth ] 2dip data-set-nth ; inline
+    [ [ data-nth ] curry bi@ ]
+    [ [ data-set-nth ] curry bi@ ] 3bi ; inline
 
 GENERIC: heap-compare ( pair1 pair2 heap -- ? )
 

diff --git a/basis/html/templates/chloe/syntax/syntax.factor b/basis/html/templates/chloe/syntax/syntax.factor
index c2ecd4506b342a4d98f18356c47545217aac4d20..82082e37af0f969b08cc64ee9631ddc124c5a26d 100644 (file)
--- a/basis/html/templates/chloe/syntax/syntax.factor
+++ b/basis/html/templates/chloe/syntax/syntax.factor
@@ -26,8 +26,8 @@ tags global [ H{ } clone or ] change-at
 XML-NS: chloe-name http://factorcode.org/chloe/1.0
 
 : required-attr ( tag name -- value )
-    tuck chloe-name attr
-    [ nip ] [ " attribute is required" append throw ] if* ;
+    [ nip ] [ chloe-name attr ] 2bi
+    [ ] [ " attribute is required" append throw ] ?if ;
 
 : optional-attr ( tag name -- value )
     chloe-name attr ;

diff --git a/basis/io/streams/duplex/duplex.factor b/basis/io/streams/duplex/duplex.factor
index 53d554e766933fb12e95be23c9b78d26691e8937..02b56d9ab28e6c6660902f875d789a306790bea1 100644 (file)
--- a/basis/io/streams/duplex/duplex.factor
+++ b/basis/io/streams/duplex/duplex.factor
@@ -27,7 +27,7 @@ M: duplex-stream dispose
     ] with-destructors ;
 
 : <encoder-duplex> ( stream-in stream-out encoding -- duplex )
-    tuck [ re-decode ] [ re-encode ] 2bi* <duplex-stream> ;
+    [ re-decode ] [ re-encode ] bi-curry bi* <duplex-stream> ;
 
 : with-stream* ( stream quot -- )
     [ [ in>> ] [ out>> ] bi ] dip with-streams* ; inline

diff --git a/basis/math/complex/complex.factor b/basis/math/complex/complex.factor
index 620a6c3bab2f5f0b53127bb7451e4d972e855ccc..47835d58fbc59241b956bda95027e16a47fbb73a 100644 (file)
--- a/basis/math/complex/complex.factor
+++ b/basis/math/complex/complex.factor
@@ -38,7 +38,7 @@ M: complex * [ *re - ] [ *im + ] 2bi (rect>) ;
 : complex/ ( x y -- r i m )
     [ [ *re + ] [ *im - ] 2bi ] keep absq ; inline
 
-M: complex / complex/ tuck [ / ] 2bi@ (rect>) ;
+M: complex / complex/ [ / ] curry bi@ (rect>) ;
 
 M: complex abs absq >float fsqrt ;
 

diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor
index 85b4d711ac045e1bf726c8e0828a0ec933e0d087..20c31aa2bd300efd1be45b84ec6a782eaefca445 100644 (file)
--- a/basis/math/functions/functions.factor
+++ b/basis/math/functions/functions.factor
@@ -53,7 +53,7 @@ M: integer ^n
     [ factor-2s ] dip [ (^n) ] keep rot * shift ;
 
 M: ratio ^n
-    [ >fraction ] dip tuck [ ^n ] 2bi@ / ;
+    [ >fraction ] dip [ ^n ] curry bi@ / ;
 
 M: float ^n
     (^n) ;

diff --git a/basis/math/partial-dispatch/partial-dispatch.factor b/basis/math/partial-dispatch/partial-dispatch.factor
index 19715357eec1c77c03349820ea1e33bc36e13e08..6618578a990cb63c3428bd062db94014e5d6eff2 100644 (file)
--- a/basis/math/partial-dispatch/partial-dispatch.factor
+++ b/basis/math/partial-dispatch/partial-dispatch.factor
@@ -104,10 +104,10 @@ M: word integer-op-input-classes
 
 : define-integer-ops ( word fix-word big-word -- )
     [
-        rot tuck
+        rot
         [ fixnum fixnum 3array "derived-from" set-word-prop ]
         [ bignum bignum 3array "derived-from" set-word-prop ]
-        2bi*
+        bi-curry bi*
     ] [
         [ integer-op-triples ] 2dip
         [ define-integer-op-words ]

diff --git a/basis/math/ratios/ratios.factor b/basis/math/ratios/ratios.factor
index e44dbd1a757f8e01fe4c5e0d8522185ca7437497..54e4bee1a85582376d185fd275e3ba81748efdaf 100644 (file)
--- a/basis/math/ratios/ratios.factor
+++ b/basis/math/ratios/ratios.factor
@@ -24,7 +24,7 @@ M: integer /
         "Division by zero" throw
     ] [
         dup 0 < [ [ neg ] bi@ ] when
-        2dup gcd nip tuck [ /i ] 2bi@ fraction>
+        2dup gcd nip [ /i ] curry bi@ fraction>
     ] if ;
 
 M: ratio hashcode*

diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor
index 09caebcf0757bd81bcaf39194133002c45ae8907..589876184ff2ad826dd7ed7d7648ddd7a7fd0b90 100644 (file)
--- a/basis/math/statistics/statistics.factor
+++ b/basis/math/statistics/statistics.factor
@@ -22,7 +22,7 @@ IN: math.statistics
 
 : minmax ( seq -- min max )
     #! find the min and max of a seq in one pass
-    [ 1/0. -1/0. ] dip [ tuck [ min ] [ max ] 2bi* ] each ;
+    [ 1/0. -1/0. ] dip [ [ min ] [ max ] bi-curry bi* ] each ;
 
 : range ( seq -- n )
     minmax swap - ;

diff --git a/basis/random/random.factor b/basis/random/random.factor
index 554ed5c96a8d85d807d070aedc6e5cf74daeafa6..e0ce59dc876d9a4179c1c96bf725a11713ec314c 100755 (executable)
--- a/basis/random/random.factor
+++ b/basis/random/random.factor
@@ -15,12 +15,12 @@ GENERIC: random-32* ( tuple -- r )
 GENERIC: random-bytes* ( n tuple -- byte-array )
 
 M: object random-bytes* ( n tuple -- byte-array )
-    [ [ <byte-vector> ] keep 4 /mod ] dip tuck
+    [ [ <byte-vector> ] keep 4 /mod ] dip
     [ pick '[ _ random-32* 4 >le _ push-all ] times ]
     [
         over zero?
         [ 2drop ] [ random-32* 4 >le swap head over push-all ] if
-    ] 2bi* ;
+    ] bi-curry bi* ;
 
 M: object random-32* ( tuple -- r ) 4 random-bytes* le> ;
 

diff --git a/basis/tools/completion/completion.factor b/basis/tools/completion/completion.factor
index 4bf1f8253aff6a4506a525002bd842f695f4cf61..47977b45c1266eef49c1d9d49c54abf2cad7a1e2 100644 (file)
--- a/basis/tools/completion/completion.factor
+++ b/basis/tools/completion/completion.factor
@@ -65,9 +65,8 @@ IN: tools.completion
     [ second >lower swap complete ] keep 2array ;
 
 : completions ( short candidates -- seq )
-    [ '[ _ ] ]
-    [ '[ >lower _ [ completion ] with map rank-completions ] ] bi
-    if-empty ;
+    [ ] [ [ >lower ] dip [ completion ] with map rank-completions ]
+    bi-curry if-empty ;
 
 : name-completions ( str seq -- seq' )
     [ dup name>> ] { } map>assoc completions ;

diff --git a/basis/tools/memory/memory.factor b/basis/tools/memory/memory.factor
index 2ad16a4d8d6d34cff4886ff4e64c133b4a81e638..cf3b7c280f9d835f866a23df0143da1017d8c7e2 100644 (file)
--- a/basis/tools/memory/memory.factor
+++ b/basis/tools/memory/memory.factor
@@ -52,9 +52,8 @@ IN: tools.memory
     } spread ;
 
 : heap-stat-step ( obj counts sizes -- )
-    [ over ] dip
     [ [ class ] dip inc-at ]
-    [ [ [ size ] [ class ] bi ] dip at+ ] 2bi* ;
+    [ [ [ size ] [ class ] bi ] dip at+ ] bi-curry* bi ;
 
 PRIVATE>
 

diff --git a/basis/ui/gadgets/borders/borders.factor b/basis/ui/gadgets/borders/borders.factor
index ec625c909a927f87f97166540c7c4b6c68f03b19..44bf91224581623e1c03a0a87b10e1553a1995c3 100644 (file)
--- a/basis/ui/gadgets/borders/borders.factor
+++ b/basis/ui/gadgets/borders/borders.factor
@@ -32,7 +32,7 @@ M: border baseline
     gadget-child pref-dim ;
 
 : scale ( a b s -- c )
-    tuck { 1 1 } swap v- [ v* ] 2bi@ v+ ;
+    [ v* ] [ { 1 1 } swap v- v* ] bi-curry bi* v+ ;
 
 : border-dim ( border -- dim )
     [ border-major-dim ] [ border-minor-dim ] [ fill>> ] tri scale ;

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 867158df4f65cab71b16fcbabd8355c0027520fb..c8345583fa007e7dea03fd85066eb222f3f81f85 100755 (executable)
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -2,12 +2,13 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays documents documents.elements kernel math
 models models.filter namespaces locals fry make opengl opengl.gl
-sequences strings math.vectors sorting colors combinators assocs
-math.order fry calendar alarms continuations ui.clipboards ui.commands
-ui.gadgets ui.gadgets.borders ui.gadgets.buttons ui.gadgets.labels
-ui.gadgets.scrollers ui.gadgets.theme ui.gadgets.menus
-ui.gadgets.wrappers ui.render ui.text ui.gestures math.geometry.rect
-splitting unicode.categories fonts ;
+sequences strings math.vectors math.functions sorting colors
+combinators assocs math.order fry calendar alarms continuations
+ui.clipboards ui.commands ui.gadgets ui.gadgets.borders
+ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers
+ui.gadgets.theme ui.gadgets.menus ui.gadgets.wrappers ui.render
+ui.text ui.gestures math.geometry.rect splitting unicode.categories
+fonts ;
 IN: ui.gadgets.editors
 
 TUPLE: editor < gadget
@@ -133,7 +134,7 @@ M: editor ungraft*
     [ stop-blinking ] [ f >>focused? relayout-1 ] bi ;
 
 : loc>x ( loc editor -- x )
-    [ first2 swap ] dip [ editor-line ] [ font>> ] bi swap offset>x ;
+    [ first2 swap ] dip [ editor-line ] [ font>> ] bi swap offset>x round ;
 
 : line>y ( lines# editor -- y )
     line-height * ;
@@ -222,7 +223,7 @@ M: editor ungraft*
 
 : draw-selected-line ( start end n -- )
     [ start/end-on-line ] keep
-    tuck [ swap 2array editor get loc>x ] 2bi@
+    [ swap 2array editor get loc>x ] curry bi@
     (draw-selection) ;
 
 : draw-selection ( -- )
@@ -347,7 +348,7 @@ M: editor gadget-text* editor-string % ;
     dupd editor-select-next mark>caret ;
 
 : editor-select ( from to editor -- )
-    tuck [ mark>> set-model ] [ caret>> set-model ] 2bi* ;
+    [ mark>> set-model ] [ caret>> set-model ] bi-curry bi* ;
 
 : select-elt ( editor elt -- )
     [ [ [ editor-caret ] [ model>> ] bi ] dip prev/next-elt ] [ drop ] 2bi

diff --git a/basis/ui/gadgets/frames/frames.factor b/basis/ui/gadgets/frames/frames.factor
index ae4c7d929a5d3658839ce6ad4f28a8ab83dde066..4d9f35ea515c38f07e667bb0c012381c23595e9f 100644 (file)
--- a/basis/ui/gadgets/frames/frames.factor
+++ b/basis/ui/gadgets/frames/frames.factor
@@ -36,7 +36,7 @@ TUPLE: frame < grid ;
     [ [ first ] [ third ] bi v+ [v-] ] keep set-second ;
 
 : fill-center ( dim horiz vert -- )
-    [ over ] dip [ (fill-center) ] 2bi@ ;
+    [ (fill-center) ] bi-curry@ bi ;
 
 M: frame layout*
     dup compute-grid

diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor
index 34a0d5c92ff11dfbdac8a303cda9663983a7dac2..a0c95c6410a609eadf5282e754cba47f481b46d7 100644 (file)
--- a/basis/ui/gadgets/gadgets.factor
+++ b/basis/ui/gadgets/gadgets.factor
@@ -190,10 +190,18 @@ GENERIC: pref-dim* ( gadget -- dim )
 
 M: gadget pref-dim* dim>> ;
 
+SYMBOL: +baseline+
+
 GENERIC: baseline ( gadget -- y )
 
 M: gadget baseline pref-dim second ;
 
+: baseline-align ( gadgets -- ys )
+    [ { } ] [
+        [ baseline ] map [ supremum ] keep
+        [ - ] with map
+    ] if-empty ;
+
 GENERIC: layout* ( gadget -- )
 
 M: gadget layout* drop ;
@@ -315,25 +323,24 @@ PRIVATE>
 
 <PRIVATE
 
-: ((add-gadget)) ( parent child -- parent )
-    over children>> ?push >>children ;
-
-: (add-gadget) ( parent child -- parent )
-    dup unparent
-    over >>parent
-    tuck ((add-gadget))
-    tuck graft-state>> second [ graft ] [ drop ] if ;
+: (add-gadget) ( child parent -- )
+    {
+        [ drop unparent ]
+        [ >>parent drop ]
+        [ [ ?push ] change-children drop ]
+        [ graft-state>> second [ graft ] [ drop ] if ]
+    } 2cleave ;
 
 PRIVATE>
 
 : add-gadget ( parent child -- parent )
     not-in-layout
-    (add-gadget)
+    over (add-gadget)
     dup relayout ;
 
 : add-gadgets ( parent children -- parent )
     not-in-layout
-    [ (add-gadget) ] each
+    [ over (add-gadget) ] each
     dup relayout ;
 
 : parents ( gadget -- seq )

diff --git a/basis/ui/gadgets/grids/grids.factor b/basis/ui/gadgets/grids/grids.factor
index 8a448fddf1b79911084e284e99e3852d4ab19cca..dc1f70aa0888264c22f06c2556f1d9434ace458f 100644 (file)
--- a/basis/ui/gadgets/grids/grids.factor
+++ b/basis/ui/gadgets/grids/grids.factor
@@ -8,7 +8,8 @@ IN: ui.gadgets.grids
 TUPLE: grid < gadget
 grid
 { gap initial: { 0 0 } }
-{ fill? initial: t } ;
+{ fill? initial: t }
+align ;
 
 : new-grid ( children class -- grid )
     new-gadget
@@ -49,7 +50,7 @@ grid
 
 M: grid pref-dim*
     [ gap>> ] [ compute-grid ] bi
-    [ over ] dip [ gap-sum ] 2bi@ (pair-up) ;
+    [ gap-sum ] bi-curry@ bi (pair-up) ;
 
 : do-grid ( dims grid quot -- )
     [ grid>> ] dip '[ _ 2each ] 2each ; inline
@@ -58,7 +59,7 @@ M: grid pref-dim*
     [ gap>> dup ] dip add-gaps swap [ v+ ] accumulate nip ;
 
 : position-grid ( grid horiz vert -- )
-    pick [ [ over ] dip [ grid-positions ] 2bi@ pair-up ] dip
+    pick [ [ grid-positions ] bi-curry@ bi pair-up ] dip
     [ (>>loc) ] do-grid ;
 
 : resize-grid ( grid horiz vert -- )

diff --git a/basis/ui/gadgets/incremental/incremental.factor b/basis/ui/gadgets/incremental/incremental.factor
index 29d8f8ab030baa323da14069b75b931414e20979..c31dd1d35a8be30ac74499987218008638199987 100644 (file)
--- a/basis/ui/gadgets/incremental/incremental.factor
+++ b/basis/ui/gadgets/incremental/incremental.factor
@@ -37,7 +37,7 @@ M: incremental dim-changed drop ;
 
 : add-incremental ( gadget incremental -- )
     not-in-layout
-    2dup swap (add-gadget) drop
+    2dup (add-gadget)
     t in-layout? [
         {
             [ drop prefer-incremental ]

diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor
index 98037b08bd882f2dd0956a86f0d3db55c4aa3387..7377e9e1869814d2571f800869883d1eea55f9b1 100644 (file)
--- a/basis/ui/gadgets/panes/panes.factor
+++ b/basis/ui/gadgets/panes/panes.factor
@@ -108,14 +108,12 @@ C: <pane-stream> pane-stream
     [ prepare-line ] bi ;
 
 : pane-write ( seq pane -- )
-    [ '[ _ pane-nl ] ]
-    [ '[ _ current>> stream-write ] ] bi
-    interleave ;
+    [ pane-nl ] [ current>> stream-write ]
+    bi-curry interleave ;
 
 : pane-format ( seq style pane -- )
-    [ '[ _ drop _ pane-nl ] ]
-    [ '[ _ _ current>> stream-format ] ] 2bi
-    interleave ;
+    [ nip pane-nl ] [ current>> stream-format ]
+    bi-curry bi-curry interleave ;
 
 GENERIC: write-gadget ( gadget stream -- )
 
@@ -329,8 +327,7 @@ M: paragraph stream-format
         gadget-format
     ] [
         [ " " split ] 2dip
-        [ '[ _ _ gadget-bl ] ]
-        [ '[ _ _ gadget-format ] ] 2bi
+        [ gadget-bl ] [ gadget-format ] bi-curry bi-curry
         interleave
     ] if ;
 

diff --git a/basis/ui/gadgets/sliders/sliders.factor b/basis/ui/gadgets/sliders/sliders.factor
index 29671ff0e3f5581ceafe9ee6abae71004d2904c6..d918cdd8921899d5f0c68f0cff4e6269b369eeb2 100644 (file)
--- a/basis/ui/gadgets/sliders/sliders.factor
+++ b/basis/ui/gadgets/sliders/sliders.factor
@@ -129,16 +129,15 @@ M: elevator layout*
     '[ _ swap find-slider slide-by-line ] <repeat-button>
     swap >>orientation ;
 
-: elevator, ( gadget orientation -- gadget )
-    tuck <elevator> >>elevator
-    swap <thumb> >>thumb
-    dup elevator>> over thumb>> add-gadget
+: add-elevator ( gadget orientation -- gadget )
+    [ <elevator> >>elevator ] [ <thumb> >>thumb ] bi
+    dup [ elevator>> ] [ thumb>> ] bi add-gadget
     @center grid-add ;
 
-: <left-button>  ( -- button ) { 0 1 } arrow-left -1 <slide-button> ;
+: <left-button> ( -- button ) { 0 1 } arrow-left -1 <slide-button> ;
 : <right-button> ( -- button ) { 0 1 } arrow-right 1 <slide-button> ;
-: <up-button>    ( -- button ) horizontal arrow-up   -1 <slide-button> ;
-: <down-button>  ( -- button ) horizontal arrow-down  1 <slide-button> ;
+: <up-button> ( -- button ) horizontal arrow-up -1 <slide-button> ;
+: <down-button> ( -- button ) horizontal arrow-down  1 <slide-button> ;
 
 : <slider> ( range orientation -- slider )
     slider new-frame
@@ -149,16 +148,16 @@ M: elevator layout*
 : <x-slider> ( range -- slider )
     horizontal <slider>
         <left-button> @left grid-add
-        vertical elevator,
+        vertical add-elevator
         <right-button> @right grid-add ;
 
 : <y-slider> ( range -- slider )
     vertical <slider>
         <up-button> @top grid-add
-        horizontal elevator,
+        horizontal add-elevator
         <down-button> @bottom grid-add ;
 
 M: slider pref-dim*
-    dup call-next-method
-    swap orientation>> [ 40 v*n ] keep
+    [ call-next-method ] [ orientation>> ] bi
+    [ 40 v*n ] keep
     set-axis ;

diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor
index dff4fa682ed610496060f814a3c2436895eb5732..0c9c4abcb442cdf3a69379d9e04c30ab88019840 100644 (file)
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -178,8 +178,8 @@ M: table draw-gadget*
             {
                 [ draw-selected ]
                 [ draw-columns ]
-                [ draw-moused ]
                 [ draw-rows ]
+                [ draw-moused ]
             } cleave
         ] with-translation
     ] if ;
@@ -295,7 +295,8 @@ PRIVATE>
 
 : show-table-menu ( table -- )
     [
-        tuck [ nth-row drop ] [ renderer>> row-value ] [ hook>> ] tri
+        [ nip ]
+        [ [ nth-row drop ] [ renderer>> row-value ] [ hook>> ] tri ] 2bi
         show-operations-menu
     ] [ drop ] if-mouse-row ;
 

diff --git a/basis/ui/tools/listener/completion/completion.factor b/basis/ui/tools/listener/completion/completion.factor
index 88f2731b821189125333b2909ad10f992fe4cc0e..5bb59b6b2152e095c631c78bd92f41cd2438148e 100644 (file)
--- a/basis/ui/tools/listener/completion/completion.factor
+++ b/basis/ui/tools/listener/completion/completion.factor
@@ -158,8 +158,8 @@ CONSTANT: completion-popup-offset { -4 0 }
     ?if ;
 
 : completion-gesture ( gesture completion -- value/f operation/f )
-    table>> selected-row [ tuck ] dip
-    [ gesture>operation ] [ 2drop f ] if ;
+    table>> selected-row
+    [ [ nip ] [ gesture>operation ] 2bi ] [ drop f ] if ;
 
 M: completion-popup handle-gesture ( gesture completion -- ? )
     2dup completion-gesture dup [

diff --git a/basis/validators/validators.factor b/basis/validators/validators.factor
index eaf8056c451028ec1da1c46fde4a038519239c28..f0ee13dd382c205cd55806fc3097a290463cc5ee 100644 (file)
--- a/basis/validators/validators.factor
+++ b/basis/validators/validators.factor
@@ -54,12 +54,12 @@ IN: validators
     ] if ;
 
 : v-regexp ( str what regexp -- str )
-    [ over ] dip matches?
-    [ drop ] [ "invalid " prepend throw ] if ;
+    3dup nip matches?
+    [ 2drop ] [ drop "invalid " prepend throw ] if ;
 
 : v-email ( str -- str )
     #! From http://www.regular-expressions.info/email.html
-    60 v-max-length
+    320 v-max-length
     "e-mail"
     R' [A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}'i
     v-regexp ;

diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor
index 813d8315ac07f0a893c220e66e5e75fb49f37e6c..68d30d92237ee02a891050b8ac7d5088eefe10e2 100755 (executable)
--- a/basis/windows/com/wrapper/wrapper.factor
+++ b/basis/windows/com/wrapper/wrapper.factor
@@ -87,9 +87,9 @@ unless
     if ;
 
 : (thunked-quots) ( quots iunknown-methods thunk -- {thunk,quot}s )
-    [ '[ _ '[ @ com-unwrap ] [ swap 2array ] curry map ] ]
-    [ '[ _                   [ swap 2array ] curry map ] ] bi bi*
-    swap append ;
+    [ '[ @ com-unwrap ] [ swap 2array ] curry map ]
+    [                   [ swap 2array ] curry map ] bi-curry bi*
+    prepend ;
 
 : compile-alien-callback ( word return parameters abi quot -- word )
     '[ _ _ _ _ alien-callback ]

diff --git a/basis/xml/tests/xmltest.factor b/basis/xml/tests/xmltest.factor
index a8024ce151bebe0b58aaf7c1f7cb290487cb88de..ec75eeb89e4f57bd53d1feda538122e50a377352 100644 (file)
--- a/basis/xml/tests/xmltest.factor
+++ b/basis/xml/tests/xmltest.factor
@@ -26,8 +26,7 @@ MACRO: drop-input ( quot -- newquot )
     infer in>> '[ _ ndrop ] ;
 
 : fails? ( quot -- ? )
-    [ '[ _ drop-output f ] ]
-    [ '[ drop _ drop-input t ] ] bi recover ; inline
+    [ drop-output f ] [ nip drop-input t ] bi-curry recover ; inline
 
 : well-formed? ( uri -- answer )
     [ file>xml ] fails? "not-wf" "valid" ? ;

diff --git a/basis/xml/writer/writer-tests.factor b/basis/xml/writer/writer-tests.factor
index d09ae08b3fa6ca26134b42a2ba333d55d1818d4f..b87e0adee0a4fa6d3035431fbddb23efacff8cc9 100644 (file)
--- a/basis/xml/writer/writer-tests.factor
+++ b/basis/xml/writer/writer-tests.factor
@@ -14,10 +14,10 @@ IN: xml.writer.tests
 [ "ns:foo" ] [ T{ name { space "ns" } { main "foo" } } name>string ] unit-test
 
 : reprints-as ( to from -- )
-     [ '[ _ ] ] [ '[ _ string>xml xml>string ] ] bi* unit-test ;
+     [ ] [ string>xml xml>string ] bi-curry* unit-test ;
 
 : pprint-reprints-as ( to from -- )
-     [ '[ _ ] ] [ '[ _ string>xml pprint-xml>string ] ] bi* unit-test ;
+     [ ] [ string>xml pprint-xml>string ] bi-curry* unit-test ;
 
 : reprints-same ( string -- ) dup reprints-as ;
 

diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor
index e46bb7abb669ce0e983b474e6a64b1d07cc9f5df..73f787e00962263ac55eb4249425e013dfa9fef8 100755 (executable)
--- a/core/assocs/assocs.factor
+++ b/core/assocs/assocs.factor
@@ -68,7 +68,7 @@ PRIVATE>
 
 : assoc-partition ( assoc quot -- true-assoc false-assoc )
     [ (assoc-each) partition ] [ drop ] 2bi
-    tuck [ assoc-like ] 2bi@ ; inline
+    [ assoc-like ] curry bi@ ; inline
 
 : assoc-any? ( assoc quot -- ? )
     assoc-find 2nip ; inline

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 6147dcfbdc8a17c45f5bf00bad38b4a70383acc0..69a8f3347e055a2f3cea506a02dab2800d3f9761 100755 (executable)
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -251,9 +251,9 @@ M: tuple-class update-class
     3bi ;
 
 : tuple-class-unchanged? ( class superclass slots -- ? )
-    [ over ] dip
     [ [ superclass ] [ bootstrap-word ] bi* = ]
-    [ [ "slots" word-prop ] dip = ] 2bi* and ;
+    [ [ "slots" word-prop ] dip = ]
+    bi-curry* bi and ;
 
 : valid-superclass? ( class -- ? )
     [ tuple-class? ] [ tuple eq? ] bi or ;

diff --git a/core/continuations/continuations-tests.factor b/core/continuations/continuations-tests.factor
index 28658d67d779c62ffe47a3424735721f3db3b523..d5bd0da663b5b2e581657f0e632c914f5413583b 100644 (file)
--- a/core/continuations/continuations-tests.factor
+++ b/core/continuations/continuations-tests.factor
@@ -4,7 +4,7 @@ kernel.private accessors eval ;
 IN: continuations.tests
 
 : (callcc1-test)
-    swap 1- tuck swap ?push
+    [ 1- dup ] dip ?push
     over 0 = [ "test-cc" get continue-with ] when
     (callcc1-test) ;
 

diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor
index 66f2da7191515435d9d05fd7eac3d53b06209015..738c011a48586225161e8de283fb725a885cd41c 100644 (file)
--- a/core/generic/math/math.factor
+++ b/core/generic/math/math.factor
@@ -33,10 +33,11 @@ PREDICATE: math-class < class
 
 : math-upgrade ( class1 class2 -- quot )
     [ math-class-max ] 2keep
-    [ over ] dip (math-upgrade) [
+    [
         (math-upgrade)
         dup empty? [ [ dip ] curry [ ] like ] unless
-    ] dip append ;
+    ] [ (math-upgrade) ]
+    bi-curry* bi append ;
 
 ERROR: no-math-method left right generic ;
 

diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor
index 94d211547870bc76918336d5a5c48b1af54b5188..ab9d297d6cd8f926ef458a6b3c454149c700234f 100644 (file)
--- a/core/io/encodings/encodings.factor
+++ b/core/io/encodings/encodings.factor
@@ -74,7 +74,8 @@ M: decoder stream-read1
     } cond ; inline
 
 M: decoder stream-read
-    tuck >decoder< [ decode-char ] 2curry (read) finish-read fix-read ;
+    [ nip ] [ >decoder< [ decode-char ] 2curry (read) finish-read ] 2bi
+    fix-read ;
 
 M: decoder stream-read-partial stream-read ;
 

diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index b9bd7bfa42bb5995045cbd58f50d628dd8f33f4b..0432a5250cf12f20143ef8d061d9ffaff36db5e4 100644 (file)
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -184,6 +184,29 @@ GENERIC: boa ( ... class -- tuple )
 : prepose ( quot1 quot2 -- compose )
     swap compose ; inline
 
+! Curried cleavers
+<PRIVATE
+
+: schönfinkel ( quot -- quot' ) [ curry ] curry ; inline
+
+: bi-schönfinkel ( p q -- p' q' ) [ schönfinkel ] bi@ ; inline
+
+: tri-schönfinkel ( p q r -- p' q' r' ) [ schönfinkel ] tri@ ; inline
+
+PRIVATE>
+
+: bi-curry ( x p q -- p' q' ) bi-schönfinkel bi ; inline
+
+: tri-curry ( x p q r -- p' q' r' ) tri-schönfinkel tri ; inline
+
+: bi-curry* ( x y p q -- p' q' ) bi-schönfinkel bi* ; inline
+
+: tri-curry* ( x y z p q r -- p' q' r' ) tri-schönfinkel tri* ; inline
+
+: bi-curry@ ( x y q -- p' q' ) schönfinkel bi@ ; inline
+
+: tri-curry@ ( x y z q -- p' q' r' ) schönfinkel tri@ ; inline
+
 ! Booleans
 : not ( obj -- ? ) [ f ] [ t ] if ; inline
 

diff --git a/core/lexer/lexer.factor b/core/lexer/lexer.factor
index c36e6da19056d11ab1de53bc8821d8f690878532..75341f0204d9026d14518d1ce72b23320e6901d9 100644 (file)
--- a/core/lexer/lexer.factor
+++ b/core/lexer/lexer.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences accessors namespaces math words strings
 io vectors arrays math.parser combinators continuations ;
@@ -23,13 +23,11 @@ TUPLE: lexer text line line-text line-length column ;
     lexer new-lexer ;
 
 : skip ( i seq ? -- n )
-    [ tuck ] dip
-    [ swap CHAR: \s eq? xor ] curry find-from drop
-    [ ] [ length ] ?if ;
+    over length
+    [ [ swap CHAR: \s eq? xor ] curry find-from drop ] dip or ;
 
 : change-lexer-column ( lexer quot -- )
-    swap
-    [ [ column>> ] [ line-text>> ] bi rot call ] keep
+    [ [ column>> ] [ line-text>> ] bi ] prepose keep
     (>>column) ; inline
 
 GENERIC: skip-blank ( lexer -- )

diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor
index 6ed945216ecb23da817e59f4798181e3f3605c74..64ada4c052f38f806adce5872f3e6fada8a16705 100644 (file)
--- a/core/math/integers/integers.factor
+++ b/core/math/integers/integers.factor
@@ -93,7 +93,7 @@ M: bignum (log2) bignum-log2 ;
 
 : pre-scale ( num den -- scale shifted-num scaled-den )
     2dup [ log2 ] bi@ -
-    tuck [ neg 54 + shift ] [ [ scale-denonimator ] dip + ] 2bi*
+    [ neg 54 + shift ] [ [ scale-denonimator ] dip + ] bi-curry bi*
     -rot ; inline
 
 ! Second step: loop

diff --git a/core/math/math.factor b/core/math/math.factor
index 412fd325cc71f28dd447a32d4fcfa06f7cae4e92..322537b5516e2f0572751804c6f24c602979f396 100755 (executable)
--- a/core/math/math.factor
+++ b/core/math/math.factor
@@ -66,7 +66,7 @@ PRIVATE>
 
 : ?1+ ( x -- y ) [ 1+ ] [ 0 ] if* ; inline
 
-: rem ( x y -- z ) abs tuck mod over + swap mod ; foldable
+: rem ( x y -- z ) abs [ mod ] [ + ] [ mod ] tri ; foldable
 
 : 2^ ( n -- 2^n ) 1 swap shift ; inline
 

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 44f96a5c8f988e07df715ae694ff2a84df1950cb..f78b7a76f2346c301d5d8d0840e67e6c4e2985db 100755 (executable)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -128,8 +128,8 @@ INSTANCE: iota immutable-sequence
     [ first3-unsafe ] [ 3 swap nth-unsafe ] bi ; inline
 
 : exchange-unsafe ( m n seq -- )
-    [ tuck [ nth-unsafe ] 2bi@ ]
-    [ tuck [ set-nth-unsafe ] 2bi@ ] 3bi ; inline
+    [ [ nth-unsafe ] curry bi@ ]
+    [ [ set-nth-unsafe ] curry bi@ ] 3bi ; inline
 
 : (head) ( seq n -- from to seq ) [ 0 ] 2dip swap ; inline
 
@@ -205,7 +205,7 @@ TUPLE: slice
 { seq read-only } ;
 
 : collapse-slice ( m n slice -- m' n' seq )
-    [ from>> ] [ seq>> ] bi [ tuck [ + ] 2bi@ ] dip ; inline
+    [ from>> ] [ seq>> ] bi [ [ + ] curry bi@ ] dip ; inline
 
 ERROR: slice-error from to seq reason ;
 
@@ -357,7 +357,7 @@ PRIVATE>
     [ (each) ] dip collect ; inline
 
 : 2nth-unsafe ( n seq1 seq2 -- elt1 elt2 )
-    [ over ] dip [ nth-unsafe ] 2bi@ ; inline
+    [ nth-unsafe ] bi-curry@ bi ; inline
 
 : (2each) ( seq1 seq2 quot -- n quot' )
     [
@@ -366,12 +366,12 @@ PRIVATE>
     ] dip compose ; inline
 
 : 3nth-unsafe ( n seq1 seq2 seq3 -- elt1 elt2 elt3 )
-    [ over ] 2dip [ over ] dip [ nth-unsafe ] 2tri@ ; inline
+    [ nth-unsafe ] tri-curry@ tri ; inline
 
 : (3each) ( seq1 seq2 seq3 quot -- n quot' )
     [
-        [ [ length ] tri@ min min ] 3keep
-        [ 3nth-unsafe ] 3curry
+        [ [ length ] tri@ min min ]
+        [ [ 3nth-unsafe ] 3curry ] 3bi
     ] dip compose ; inline
 
 : finish-find ( i seq -- i elt )
@@ -470,7 +470,7 @@ PRIVATE>
     V{ } clone V{ } clone [ [ push-either ] 3curry ] 2keep ; inline
 
 : partition ( seq quot -- trueseq falseseq )
-    over [ 2pusher [ each ] 2dip ] dip tuck [ like ] 2bi@ ; inline
+    over [ 2pusher [ each ] 2dip ] dip [ like ] curry bi@ ; inline
 
 : accumulator ( quot -- quot' vec )
     V{ } clone [ [ push ] curry compose ] keep ; inline
@@ -653,8 +653,14 @@ PRIVATE>
 : delete-nth ( n seq -- )
     [ dup 1+ ] dip delete-slice ;
 
+: snip ( from to seq -- head tail )
+    [ swap head ] [ swap tail ] bi-curry bi* ; inline
+
+: snip-slice ( from to seq -- head tail )
+    [ swap head-slice ] [ swap tail-slice ] bi-curry bi* ; inline
+
 : replace-slice ( new from to seq -- seq' )
-    tuck [ swap head-slice ] [ swap tail-slice ] 2bi* surround ;
+    snip-slice surround ;
 
 : remove-nth ( n seq -- seq' )
     [ [ { } ] dip dup 1+ ] dip replace-slice ;
@@ -663,14 +669,14 @@ PRIVATE>
     [ length 1- ] [ [ nth ] [ shorten ] 2bi ] bi ;
 
 : exchange ( m n seq -- )
-    pick over bounds-check 2drop 2dup bounds-check 2drop
-    exchange-unsafe ;
+    [ nip bounds-check 2drop ]
+    [ bounds-check 3drop ]
+    [ exchange-unsafe ]
+    3tri ;
 
 : reverse-here ( seq -- )
-    dup length dup 2/ [
-        [ 2dup ] dip
-        tuck - 1- rot exchange-unsafe
-    ] each 2drop ;
+    [ length 2/ ] [ length ] [ ] tri
+    [ [ over - 1- ] dip exchange-unsafe ] 2curry each ;
 
 : reverse ( seq -- newseq )
     [
@@ -787,7 +793,7 @@ PRIVATE>
 
 : drop-prefix ( seq1 seq2 -- slice1 slice2 )
     2dup mismatch [ 2dup min-length ] unless*
-    tuck [ tail-slice ] 2bi@ ;
+    [ tail-slice ] curry bi@ ;
 
 : unclip ( seq -- rest first )
     [ rest ] [ first-unsafe ] bi ;

diff --git a/core/slots/slots-docs.factor b/core/slots/slots-docs.factor
index bdc5a5ba07adebfd917f4b0b4204376e277a5e86..840fe628e0a52dbba67707b277bb459a1ce467ac 100644 (file)
--- a/core/slots/slots-docs.factor
+++ b/core/slots/slots-docs.factor
@@ -42,11 +42,11 @@ $nl
     "    \"alice@bigcorp.com\" >>from"
     "send-email"
 }
-"This is because " { $link swap } " is easier to understand than " { $link tuck } ":"
+"The above has less shuffling than the writer version:"
 { $code
     "<email>"
-    "    tuck (>>subject)"
-    "    tuck (>>to)"
+    "    [ (>>subject) ] keep"
+    "    [ (>>to) ] keep"
     "    \"alice@bigcorp.com\" over (>>from)"
     "send-email"
 }

diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor
index 938bf17cd2f664f79b65bbc9ddc2cb01b34bef87..ef9ada95917f0a9efe7ebe5c406e9e666b31b9ca 100644 (file)
--- a/core/sorting/sorting.factor
+++ b/core/sorting/sorting.factor
@@ -137,9 +137,9 @@ TUPLE: merge
         [ drop nip nth ] dip push
     ] [
         [
-            [ tuck [ nth-unsafe ] 2bi@ 2dup ] dip call +gt+ eq?
+            [ [ nth-unsafe ] curry bi@ 2dup ] dip call +gt+ eq?
             [ swap ] when
-        ] dip tuck [ push ] 2bi@
+        ] dip [ push ] curry bi@
     ] if ; inline
 
 : sort-pairs ( merge quot -- )

diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor
index 7ecc967e9ee35a61c72a1fb9b66d39c91ee2aead..c8441ba3b0a2bf65605720ee4f50f0a66aa1d976 100644 (file)
--- a/core/source-files/source-files.factor
+++ b/core/source-files/source-files.factor
@@ -31,9 +31,8 @@ uses definitions ;
     source-files get [ nip xref-source ] assoc-each ;
 
 : record-form ( quot source-file -- )
-    tuck unxref-source
-    quot-uses keys >>uses
-    xref-source ;
+    [ quot-uses keys ] dip
+    [ unxref-source ] [ (>>uses) ] [ xref-source ] tri ;
 
 : record-definitions ( file -- )
     new-definitions get >>definitions drop ;

diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor
index e31a25b687f981d581afb76cfba310556db64611..50ddab4da577bd981c5a9b1a0228b995740fe218 100644 (file)
--- a/core/splitting/splitting.factor
+++ b/core/splitting/splitting.factor
@@ -4,35 +4,46 @@ USING: kernel math make strings arrays vectors sequences
 sets math.order accessors ;
 IN: splitting
 
+<PRIVATE
+
+: ?chomp ( seq begin tester chopper -- newseq ? )
+    [ [ 2dup ] dip call ] dip
+    [ [ length ] dip call t ] curry
+    [ drop f ] if ; inline
+
+PRIVATE>
+
 : ?head ( seq begin -- newseq ? )
-    2dup head? [ length tail t ] [ drop f ] if ;
+    [ head? ] [ tail ] ?chomp ;
 
 : ?head-slice ( seq begin -- newseq ? )
-    2dup head? [ length tail-slice t ] [ drop f ] if ;
+    [ head? ] [ tail-slice ] ?chomp ;
 
 : ?tail ( seq end -- newseq ? )
-    2dup tail? [ length head* t ] [ drop f ] if ;
+    [ tail? ] [ head* ] ?chomp ;
 
 : ?tail-slice ( seq end -- newseq ? )
-    2dup tail? [ length head-slice* t ] [ drop f ] if ;
+    [ tail? ] [ head-slice* ] ?chomp ;
+
+<PRIVATE
+
+: (split1) ( seq subseq quot -- before after )
+    [
+        swap [
+            [ drop length ] [ start dup ] 2bi
+            [ [ nip ] [ + ] 2bi t ]
+            [ 2drop f f f ]
+            if
+        ] keep swap
+    ] dip [ 2nip f ] if ; inline
 
-: (split1) ( seq subseq -- start end ? )
-    tuck swap start dup
-    [ swap [ drop ] [ length + ] 2bi t ]
-    [ 2drop f f f ]
-    if ;
+PRIVATE>
 
 : split1 ( seq subseq -- before after )
-    [ drop ] [ (split1) ] 2bi
-    [ [ over ] dip [ head ] [ tail ] 2bi* ]
-    [ 2drop f ]
-    if ;
+    [ snip ] (split1) ;
 
 : split1-slice ( seq subseq -- before-slice after-slice )
-    [ drop ] [ (split1) ] 2bi
-    [ [ over ] dip [ head-slice ] [ tail-slice ] 2bi* ]
-    [ 2drop f ]
-    if ;
+    [ snip-slice ] (split1) ;
 
 : split1-last ( seq subseq -- before after )
     [ <reversed> ] bi@ split1 [ reverse ] bi@
@@ -49,7 +60,8 @@ IN: splitting
 
 : split, ( seq separators -- ) 0 rot (split) ;
 
-: split ( seq separators -- pieces ) [ split, ] { } make ;
+: split ( seq separators -- pieces )
+    [ split, ] { } make ;
 
 : string-lines ( str -- seq )
     dup "\r\n" intersects? [

diff --git a/core/words/words.factor b/core/words/words.factor
index 3197d0a6f65ead9aa5fd8df7a5fbdc224b2bc5a8..cbaa7b964b657730a9fdc4b528c4a2c77a77fdd1 100755 (executable)
--- a/core/words/words.factor
+++ b/core/words/words.factor
@@ -109,10 +109,9 @@ compiled-generic-crossref global [ H{ } assoc-like ] change-at
 
 : compiled-xref ( word dependencies generic-dependencies -- )
     [ [ drop crossref? ] { } assoc-filter-as f like ] bi@
-    [ over ] dip
     [ "compiled-uses" compiled-crossref (compiled-xref) ]
     [ "compiled-generic-uses" compiled-generic-crossref (compiled-xref) ]
-    2bi* ;
+    bi-curry* bi ;
 
 : (compiled-unxref) ( word word-prop variable -- )
     [ [ [ dupd word-prop ] dip get remove-vertex* ] 2curry ]