remove non-primitive-related uses of tuck from basis

diff --git a/basis/core-text/core-text-tests.factor b/basis/core-text/core-text-tests.factor
index a5cf69fdee3e23b7fa5db1aec4b59ddd8db3fffa..b6b54df7c3b567865a3926ce0c6d2a7a0967adfa 100644 (file)
--- a/basis/core-text/core-text-tests.factor
+++ b/basis/core-text/core-text-tests.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tools.test core-text core-text.fonts core-foundation
 core-foundation.dictionaries destructors arrays kernel generalizations
-math accessors core-foundation.utilities combinators hashtables colors
+locals math accessors core-foundation.utilities combinators hashtables colors
 colors.constants ;
 IN: core-text.tests
 
@@ -18,10 +18,11 @@ IN: core-text.tests
     ] with-destructors
 ] unit-test
 
-: test-typographic-bounds ( string font -- ? )
+:: test-typographic-bounds ( string font -- ? )
     [
-        test-font &CFRelease tuck COLOR: white <CTLine> &CFRelease
-        compute-line-metrics {
+        font test-font &CFRelease :> ctfont
+        string ctfont COLOR: white <CTLine> &CFRelease :> ctline
+        ctfont ctline compute-line-metrics {
             [ width>> float? ]
             [ ascent>> float? ]
             [ descent>> float? ]
@@ -33,4 +34,4 @@ IN: core-text.tests
 
 [ t ] [ "Hello world" "Chicago" test-typographic-bounds ] unit-test
 
-[ t ] [ "日本語" "Helvetica" test-typographic-bounds ] unit-test
\ No newline at end of file
+[ t ] [ "日本語" "Helvetica" test-typographic-bounds ] unit-test

diff --git a/basis/csv/csv-tests.factor b/basis/csv/csv-tests.factor
index 6ba8e2d5b8a965b67767fc7400ce751aed0c3892..829637b4aa18b2e916ac4e6f9aed77d954ffdf4c 100644 (file)
--- a/basis/csv/csv-tests.factor
+++ b/basis/csv/csv-tests.factor
@@ -70,11 +70,12 @@ IN: csv.tests
 
 "can write csv too!"
 [ "foo1,bar1\nfoo2,bar2\n" ]
-[ { { "foo1" "bar1" } { "foo2" "bar2" } } <string-writer> tuck write-csv >string ] named-unit-test
+[ { { "foo1" "bar1" } { "foo2" "bar2" } } <string-writer> [ write-csv ] keep >string ] named-unit-test
+
 
 "escapes quotes commas and newlines when writing"
 [ "\"fo\"\"o1\",bar1\n\"fo\no2\",\"b,ar2\"\n" ]
-[ { { "fo\"o1" "bar1" } { "fo\no2" "b,ar2" } } <string-writer> tuck write-csv >string ] named-unit-test ! "
+[ { { "fo\"o1" "bar1" } { "fo\no2" "b,ar2" } } <string-writer> [ write-csv ] keep >string ] named-unit-test ! "
 
 [ { { "writing" "some" "csv" "tests" } } ]
 [

diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor
index ffcbec70d08340f8b0456c71034c2aa61a207660..8d26d3b098c185a2fdcb5bf016c865dcd6a81bf4 100755 (executable)
--- a/basis/db/sqlite/sqlite.factor
+++ b/basis/db/sqlite/sqlite.factor
@@ -4,7 +4,7 @@ USING: alien arrays assocs classes compiler db hashtables
 io.files kernel math math.parser namespaces prettyprint fry
 sequences strings classes.tuple alien.c-types continuations
 db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators
-math.intervals io nmake accessors vectors math.ranges random
+math.intervals io locals nmake accessors vectors math.ranges random
 math.bitwise db.queries destructors db.tuples.private interpolate
 io.streams.string make db.private sequences.deep
 db.errors.sqlite ;
@@ -85,12 +85,11 @@ M: literal-bind sqlite-bind-conversion ( tuple literal-bind -- array )
     nip [ key>> ] [ value>> ] [ type>> ] tri
     <sqlite-low-level-binding> ;
 
-M: generator-bind sqlite-bind-conversion ( tuple generate-bind -- array )
-    tuck
-    [ generator-singleton>> eval-generator tuck ] [ slot-name>> ] bi
-    rot set-slot-named
-    [ [ key>> ] [ type>> ] bi ] dip
-    swap <sqlite-low-level-binding> ;
+M:: generator-bind sqlite-bind-conversion ( tuple generate-bind -- array )
+    generate-bind generator-singleton>> eval-generator :> obj
+    generate-bind slot-name>> :> name
+    obj name tuple set-slot-named
+    generate-bind key>> obj generate-bind type>> <sqlite-low-level-binding> ;
 
 M: sqlite-statement bind-tuple ( tuple statement -- )
     [

diff --git a/basis/fry/fry-docs.factor b/basis/fry/fry-docs.factor
index 9602933785d60492af2ff4ac419145f4a178c01f..3401208858ad242d542936b79ee7127e21e5d398 100644 (file)
--- a/basis/fry/fry-docs.factor
+++ b/basis/fry/fry-docs.factor
@@ -59,7 +59,6 @@ $nl
     { { $link literalize } { $snippet ": literalize '[ _ ] ;" } }\r
     { { $link curry } { $snippet ": curry '[ _ @ ] ;" } }\r
     { { $link compose } { $snippet ": compose '[ @ @ ] ;" } }\r
-    { { $link bi@ } { $snippet ": bi@ tuck '[ _ @ _ @ ] call ;" } }\r
 } ;\r
 \r
 ARTICLE: "fry.philosophy" "Fried quotation philosophy"\r

diff --git a/basis/game/input/input.factor b/basis/game/input/input.factor
index 377a89a884b78557e64e9f606a142a51c9f2781d..954602cf0671e95894b41087d782877dd75eade1 100755 (executable)
--- a/basis/game/input/input.factor
+++ b/basis/game/input/input.factor
@@ -75,9 +75,8 @@ SYMBOLS:
     get-controllers [ product-id = ] with filter ;
 : find-controller-instance ( product-id instance-id -- controller/f )
     get-controllers [
-        tuck
         [ product-id  = ]
-        [ instance-id = ] 2bi* and
+        [ instance-id = ] bi-curry bi* and
     ] with with find nip ;
 
 TUPLE: keyboard-state keys ;

diff --git a/basis/images/jpeg/jpeg.factor b/basis/images/jpeg/jpeg.factor
index e8af7144ad2cb24ee2cb10a96eecea515ae08d8b..e305c8477a18f63f2f3a80a0202d4a09018a48f7 100644 (file)
--- a/basis/images/jpeg/jpeg.factor
+++ b/basis/images/jpeg/jpeg.factor
@@ -295,7 +295,7 @@ MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ;
     binary [
         [
             { HEX: FF } read-until
-            read1 tuck HEX: 00 = and
+            read1 [ HEX: 00 = and ] keep swap
         ]
         [ drop ] produce
         swap >marker {  EOI } assert=

diff --git a/basis/io/buffers/buffers-tests.factor b/basis/io/buffers/buffers-tests.factor
index d366df7c54ff33aa97b696ff0796eec9ce3740dd..93d2f5b2fc60ce3a1107c4b97918f9296a7660b4 100644 (file)
--- a/basis/io/buffers/buffers-tests.factor
+++ b/basis/io/buffers/buffers-tests.factor
@@ -8,7 +8,7 @@ strings accessors destructors ;
     [ length ] dip buffer-reset ;
 
 : string>buffer ( string -- buffer )
-    dup length <buffer> tuck buffer-set ;
+    dup length <buffer> [ buffer-set ] keep ;
 
 : buffer-read-all ( buffer -- byte-array )
     [ [ pos>> ] [ ptr>> ] bi <displaced-alien> ]

diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor
index 5ae21fcfee111898ae48b66d7ddfefb177dcf998..6bd3f77ffa68df512713bb51b07a0513a2186b91 100755 (executable)
--- a/basis/io/files/info/windows/windows.factor
+++ b/basis/io/files/info/windows/windows.factor
@@ -151,12 +151,16 @@ PRIVATE>
 M: winnt file-system-info ( path -- file-system-info )
     normalize-path root-directory (file-system-info) ;
 
-: volume>paths ( string -- array )
-    16384 <ushort-array> tuck dup length
-    0 <uint> dup [ GetVolumePathNamesForVolumeName 0 = ] dip swap [
-        win32-error-string throw
+:: volume>paths ( string -- array )
+    16384 :> names-buf-length
+    names-buf-length <ushort-array> :> names
+    0 <uint> :> names-length
+
+    string names names-buf-length names-length GetVolumePathNamesForVolumeName :> ret
+    ret 0 = [
+        ret win32-error-string throw
     ] [
-        *uint "ushort" heap-size * head
+        names names-length *uint "ushort" heap-size * head
         utf16n alien>string CHAR: \0 split
     ] if ;
 
@@ -166,13 +170,16 @@ M: winnt file-system-info ( path -- file-system-info )
     FindFirstVolume dup win32-error=0/f
     [ utf16n alien>string ] dip ;
 
-: find-next-volume ( handle -- string/f )
-    MAX_PATH 1 + [ <ushort-array> tuck ] keep
-    FindNextVolume 0 = [
+:: find-next-volume ( handle -- string/f )
+    MAX_PATH 1 + :> buf-length
+    buf-length <ushort-array> :> buf
+
+    handle buf buf-length FindNextVolume :> ret
+    ret 0 = [
         GetLastError ERROR_NO_MORE_FILES =
         [ drop f ] [ win32-error-string throw ] if
     ] [
-        utf16n alien>string
+        buf utf16n alien>string
     ] if ;
 
 : find-volumes ( -- array )

diff --git a/basis/io/launcher/windows/windows.factor b/basis/io/launcher/windows/windows.factor
index 6cae50bd9e107272d7369eb45480f1ceaa2bcf0d..8a800115f6421e607744c40514d3ca99f52c036a 100755 (executable)
--- a/basis/io/launcher/windows/windows.factor
+++ b/basis/io/launcher/windows/windows.factor
@@ -132,7 +132,7 @@ M: windows run-process* ( process -- handle )
         current-directory get absolute-path cd
 
         dup make-CreateProcess-args
-        tuck fill-redirection
+        [ fill-redirection ] keep
         dup call-CreateProcess
         lpProcessInformation>>
     ] with-destructors ;

diff --git a/basis/lists/lazy/lazy.factor b/basis/lists/lazy/lazy.factor
index 7b386e9c819ea1acfc93988b97227fcfb8666355..57cacaa4945c6d83bf56bf317c65ab236ec51ab7 100644 (file)
--- a/basis/lists/lazy/lazy.factor
+++ b/basis/lists/lazy/lazy.factor
@@ -114,7 +114,7 @@ M: lazy-until car ( lazy-until -- car )
      cons>> car ;
 
 M: lazy-until cdr ( lazy-until -- cdr )
-     [ cons>> unswons ] keep quot>> tuck call( elt -- ? )
+     [ quot>> ] [ cons>> unswons ] bi over call( elt -- ? )
      [ 2drop nil ] [ luntil ] if ;
 
 M: lazy-until nil? ( lazy-until -- ? )

diff --git a/basis/math/combinatorics/combinatorics.factor b/basis/math/combinatorics/combinatorics.factor
index bc09f9fe0fa9b609147c751e7eb01a8e05fba3bc..5c03e4187079a3712a9e821cd50048905dba94c8 100644 (file)
--- a/basis/math/combinatorics/combinatorics.factor
+++ b/basis/math/combinatorics/combinatorics.factor
@@ -96,9 +96,9 @@ C: <combo> combo
     initial-values [ over 0 > ] [ next-values ] produce
     [ 3drop ] dip ;
 
-: combination-indices ( m combo -- seq )
-    [ tuck dual-index combinadic ] keep
-    seq>> length 1 - swap [ - ] with map ;
+:: combination-indices ( m combo -- seq )
+    combo m combo dual-index combinadic
+    combo seq>> length 1 - swap [ - ] with map ;
 
 : apply-combination ( m combo -- seq )
     [ combination-indices ] keep seq>> nths ;

diff --git a/basis/math/intervals/intervals-tests.factor b/basis/math/intervals/intervals-tests.factor
index 1ee4e1e100f6c7285edb9a7f2ace547bdd95c0af..a569b4af7bb39b852c752d83c85d5c83f48466b0 100644 (file)
--- a/basis/math/intervals/intervals-tests.factor
+++ b/basis/math/intervals/intervals-tests.factor
@@ -79,7 +79,7 @@ IN: math.intervals.tests
 
 [ t ] [ 1 2 [a,b] dup empty-interval interval-union = ] unit-test
 
-[ t ] [ empty-interval 1 2 [a,b] tuck interval-union = ] unit-test
+[ t ] [ 1 2 [a,b] empty-interval over interval-union = ] unit-test
 
 [ t ] [
     0 1 (a,b) 0 1 [a,b] interval-union 0 1 [a,b] =
@@ -250,7 +250,7 @@ IN: math.intervals.tests
     dup full-interval eq? [
         drop 32 random-bits 31 2^ -
     ] [
-        dup to>> first over from>> first tuck - random +
+        [ ] [ from>> first ] [ to>> first ] tri over - random +
         2dup swap interval-contains? [
             nip
         ] [

diff --git a/basis/persistent/vectors/vectors.factor b/basis/persistent/vectors/vectors.factor
index 2527959f325f0317cd6540a0c3ab2a625e45f2fe..b02604e9bd8ca02f856a2cd27d1d8c7697cef08a 100644 (file)
--- a/basis/persistent/vectors/vectors.factor
+++ b/basis/persistent/vectors/vectors.factor
@@ -58,7 +58,7 @@ M: persistent-vector nth-unsafe
     [ 2array ] [ drop level>> 1 + ] 2bi node boa ;
 
 : new-child ( new-child node -- node' expansion/f )
-    dup full? [ tuck level>> 1node ] [ node-add f ] if ;
+    dup full? [ [ level>> 1node ] keep swap ] [ node-add f ] if ;
 
 : new-last ( val seq -- seq' )
     [ length 1 - ] keep new-nth ;
@@ -70,7 +70,7 @@ M: persistent-vector nth-unsafe
     dup level>> 1 = [
         new-child
     ] [
-        tuck children>> last (ppush-new-tail)
+        [ nip ] 2keep children>> last (ppush-new-tail)
         [ swap new-child ] [ swap node-set-last f ] ?if
     ] if ;
 

diff --git a/basis/regexp/dfa/dfa.factor b/basis/regexp/dfa/dfa.factor
index 2de4e8b0e02322d7a3391c86f607944d18125ace..fa75232fd5c0b7472da6c765b6bca3b60a43aa8b 100644 (file)
--- a/basis/regexp/dfa/dfa.factor
+++ b/basis/regexp/dfa/dfa.factor
@@ -25,7 +25,7 @@ IN: regexp.dfa
     ] unless ;
 
 : epsilon-table ( states nfa -- table )
-    [ H{ } clone tuck ] dip
+    [ [ H{ } clone ] dip over ] dip
     '[ _ _ t epsilon-loop ] each ;
 
 : find-epsilon-closure ( states nfa -- dfa-state )

diff --git a/basis/regexp/minimize/minimize.factor b/basis/regexp/minimize/minimize.factor
index 1885144e6ccb45937d7aa3d8174fa37aa5870ff5..a6eb4f00a288dbf752ccd8a1d2fd74aa9b441321 100644 (file)
--- a/basis/regexp/minimize/minimize.factor
+++ b/basis/regexp/minimize/minimize.factor
@@ -85,7 +85,7 @@ IN: regexp.minimize
     '[ _ delete-duplicates ] change-transitions ;
 
 : combine-state-transitions ( hash -- hash )
-    H{ } clone tuck '[
+    [ H{ } clone ] dip over '[
         _ [ 2array <or-class> ] change-at
     ] assoc-each [ swap ] assoc-map ;
 

diff --git a/basis/suffix-arrays/suffix-arrays.factor b/basis/suffix-arrays/suffix-arrays.factor
index 931cb36ea949b8c394164e3e85d9bbdaa34b09bb..f486adcb32e27f882289eb4a6b4b567c41706126 100755 (executable)
--- a/basis/suffix-arrays/suffix-arrays.factor
+++ b/basis/suffix-arrays/suffix-arrays.factor
@@ -22,8 +22,7 @@ IN: suffix-arrays
 
 : <funky-slice> ( from/f to/f seq -- slice )
     [
-        tuck
-        [ drop 0 or ] [ length or ] 2bi*
+        [ drop 0 or ] [ length or ] bi-curry bi*
         [ min ] keep
     ] keep <slice> ; inline
 

diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor
index 089bad3158ba44dde8506b8b11a2956039421bd1..936d388b0126095ecfc58e72ec32cdfd4b997648 100755 (executable)
--- a/basis/tools/scaffold/scaffold.factor
+++ b/basis/tools/scaffold/scaffold.factor
@@ -98,7 +98,7 @@ M: bad-developer-name summary
     [ main-file-string ] dip utf8 set-file-contents ;
 
 : scaffold-main ( vocab-root vocab -- )
-    tuck ".factor" vocab-root/vocab/suffix>path scaffolding? [
+    [ ".factor" vocab-root/vocab/suffix>path ] keep swap scaffolding? [
         set-scaffold-main-file
     ] [
         2drop

diff --git a/basis/ui/traverse/traverse.factor b/basis/ui/traverse/traverse.factor
index 11c2a48a2a5408900b03b538f9390eae9f4a36bb..5a92a4cea211c4d711cd7ad7f46b3ec4d8743f97 100644 (file)
--- a/basis/ui/traverse/traverse.factor
+++ b/basis/ui/traverse/traverse.factor
@@ -20,8 +20,9 @@ TUPLE: node value children ;
         ] [
             [
                 [ children>> swap first head-slice % ]
-                [ tuck traverse-step traverse-to-path ]
-                2bi
+                [ nip ]
+                [ traverse-step traverse-to-path ]
+                2tri
             ] make-node
         ] if
     ] if ;
@@ -35,7 +36,9 @@ TUPLE: node value children ;
         ] [
             [
                 [ traverse-step traverse-from-path ]
-                [ tuck children>> swap first 1 + tail-slice % ] 2bi
+                [ nip ]
+                [ children>> swap first 1 + tail-slice % ]
+                2tri
             ] make-node
         ] if
     ] if ;

diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor
index c4392c4c6da9ec3fb009c9d995fb4b58c992940a..02d9f370236d4d0135da2c688af99ebbdbd8e0d4 100644 (file)
--- a/basis/unix/groups/groups.factor
+++ b/basis/unix/groups/groups.factor
@@ -23,7 +23,7 @@ GENERIC: group-struct ( obj -- group/f )
     gr_mem>> utf8 alien>strings ;
 
 : (group-struct) ( id -- group-struct id group-struct byte-array length void* )
-    \ unix:group <struct> tuck 4096
+    [ \ unix:group <struct> ] dip over 4096
     [ <byte-array> ] keep f <void*> ;
 
 : check-group-struct ( group-struct ptr -- group-struct/f )

diff --git a/basis/xmode/catalog/catalog.factor b/basis/xmode/catalog/catalog.factor
index 97de95a932d8ded288a696cb4524e8c315b45f37..40b8e2191c1173a329ff4d9cd9e011b5f4e2dc1a 100644 (file)
--- a/basis/xmode/catalog/catalog.factor
+++ b/basis/xmode/catalog/catalog.factor
@@ -110,7 +110,7 @@ ERROR: mutually-recursive-rulesets ruleset ;
     dup [ glob-matches? ] [ 2drop f ] if ;
 
 : suitable-mode? ( file-name first-line mode -- ? )
-    tuck first-line-glob>> ?glob-matches
+    [ nip ] 2keep first-line-glob>> ?glob-matches
     [ 2drop t ] [ file-name-glob>> ?glob-matches ] if ;
 
 : find-mode ( file-name first-line -- mode )

diff --git a/basis/xmode/marker/marker.factor b/basis/xmode/marker/marker.factor
index d3a4f1e9a22a17c99af1bc999e4a4a159a53bdac..6b8db76ac97e88186280949eb8c9855a38563851 100755 (executable)
--- a/basis/xmode/marker/marker.factor
+++ b/basis/xmode/marker/marker.factor
@@ -86,7 +86,7 @@ M: regexp text-matches?
     [ >string ] dip first-match dup [ to>> ] when ;
 
 : rule-start-matches? ( rule -- match-count/f )
-    dup start>> tuck swap can-match-here? [
+    [ start>> dup ] keep can-match-here? [
         rest-of-line swap text>> text-matches?
     ] [
         drop f
@@ -96,7 +96,7 @@ M: regexp text-matches?
     dup mark-following-rule? [
         dup start>> swap can-match-here? 0 and
     ] [
-        dup end>> tuck swap can-match-here? [
+        [ end>> dup ] keep can-match-here? [
             rest-of-line
             swap text>> context get end>> or
             text-matches?
@@ -170,7 +170,7 @@ M: seq-rule handle-rule-start
     ?end-rule
     mark-token
     add-remaining-token
-    tuck body-token>> next-token,
+    [ body-token>> next-token, ] keep
     delegate>> [ push-context ] when* ;
 
 UNION: abstract-span-rule span-rule eol-span-rule ;
@@ -179,7 +179,7 @@ M: abstract-span-rule handle-rule-start
     ?end-rule
     mark-token
     add-remaining-token
-    tuck rule-match-token* next-token,
+    [ rule-match-token* next-token, ] keep
     ! ... end subst ...
     dup context get (>>in-rule)
     delegate>> push-context ;
@@ -190,7 +190,7 @@ M: span-rule handle-rule-end
 M: mark-following-rule handle-rule-start
     ?end-rule
     mark-token add-remaining-token
-    tuck rule-match-token* next-token,
+    [ rule-match-token* next-token, ] keep
     f context get (>>end)
     context get (>>in-rule) ;
 

diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index f70d9d42145ae9659c636faf7b548d40873f02b3..7327285ffd0bb79b5483bf964f412ffccb0682ba 100644 (file)
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -21,7 +21,6 @@ HELP: 2over                          $shuffle ;
 HELP: pick  ( x y z -- x y z x )     $shuffle ;
 HELP: swap  ( x y -- y x )           $shuffle ;
 
-HELP: spin                     $complex-shuffle ;
 HELP: rot   ( x y z -- y z x ) $complex-shuffle ;
 HELP: -rot  ( x y z -- z x y ) $complex-shuffle ;
 HELP: dupd  ( x y -- x x y )   $complex-shuffle ;
@@ -828,7 +827,6 @@ $nl
     swapd
     rot
     -rot
-    spin
 } ;
 
 ARTICLE: "shuffle-words" "Shuffle words"