Move replicate into core; move selection sort into its own vocab; remove usages of and? and or? which are redundant now

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

core/classes/algebra/algebra-tests.factor

@@ -204,7 +204,7 @@ UNION: z1 b1 c1 ;
 
 10 [
     [ ] [
-        20 [ drop random-op ] map >quotation
+        20 [ random-op ] [ ] replicate-as
         [ infer effect-in [ random-class ] times ] keep
         call
         drop
@@ -238,8 +238,8 @@ UNION: z1 b1 c1 ;
 
 20 [
     [ t ] [
-        20 [ drop random-boolean-op ] [ ] map-as dup .
+        20 [ random-boolean-op ] [ ] replicate-as dup .
-        [ infer effect-in [ drop random-boolean ] map dup . ] keep
+        [ infer effect-in [ random-boolean ] replicate dup . ] keep
         
         [ >r [ ] each r> call ] 2keep
         

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 ;

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
 

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
 

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

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
 

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 ;
 

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
+sequences arrays vectors definitions prettyprint
-math hashtables sets ;
+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 -- )

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

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

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 )

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

extra/lcs/lcs.factor

@@ -63,15 +63,19 @@ TUPLE: trace-state old new table i j ;
     [ 1- ] change-i [ 1- ] change-j ;
 
 : inserted? ( state -- ? )
-    [ j>> 0 > ]
+    {
-    [ [ i>> zero? ] [ top-beats-side? ] or? ] and? ;
+        [ j>> 0 > ]
+        [ { [ i>> zero? ] [ top-beats-side? ] } 1|| ]
+    } 1&& ;
 
 : do-insert ( state -- state )
     dup new-nth insert boa , [ 1- ] change-j ;
 
 : deleted? ( state -- ? )
-    [ i>> 0 > ]
+    {
-    [ [ j>> zero? ] [ top-beats-side? not ] or? ] and? ;
+        [ i>> 0 > ]
+        [ { [ j>> zero? ] [ top-beats-side? not ] } 1|| ]
+    } 1&& ;
 
 : do-delete ( state -- state )
     dup old-nth delete boa , [ 1- ] change-i ;

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>
 

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
 

extra/sorting/insertion/authors.txt

@@ -0,0 +1 @@
+Daniel Ehrenberg

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

extra/sorting/insertion/summary.txt

@@ -0,0 +1 @@
+Insertion sort

extra/sorting/insertion/tags.txt

@@ -0,0 +1 @@
+collections

extra/state-parser/state-parser.factor

@@ -144,7 +144,7 @@ M: not-enough-characters summary ( obj -- str )
     ] if next ;
 
 : expect-string ( string -- )
-    dup [ drop get-char next ] map 2dup =
+    dup [ get-char next ] replicate 2dup =
     [ 2drop ] [ expected ] if ;
 
 : init-parser ( -- )

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

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 ;
-

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 ;

extra/unicode/breaks/breaks.factor

@@ -23,8 +23,7 @@ CATEGORY: grapheme-control Zl Zp Cc Cf ;
 
 CATEGORY: (extend) Me Mn ;
 : extend? ( ch -- ? )
-    [ (extend)? ]
+    { [ (extend)? ] [ "Other_Grapheme_Extend" property? ] } 1|| ;
-    [ "Other_Grapheme_Extend" property? ] or? ;
 
 : 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
 

extra/unicode/collation/collation.factor

@@ -58,8 +58,7 @@ ducet insert-helpers
     HEX: 7FFF bitand HEX: 8000 bitor 0 0 f weight boa ;
 
 : illegal? ( char -- ? )
-    [ "Noncharacter_Code_Point" property? ]
+    { [ "Noncharacter_Code_Point" property? ] [ category "Cs" = ] } 1|| ;
-    [ category "Cs" = ] or? ;
 
 : derive-weight ( char -- weights )
     first dup illegal?

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

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

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 ;