Move replicate into core; move selection sort into its own vocab; remove usages of...

diff --git a/core/bit-arrays/bit-arrays-tests.factor b/core/bit-arrays/bit-arrays-tests.factor
index 03961c2db6678180f9ab793bd627500c89121aba..b41cf9c4a5e81fc248ac45114a6f8a0736bd0018 100755 (executable)
--- a/core/bit-arrays/bit-arrays-tests.factor
+++ b/core/bit-arrays/bit-arrays-tests.factor
@@ -38,7 +38,7 @@ IN: bit-arrays.tests
 
 [ t ] [
     100 [
-        drop 100 [ drop 2 random zero? ] map
+        drop 100 [ 2 random zero? ] replicate
         dup >bit-array >array =
     ] all?
 ] unit-test

diff --git a/core/classes/algebra/algebra-tests.factor b/core/classes/algebra/algebra-tests.factor
index 28e899d08ba89c0188b152e3d691d6a1d9b7d2f3..05c254f225cb6a93279f8066b0afe53a04a3654b 100755 (executable)
--- a/core/classes/algebra/algebra-tests.factor
+++ b/core/classes/algebra/algebra-tests.factor
@@ -204,7 +204,7 @@ UNION: z1 b1 c1 ;
 \r
 10 [\r
     [ ] [\r
-        20 [ drop random-op ] map >quotation\r
+        20 [ random-op ] [ ] replicate-as\r
         [ infer effect-in [ random-class ] times ] keep\r
         call\r
         drop\r
@@ -238,8 +238,8 @@ UNION: z1 b1 c1 ;
 \r
 20 [\r
     [ t ] [\r
-        20 [ drop random-boolean-op ] [ ] map-as dup .\r
-        [ infer effect-in [ drop random-boolean ] map dup . ] keep\r
+        20 [ random-boolean-op ] [ ] replicate-as dup .\r
+        [ infer effect-in [ random-boolean ] replicate dup . ] keep\r
         \r
         [ >r [ ] each r> call ] 2keep\r
         \r

diff --git a/core/inference/backend/backend.factor b/core/inference/backend/backend.factor
index 8966a38496c6cf3531706ecc4926179343bf2c88..f8b071e803c92af7105a1739c3da233616d2fa38 100755 (executable)
--- a/core/inference/backend/backend.factor
+++ b/core/inference/backend/backend.factor
@@ -80,7 +80,7 @@ M: object value-literal \ literal-expected inference-warning ;
     1 #drop node,
     pop-d dup value-literal >r value-recursion r> ;
 
-: value-vector ( n -- vector ) [ drop <computed> ] V{ } map-as ;
+: value-vector ( n -- vector ) [ <computed> ] V{ } replicate-as ;
 
 : add-inputs ( seq stack -- n stack )
     tuck [ length ] bi@ - dup 0 >
@@ -162,7 +162,7 @@ TUPLE: too-many-r> ;
     dup ensure-values
     #>r
     over 0 pick node-inputs
-    over [ drop pop-d ] map reverse [ push-r ] each
+    over [ pop-d ] replicate reverse [ push-r ] each
     0 pick pick node-outputs
     node,
     drop ;
@@ -171,7 +171,7 @@ TUPLE: too-many-r> ;
     dup check-r>
     #r>
     0 pick pick node-inputs
-    over [ drop pop-r ] map reverse [ push-d ] each
+    over [ pop-r ] replicate reverse [ push-d ] each
     over 0 pick node-outputs
     node,
     drop ;

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 4854ff8001ed88b18cc1006ea77500f9f833cd72..cb3355269309443d74fd316a24dcaf4344d66d8f 100755 (executable)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -361,6 +361,12 @@ PRIVATE>
 : map ( seq quot -- newseq )
     over map-as ; inline
 
+: replicate ( seq quot -- newseq )
+    [ drop ] prepose map ; inline
+
+: replicate-as ( seq quot exemplar -- newseq )
+    >r [ drop ] prepose r> map-as ; inline
+
 : change-each ( seq quot -- )
     over map-into ; inline
 

diff --git a/core/sorting/sorting-tests.factor b/core/sorting/sorting-tests.factor
index a56c41b620193d9a2f3fc8d3499075da5d817888..17ec2d7cd15260ba1e482486a9ba31094afc2cf6 100755 (executable)
--- a/core/sorting/sorting-tests.factor
+++ b/core/sorting/sorting-tests.factor
@@ -11,7 +11,7 @@ unit-test
 [ t ] [
     100 [
         drop
-        100 [ drop 20 random [ drop 1000 random ] map ] map natural-sort [ before=? ] monotonic?
+        100 [ 20 random [ 1000 random ] replicate ] replicate natural-sort [ before=? ] monotonic?
     ] all?
 ] unit-test
 

diff --git a/core/strings/strings-tests.factor b/core/strings/strings-tests.factor
index 44e1d8859ffb4f204eb26531b6012e1711307be6..d10f1603f10ed1b2737b656ed8cd1270522a00ca 100755 (executable)
--- a/core/strings/strings-tests.factor
+++ b/core/strings/strings-tests.factor
@@ -98,7 +98,7 @@ unit-test
 [ ] [
     [
         4 [
-            100 [ drop "obdurak" clone ] map
+            100 [ "obdurak" clone ] replicate
             gc
             dup [
                 1234 0 rot set-string-nth

diff --git a/core/vectors/vectors-tests.factor b/core/vectors/vectors-tests.factor
index 8f642657712b93200a29ac53d1e948960564999c..7f4abe3222e2b0562dc79654b6bc4a0a82365f22 100755 (executable)
--- a/core/vectors/vectors-tests.factor
+++ b/core/vectors/vectors-tests.factor
@@ -26,7 +26,7 @@ IN: vectors.tests
 [ V{ 1 2 } ] [ [ 1 2 ] >vector ] unit-test
 
 [ t ] [
-    100 [ drop 100 random ] map >vector
+    100 [ 100 random ] V{ } map-as
     dup >array >vector =
 ] unit-test
 

diff --git a/extra/color-picker/color-picker.factor b/extra/color-picker/color-picker.factor
index 0480235dfee43c35e9655e1cccdaf83ce2ec207f..c64d1e48721ab5027ae6474a7c2314b823fa6f77 100755 (executable)
--- a/extra/color-picker/color-picker.factor
+++ b/extra/color-picker/color-picker.factor
@@ -24,7 +24,7 @@ M: color-preview model-changed
     [ [ 256 /f ] map 1 suffix <solid> ] <filter> ;
 
 : <color-sliders> ( -- model gadget )
-    3 [ drop 0 0 0 255 <range> ] map
+    3 [ 0 0 0 255 <range> ] replicate
     dup [ range-model ] map <compose>
     swap [ [ <color-slider> gadget, ] each ] make-filled-pile ;
 

diff --git a/extra/delegate/delegate.factor b/extra/delegate/delegate.factor
index c375dcf874bc4382150573ffb27eb1eb8e02a902..4f1e950b01352bc53194725381f2483d1bea452d 100755 (executable)
--- a/extra/delegate/delegate.factor
+++ b/extra/delegate/delegate.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2007 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
 USING: parser generic kernel classes words slots assocs
-sequences arrays vectors definitions prettyprint combinators.lib
-math hashtables sets ;
+sequences arrays vectors definitions prettyprint
+math hashtables sets macros namespaces ;
 IN: delegate
 
 : protocol-words ( protocol -- words )
@@ -23,7 +23,15 @@ M: tuple-class group-words
 
 : consult-method ( word class quot -- )
     [ drop swap first create-method ]
-    [ nip swap first2 swapd [ ndip ] 2curry swap suffix ] 3bi
+    [
+        nip
+        [
+            over second saver %
+            %
+            dup second restorer %
+            first ,
+        ] [ ] make
+    ] 3bi
     define ;
 
 : change-word-prop ( word prop quot -- )

diff --git a/extra/io/files/unique/unique.factor b/extra/io/files/unique/unique.factor
index 06a3ec8dd2fe22161e91090dbae65c78fddc1dd7..3efef66ae33cb6cb0c9941e06fdb2f94d27b24f6 100644 (file)
--- a/extra/io/files/unique/unique.factor
+++ b/extra/io/files/unique/unique.factor
@@ -15,7 +15,7 @@ IN: io.files.unique
     [ 10 random CHAR: 0 + ] [ random-letter ] if ;
 
 : random-name ( n -- string )
-    [ drop random-ch ] "" map-as ;
+    [ random-ch ] "" replicate-as ;
 
 : unique-length ( -- n ) 10 ; inline
 : unique-retries ( -- n ) 10 ; inline

diff --git a/extra/io/pipes/pipes.factor b/extra/io/pipes/pipes.factor
index b519752e799847fc24eac58bca8a8e4bff843aba..72beb473ed3cfbed61ce7ce0a218532ce292d9e6 100644 (file)
--- a/extra/io/pipes/pipes.factor
+++ b/extra/io/pipes/pipes.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.encodings io.backend io.ports io.streams.duplex
-io splitting grouping sequences sequences.lib namespaces kernel
+io splitting grouping sequences namespaces kernel
 destructors math concurrency.combinators accessors
 arrays continuations quotations ;
 IN: io.pipes

diff --git a/extra/koszul/koszul.factor b/extra/koszul/koszul.factor
index 7b636609b0301173b1e16d20c47d62d234164c95..b56473a0a97780049d646cf3571bb27997df4952 100755 (executable)
--- a/extra/koszul/koszul.factor
+++ b/extra/koszul/koszul.factor
@@ -142,7 +142,7 @@ DEFER: (d)
 
 ! Computing a basis
 : graded ( seq -- seq )
-    dup 0 [ length max ] reduce 1+ [ drop V{ } clone ] map
+    dup 0 [ length max ] reduce 1+ [ V{ } clone ] replicate
     [ dup length pick nth push ] reduce ;
 
 : nth-basis-elt ( generators n -- elt )

diff --git a/extra/lcs/lcs-tests.factor b/extra/lcs/lcs-tests.factor
index 3aa10a0687493ff9ca9f883a716eb34f74ca998b..7d9a9ffd2764f4bf795a9cd0a5cf5d7e4a53666c 100755 (executable)
--- a/extra/lcs/lcs-tests.factor
+++ b/extra/lcs/lcs-tests.factor
@@ -2,6 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tools.test lcs ;
 
+\ lcs must-infer
+\ diff must-infer
+\ levenshtein must-infer
+
 [ 3 ] [ "sitting" "kitten" levenshtein ] unit-test
 [ 3 ] [ "kitten" "sitting" levenshtein ] unit-test
 [ 1 ] [ "freshpak" "freshpack" levenshtein ] unit-test

diff --git a/extra/lcs/lcs.factor b/extra/lcs/lcs.factor
index 06c33505ca1a9b9eb7c65d082fe791ed5388e9cb..4b0fb53f5ec597113e6fb726983e4a91fb251d4b 100755 (executable)
--- a/extra/lcs/lcs.factor
+++ b/extra/lcs/lcs.factor
@@ -63,15 +63,19 @@ TUPLE: trace-state old new table i j ;
     [ 1- ] change-i [ 1- ] change-j ;\r
 \r
 : inserted? ( state -- ? )\r
-    [ j>> 0 > ]\r
-    [ [ i>> zero? ] [ top-beats-side? ] or? ] and? ;\r
+    {\r
+        [ j>> 0 > ]\r
+        [ { [ i>> zero? ] [ top-beats-side? ] } 1|| ]\r
+    } 1&& ;\r
 \r
 : do-insert ( state -- state )\r
     dup new-nth insert boa , [ 1- ] change-j ;\r
 \r
 : deleted? ( state -- ? )\r
-    [ i>> 0 > ]\r
-    [ [ j>> zero? ] [ top-beats-side? not ] or? ] and? ;\r
+    {\r
+        [ i>> 0 > ]\r
+        [ { [ j>> zero? ] [ top-beats-side? not ] } 1|| ]\r
+    } 1&& ;\r
 \r
 : do-delete ( state -- state )\r
     dup old-nth delete boa , [ 1- ] change-i ;\r

diff --git a/extra/project-euler/150/150.factor b/extra/project-euler/150/150.factor
index 8c93d4f7e638d3e79670f9c2335aff6e975a2a76..49de5dbc0304f270439ebde6a33fa45521b9333d 100644 (file)
--- a/extra/project-euler/150/150.factor
+++ b/extra/project-euler/150/150.factor
@@ -17,9 +17,6 @@ IN: project-euler.150
 : partial-sum-infimum ( seq -- seq )
     0 0 rot [ (partial-sum-infimum) ] each drop ; inline
 
-: generate ( n quot -- seq )
-    [ drop ] prepose map ; inline
-
 : map-infimum ( seq quot -- min )
     [ min ] compose 0 swap reduce ; inline
 
@@ -30,7 +27,7 @@ IN: project-euler.150
     615949 * 797807 + 20 2^ rem dup 19 2^ - ; inline
 
 : sums-triangle ( -- seq )
-    0 1000 [ 1+ [ next ] generate partial-sums ] map nip ; 
+    0 1000 [ 1+ [ next ] replicate partial-sums ] map nip ; 
 
 PRIVATE>
 

diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor
index 265cd5b59220b170023ca6298f13200a5f52dfeb..ed4c337a9219eca9dd033bd2242f9b9cde08b0c7 100755 (executable)
--- a/extra/sequences/lib/lib.factor
+++ b/extra/sequences/lib/lib.factor
@@ -131,10 +131,6 @@ MACRO: firstn ( n -- )
     [ find drop [ head-slice ] when* ] curry
     [ dup ] prepose keep like ;
 
-: replicate ( seq quot -- newseq )
-    #! quot: ( -- obj )
-    [ drop ] prepose map ; inline
-
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 <PRIVATE
@@ -244,20 +240,6 @@ PRIVATE>
 : short ( seq n -- seq n' )
     over length min ; inline
 
-<PRIVATE
-:: insert ( seq quot n -- )
-    n zero? [
-        n n 1- [ seq nth quot call ] bi@ >= [
-            n n 1- seq exchange
-            seq quot n 1- insert
-        ] unless
-    ] unless ; inline
-PRIVATE>
-
-: insertion-sort ( seq quot -- )
-    ! quot is a transformation on elements
-    over length [ insert ] 2with each ; inline
-
 : if-seq ( seq quot1 quot2 -- )
     [ f like ] 2dip if* ; inline
 

diff --git a/extra/sorting/insertion/authors.txt b/extra/sorting/insertion/authors.txt
new file mode 100644 (file)
index 0000000..f990dd0
--- /dev/null
+++ b/extra/sorting/insertion/authors.txt
@@ -0,0 +1 @@
+Daniel Ehrenberg

diff --git a/extra/sorting/insertion/insertion.factor b/extra/sorting/insertion/insertion.factor
new file mode 100644 (file)
index 0000000..3a46eb8
--- /dev/null
+++ b/extra/sorting/insertion/insertion.factor
@@ -0,0 +1,16 @@
+USING: locals sequences kernel math ;
+IN: sorting.insertion
+
+<PRIVATE
+:: insert ( seq quot n -- )
+    n zero? [
+        n n 1- [ seq nth quot call ] bi@ >= [
+            n n 1- seq exchange
+            seq quot n 1- insert
+        ] unless
+    ] unless ; inline
+PRIVATE>
+
+: insertion-sort ( seq quot -- )
+    ! quot is a transformation on elements
+    over length [ insert ] with with each ; inline

diff --git a/extra/sorting/insertion/summary.txt b/extra/sorting/insertion/summary.txt
new file mode 100644 (file)
index 0000000..a71be79
--- /dev/null
+++ b/extra/sorting/insertion/summary.txt
@@ -0,0 +1 @@
+Insertion sort

diff --git a/extra/sorting/insertion/tags.txt b/extra/sorting/insertion/tags.txt
new file mode 100644 (file)
index 0000000..42d711b
--- /dev/null
+++ b/extra/sorting/insertion/tags.txt
@@ -0,0 +1 @@
+collections

diff --git a/extra/state-parser/state-parser.factor b/extra/state-parser/state-parser.factor
index af005b4abe43c9cd20b4e372a22f074b78c83fbf..1feaf4601714d94c782910287a373a40efeca366 100644 (file)
--- a/extra/state-parser/state-parser.factor
+++ b/extra/state-parser/state-parser.factor
@@ -144,7 +144,7 @@ M: not-enough-characters summary ( obj -- str )
     ] if next ;\r
 \r
 : expect-string ( string -- )\r
-    dup [ drop get-char next ] map 2dup =\r
+    dup [ get-char next ] replicate 2dup =\r
     [ 2drop ] [ expected ] if ;\r
 \r
 : init-parser ( -- )\r

diff --git a/extra/strings/lib/lib-tests.factor b/extra/strings/lib/lib-tests.factor
index 2779e190c9af1b1e9a738f82f865954e05330d5b..6e0ce05eaab46e260972f68368de100f628a1474 100644 (file)
--- a/extra/strings/lib/lib-tests.factor
+++ b/extra/strings/lib/lib-tests.factor
@@ -5,4 +5,4 @@ IN: temporary
 [ "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ] [ upper-alpha-chars "" like ] unit-test
 [ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" ] [ alpha-chars "" like ] unit-test
 [ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" ] [ alphanumeric-chars "" like ] unit-test
-[ t ] [ 100 [ drop random-alphanumeric-char ] map alphanumeric-chars [ member? ] curry all? ] unit-test
+[ t ] [ 100 [ random-alphanumeric-char ] replicate alphanumeric-chars [ member? ] curry all? ] unit-test

diff --git a/extra/strings/lib/lib.factor b/extra/strings/lib/lib.factor
index e1d88e479d4ec41df2bf3310cfa715343006ce9c..6ecca05ec80fb010cceba6d6fccdfa86bb13c690 100644 (file)
--- a/extra/strings/lib/lib.factor
+++ b/extra/strings/lib/lib.factor
@@ -30,5 +30,4 @@ IN: strings.lib
     alphanumeric-chars random ;
 
 : random-alphanumeric-string ( length -- str )
-    [ drop random-alphanumeric-char ] map "" like ;
-
+    [ random-alphanumeric-char ] "" replicate-as ;

diff --git a/extra/ui/gadgets/frames/frames.factor b/extra/ui/gadgets/frames/frames.factor
index 3e38f60627f7fd8ce2fbad227cecc004c2094793..c0fe59a529e397eee4e13674dc843fb73d69676d 100644 (file)
--- a/extra/ui/gadgets/frames/frames.factor
+++ b/extra/ui/gadgets/frames/frames.factor
@@ -8,7 +8,7 @@ IN: ui.gadgets.frames
 ! gadgets gets left-over space.
 TUPLE: frame ;
 
-: <frame-grid> ( -- grid ) 9 [ drop <gadget> ] map 3 group ;
+: <frame-grid> ( -- grid ) 9 [ <gadget> ] replicate 3 group ;
 
 : @center 1 1 ;
 : @left 0 1 ;

diff --git a/extra/unicode/breaks/breaks.factor b/extra/unicode/breaks/breaks.factor
index 23dfc16e78d91f6cf09c7da1980998e325a75cc5..b70d79b87235cb89188b12f546610d9761bd934a 100755 (executable)
--- a/extra/unicode/breaks/breaks.factor
+++ b/extra/unicode/breaks/breaks.factor
@@ -23,8 +23,7 @@ CATEGORY: grapheme-control Zl Zp Cc Cf ;
 
 CATEGORY: (extend) Me Mn ;
 : extend? ( ch -- ? )
-    [ (extend)? ]
-    [ "Other_Grapheme_Extend" property? ] or? ;
+    { [ (extend)? ] [ "Other_Grapheme_Extend" property? ] } 1|| ;
 
 : grapheme-class ( ch -- class )
     {
@@ -35,7 +34,7 @@ CATEGORY: (extend) Me Mn ;
     } cond ;
 
 : init-grapheme-table ( -- table )
-    graphemes [ drop graphemes f <array> ] map ;
+    graphemes [ graphemes f <array> ] replicate ;
 
 SYMBOL: table
 

diff --git a/extra/unicode/collation/collation.factor b/extra/unicode/collation/collation.factor
index f71a58be85f2bdf65b5eb52a2788b7597598fcbc..216f80c79d8cb13b10bf376fe8e45b381d993ff8 100755 (executable)
--- a/extra/unicode/collation/collation.factor
+++ b/extra/unicode/collation/collation.factor
@@ -58,8 +58,7 @@ ducet insert-helpers
     HEX: 7FFF bitand HEX: 8000 bitor 0 0 f weight boa ;\r
 \r
 : illegal? ( char -- ? )\r
-    [ "Noncharacter_Code_Point" property? ]\r
-    [ category "Cs" = ] or? ;\r
+    { [ "Noncharacter_Code_Point" property? ] [ category "Cs" = ] } 1|| ;\r
 \r
 : derive-weight ( char -- weights )\r
     first dup illegal?\r

diff --git a/extra/unicode/data/data.factor b/extra/unicode/data/data.factor
index e3dd15558b8afefa85cb0fb11a39716bf937d1ee..8ef8658adb4514f2506ee46794c1cfe8aa5da43a 100755 (executable)
--- a/extra/unicode/data/data.factor
+++ b/extra/unicode/data/data.factor
@@ -62,7 +62,7 @@ VALUE: properties
     dup [ swap (chain-decomposed) ] curry assoc-map ;
 
 : first* ( seq -- ? )
-    second [ empty? ] [ first ] or? ;
+    second { [ empty? ] [ first ] } 1|| ;
 
 : (process-decomposed) ( data -- alist )
     5 swap (process-data)
@@ -107,7 +107,7 @@ VALUE: properties
 
 :: fill-ranges ( table -- table )
     name-map >alist sort-values keys
-    [ [ "first>" tail? ] [ "last>" tail? ] or? ] filter
+    [ { [ "first>" tail? ] [ "last>" tail? ] } 1|| ] filter
     2 group [
         [ name>char ] bi@ [ [a,b] ] [ table ?nth ] bi
         [ swap table ?set-nth ] curry each

diff --git a/extra/unicode/normalize/normalize.factor b/extra/unicode/normalize/normalize.factor
index 576c5a7e20bdcb445bb0add6cb1dff5f3dd3ff72..3b64cf577f6632d6706b636edd515c43e93c65ed 100755 (executable)
--- a/extra/unicode/normalize/normalize.factor
+++ b/extra/unicode/normalize/normalize.factor
@@ -1,5 +1,5 @@
 USING: sequences namespaces unicode.data kernel math arrays
-locals combinators.lib sequences.lib combinators.lib ;
+locals combinators.lib sorting.insertion combinators.lib ;
 IN: unicode.normalize
 
 ! Conjoining Jamo behavior

diff --git a/extra/webapps/wee-url/wee-url.factor b/extra/webapps/wee-url/wee-url.factor
index afdacf9add73a31f5a0d254e332c58abe5661aa7..d408c645f3ccc08b4b3893ae5a14b9c6b22b29f0 100644 (file)
--- a/extra/webapps/wee-url/wee-url.factor
+++ b/extra/webapps/wee-url/wee-url.factor
@@ -26,7 +26,7 @@ short-url "SHORT_URLS" {
     3append ; foldable
 
 : random-url ( -- string )
-    1 6 [a,b] random [ drop letter-bank random ] "" map-as ;
+    1 6 [a,b] random [ letter-bank random ] "" replicate-as ;
 
 : insert-short-url ( short-url -- short-url )
     '[ , dup random-url >>short insert-tuple ] 10 retry ;