]> gitweb.factorcode.org Git - factor.git/commitdiff
sequences.extras: little more cleanup.
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 29 Dec 2016 20:29:09 +0000 (12:29 -0800)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 29 Dec 2016 20:29:09 +0000 (12:29 -0800)
extra/sequences/extras/extras-tests.factor
extra/sequences/extras/extras.factor

index 6e906dec21b426b21bdd36a9c6f18c4f58936e79..96e8c7109b60faf4f3d6105dbb93b06533afd64f 100644 (file)
@@ -3,7 +3,7 @@ math math.vectors random sequences sequences.extras strings
 tools.test vectors vocabs ;
 IN: sequences.extras.tests
 
-{ { { 0 104 } { 2 108 } { 3 108 } } } [ "hello" [ even? ] find-all ] unit-test
+{ V{ { 0 104 } { 2 108 } { 3 108 } } } [ "hello" [ even? ] find-all ] unit-test
 
 { { "a" "b" "c" "d" "ab" "bc" "cd" "abc" "bcd" "abcd" } } [ "abcd" all-subseqs ] unit-test
 
@@ -107,8 +107,8 @@ IN: sequences.extras.tests
 { "abc" } [ "abc" [ 1string ] map-concat ] unit-test
 { "abc" } [ { 97 98 99 } [ 1string ] map-concat ] unit-test
 { { 97 98 99 } } [ "abc" [ 1string ] { } map-concat-as ] unit-test
-{ "baz" { "foobaz" "barbaz" } }
-[ "baz" { { "foo" } { "bar" } } [ [ over append ] map ] map-concat ] unit-test
+{ { "foobaz" "barbaz" } }
+[ "baz" { { "foo" } { "bar" } } [ [ prepend ] with map ] with map-concat ] unit-test
 
 { { } } [ { } [ ] [ even? ] map-filter ] unit-test
 { "bcde" } [ "abcd" [ 1 + ] [ drop t ] map-filter ] unit-test
index 0a80c74c2f6f6e1341cf78be2abe2b41ce3cdc16..3d7d89d8d93e062296146bdb719787bc0b84b1ad 100644 (file)
@@ -22,12 +22,10 @@ IN: sequences.extras
 : all-subseqs ( seq -- seqs )
     dup length [1,b] [ clump ] with map concat ;
 
-:: each-subseq ( ... seq quot: ( ... x -- ... ) -- ... )
+:: each-subseq ( ... seq quot: ( ... subseq -- ... ) -- ... )
     seq length :> len
-    len [0,b] [
-        :> from
-        from len (a,b] [
-            :> to
+    len [0,b] [| from |
+        from len (a,b] [| to |
             from to seq subseq quot call
         ] each
     ] each ; inline
@@ -35,12 +33,12 @@ IN: sequences.extras
 : map-like ( seq exemplar -- seq' )
     '[ _ like ] map ; inline
 
-: filter-all-subseqs-range ( ... seq range quot: ( ... x -- ... ) -- seq )
+: filter-all-subseqs-range ( ... seq range quot: ( ... subseq -- ... ) -- seq )
     [
         '[ <clumps> _ filter ] with map concat
     ] 3keep 2drop map-like ; inline
 
-: filter-all-subseqs ( ... seq quot: ( ... x -- ... ) -- seq )
+: filter-all-subseqs ( ... seq quot: ( ... subseq -- ... ) -- seq )
     [ dup length [1,b] ] dip filter-all-subseqs-range ; inline
 
 :: longest-subseq ( seq1 seq2 -- subseq )
@@ -186,6 +184,7 @@ ERROR: slices-don't-touch slice1 slice2 ;
     over length mod dup 0 >= [ cut ] [ abs cut* ] if prepend ;
 
 ERROR: underlying-mismatch slice1 slice2 ;
+
 : ensure-same-underlying ( slice1 slice2 -- slice1 slice2 )
     2dup [ seq>> ] bi@ eq? [ underlying-mismatch ] unless ;
 
@@ -231,10 +230,9 @@ PRIVATE>
 
 : map-concat ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq )
     over empty? [ 2drop { } ] [
-        [ [ first ] dip call ] 2keep rot dup [
-            >resizable [ [ push-all ] curry compose ] keep
-            [ 1 ] 3dip [ setup-each (each-integer) ] dip
-        ] curry dip like
+        [ [ first ] dip call ] 2keep pick [
+            [ >resizable ] 2dip [ append! ] compose 1 each-from
+        ] dip like
     ] if ; inline
 
 : map-filter-as ( ... seq map-quot: ( ... elt -- ... newelt ) filter-quot: ( ... newelt -- ... ? ) exemplar -- ... subseq )