core: rename some words

[factor.git] / core / sequences / sequences.factor

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 50a3a38091f87b02a10f8b494ab8e23f80a5e4e1..8b3697ab9f488492e26a68448b951dadda0538d2 100644 (file)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -218,6 +218,9 @@ TUPLE: slice
     { to integer read-only }
     { seq read-only } ;
 
+: >slice< ( slice -- from to seq )
+    [ from>> ] [ to>> ] [ seq>> ] tri ; inline
+
 : collapse-slice ( m n slice -- m' n' seq )
     [ from>> ] [ seq>> ] bi [ [ + ] curry bi@ ] dip ; inline
 
@@ -282,13 +285,22 @@ ERROR: integer-length-expected obj ;
 : check-length ( n -- n )
     dup integer? [ integer-length-expected ] unless ; inline
 
-TUPLE: copy-state
+: >sequence< ( seq -- i n seq )
+    [ drop 0 ] [ length check-length ] [ ] tri ; inline
+
+: length-sequence ( seq -- n seq )
+    [ length check-length ] [ ] bi ; inline
+
+: >underlying< ( slice/seq -- i n slice/seq )
+    dup slice? [ >slice< ] [ >sequence< ] if ; inline
+
+TUPLE: copier
     { src-i integer read-only }
     { src read-only }
     { dst-i integer read-only }
     { dst read-only } ;
 
-C: <copy> copy-state
+C: <copier> copier
 
 : copy-nth-unsafe ( n copy -- )
     [ [ src-i>> + ] [ src>> ] bi nth-unsafe ]
@@ -301,7 +313,7 @@ C: <copy> copy-state
 
 : subseq>copy ( from to seq -- n copy )
     [ over - check-length swap ] dip
-    3dup nip new-sequence 0 swap <copy> ; inline
+    3dup nip new-sequence 0 swap <copier> ; inline
 
 : bounds-check-head ( n seq -- n seq )
     over 0 < [ bounds-error ] when ; inline
@@ -311,10 +323,10 @@ C: <copy> copy-state
     [ swap length + ] dip lengthen ; inline
 
 : copy-unsafe ( src i dst -- )
-    [ [ length check-length 0 ] keep ] 2dip <copy> (copy) drop ; inline
+    [ [ length check-length 0 ] keep ] 2dip <copier> (copy) drop ; inline
 
 : subseq-unsafe-as ( from to seq exemplar -- subseq )
-    [ subseq>copy (copy) ] dip like ;
+    [ subseq>copy (copy) ] dip like ; inline
 
 : subseq-unsafe ( from to seq -- subseq )
     dup subseq-unsafe-as ; inline
@@ -325,7 +337,7 @@ PRIVATE>
     [ check-slice ] dip subseq-unsafe-as ;
 
 : subseq ( from to seq -- subseq )
-    dup subseq-as ; inline
+    dup subseq-as ;
 
 : head ( seq n -- headseq ) (head) subseq ;
 
@@ -380,6 +392,10 @@ PRIVATE>
 
 : surround ( seq1 seq2 seq3 -- newseq ) over surround-as ; inline
 
+: 1surround-as ( seq1 seq2 exemplar  -- newseq ) dupd surround-as ; inline
+
+: 1surround ( seq1 seq2 -- newseq ) dup 1surround-as ; inline
+
 : glue-as ( seq1 seq2 seq3 exemplar -- newseq ) swapd 3append-as ; inline
 
 : glue ( seq1 seq2 seq3 -- newseq ) pick glue-as ; inline
@@ -393,23 +409,26 @@ PRIVATE>
 
 <PRIVATE
 
-: setup-each ( seq -- n quot )
-    [ length check-length ] keep [ nth-unsafe ] curry ; inline
+: sequence-operator ( seq quot -- i n quot' )
+    [ >underlying< [ nth-unsafe ] curry ] dip compose ; inline
 
-: (each) ( seq quot -- n quot' )
-    [ setup-each ] dip compose ; inline
+: length-iterator ( seq quot -- n quot' )
+    length-sequence [ nth-unsafe ] curry ; inline
 
-: (each-index) ( seq quot -- n quot' )
-    [ setup-each [ keep ] curry ] dip compose ; inline
+: length-operator ( seq quot -- n quot' )
+    [ length-iterator ] dip compose ; inline
 
-: (collect) ( quot into -- quot' )
-    [ [ keep ] dip set-nth-unsafe ] 2curry ; inline
+: sequence-operator-from ( seq quot i -- i n quot' )
+    -rot length-operator ; inline
 
 : collect ( n quot into -- )
-    (collect) each-integer ; inline
+    [ [ keep ] dip set-nth-unsafe ] 2curry each-integer ; inline
+
+: sequence-index-iterator ( seq quot -- n quot' )
+    [ length-iterator [ keep ] curry ] dip compose ; inline
 
 : map-into ( seq quot into -- )
-    [ (each) ] dip collect ; inline
+    [ length-operator ] dip collect ; inline
 
 : 2nth-unsafe ( n seq1 seq2 -- elt1 elt2 )
     [ nth-unsafe ] bi-curry@ bi ; inline
@@ -434,22 +453,18 @@ PRIVATE>
     over [ dupd nth-unsafe ] [ drop f ] if ; inline
 
 : (find) ( seq quot quot' -- i elt )
-    pick [ [ (each) ] dip call ] dip finish-find ; inline
+    pick [ [ length-operator ] dip call ] dip finish-find ; inline
 
 : (find-from) ( n seq quot quot' -- i elt )
     [ 2dup bounds-check? ] 2dip
-    [ (find) ] 2curry
-    [ 2drop f f ]
-    if ; inline
+    '[ _ _ (find) ] [ 2drop f f ] if ; inline
 
 : (find-index) ( seq quot quot' -- i elt )
-    pick [ [ (each-index) ] dip call ] dip finish-find ; inline
+    pick [ [ sequence-index-iterator ] dip call ] dip finish-find ; inline
 
 : (find-index-from) ( n seq quot quot' -- i elt )
     [ 2dup bounds-check? ] 2dip
-    [ (find-index) ] 2curry
-    [ 2drop f f ]
-    if ; inline
+    '[ _ _ (find-index) ] [ 2drop f f ] if ; inline
 
 : (accumulate) ( seq identity quot -- identity seq quot )
     swapd [ keepd ] curry ; inline
@@ -460,10 +475,10 @@ PRIVATE>
 PRIVATE>
 
 : each ( ... seq quot: ( ... x -- ... ) -- ... )
-    (each) each-integer ; inline
+    sequence-operator each-integer-from ; inline
 
 : each-from ( ... seq quot: ( ... x -- ... ) i -- ... )
-    -rot (each) (each-integer) ; inline
+    sequence-operator-from each-integer-from ; inline
 
 : reduce ( ... seq identity quot: ( ... prev elt -- ... next ) -- ... result )
     swapd each ; inline
@@ -472,7 +487,7 @@ PRIVATE>
     overd [ [ collect ] keep ] new-like ; inline
 
 : map-as ( ... seq quot: ( ... elt -- ... newelt ) exemplar -- ... newseq )
-    [ (each) ] dip map-integers ; inline
+    [ length-operator ] dip map-integers ; inline
 
 : map ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq )
     over map-as ; inline
@@ -508,7 +523,7 @@ PRIVATE>
     (2each) each-integer ; inline
 
 : 2each-from ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... ) i -- ... )
-    [ (2each) ] dip -rot (each-integer) ; inline
+    [ (2each) ] dip -rot each-integer-from ; inline
 
 : 2reduce ( ... seq1 seq2 identity quot: ( ... prev elt1 elt2 -- ... next ) -- ... result )
     -rotd 2each ; inline
@@ -535,7 +550,7 @@ PRIVATE>
     pickd swap 3map-as ; inline
 
 : find-from ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt )
-    [ (find-integer) ] (find-from) ; inline
+    [ find-integer-from ] (find-from) ; inline
 
 : find ( ... seq quot: ( ... elt -- ... ? ) -- ... i elt )
     [ find-integer ] (find) ; inline
@@ -547,13 +562,13 @@ PRIVATE>
     [ [ 1 - ] dip find-last-integer ] (find) ; inline
 
 : find-index-from ( ... n seq quot: ( ... elt i -- ... ? ) -- ... i elt )
-    [ (find-integer) ] (find-index-from) ; inline
+    [ find-integer-from ] (find-index-from) ; inline
 
 : find-index ( ... seq quot: ( ... elt i -- ... ? ) -- ... i elt )
     [ find-integer ] (find-index) ; inline
 
 : all? ( ... seq quot: ( ... elt -- ... ? ) -- ... ? )
-    (each) all-integers? ; inline
+    sequence-operator all-integers-from? ; inline
 
 : push-if ( ..a elt quot: ( ..a elt -- ..b ? ) accum -- ..b )
     [ keep ] dip rot [ push ] [ 2drop ] if ; inline
@@ -614,13 +629,13 @@ PRIVATE>
     [ dup ] swap [ keep ] curry produce nip ; inline
 
 : each-index ( ... seq quot: ( ... elt index -- ... ) -- ... )
-    (each-index) each-integer ; inline
+    sequence-index-iterator each-integer ; inline
 
 : map-index-as ( ... seq quot: ( ... elt index -- ... newelt ) exemplar -- ... newseq )
     [ dup length <iota> ] 2dip 2map-as ; inline
 
 : map-index ( ... seq quot: ( ... elt index -- ... newelt ) -- ... newseq )
-    { } map-index-as ; inline
+    over map-index-as ; inline
 
 : interleave ( ... seq between quot: ( ... elt -- ... ) -- ... )
     pick empty? [ 3drop ] [
@@ -668,15 +683,27 @@ PRIVATE>
 : member? ( elt seq -- ? )
     [ = ] with any? ;
 
+: member-of? ( seq elt -- ? )
+    [ = ] curry any? ;
+
 : member-eq? ( elt seq -- ? )
     [ eq? ] with any? ;
 
+: member-eq-of? ( seq elt -- ? )
+    [ eq? ] curry any? ;
+
 : remove ( elt seq -- newseq )
     [ = ] with reject ;
 
+: remove-of ( seq elt -- newseq )
+    [ = ] curry reject ;
+
 : remove-eq ( elt seq -- newseq )
     [ eq? ] with reject ;
 
+: remove-eq-of ( seq elt -- newseq )
+    [ eq? ] curry reject ;
+
 : sift ( seq -- newseq )
     [ ] filter ;
 
@@ -691,7 +718,7 @@ PRIVATE>
 PRIVATE>
 
 : mismatch ( seq1 seq2 -- i )
-    [ min-length ] 2keep mismatch-unsafe ; inline
+    [ min-length ] 2keep mismatch-unsafe ;
 
 M: sequence <=>
     [ mismatch ] 2keep pick
@@ -992,7 +1019,11 @@ PRIVATE>
 PRIVATE>
 
 : binary-reduce ( seq start quot: ( elt1 elt2 -- newelt ) -- value )
-    pick length 0 max 0 swap (binary-reduce) ; inline
+    pick dup slice? [
+        [ seq>> ] 3dip [ from>> 0 max ] [ to>> 0 max over - ] bi
+    ] [
+        length 0 max 0 swap
+    ] if (binary-reduce) ; inline
 
 : cut ( seq n -- before after )
     [ head ] [ tail ] 2bi ;
@@ -1000,22 +1031,25 @@ PRIVATE>
 : cut* ( seq n -- before after )
     [ head* ] [ tail* ] 2bi ;
 
-<PRIVATE
+: subseq-starts-at? ( i seq subseq -- ? )
+    [ length swap ] keep
+    '[
+        [ + _ nth-unsafe ] keep _ nth-unsafe =
+    ] with all-integers? ; inline
 
-: (subseq-start-from) ( subseq seq n length -- subseq seq ? )
-    [
-        [ 3dup ] dip [ + swap nth-unsafe ] keep rot nth-unsafe =
-    ] all-integers? nip ; inline
+: find-subseq-from ( n seq subseq -- i/f )
+    [ [ length ] bi@ - 1 + ] 2keep
+    '[ _ _ subseq-starts-at? ] find-integer-from ; inline
 
-PRIVATE>
+: subseq-start-from ( subseq seq n -- i/f ) spin find-subseq-from ; inline
+
+: find-subseq ( seq subseq -- i/f ) [ 0 ] 2dip find-subseq-from ; inline
 
-: subseq-start-from ( subseq seq n -- i )
-    pick length [ pick length swap - 1 + ] keep
-    [ (subseq-start-from) ] curry (find-integer) 2nip ;
+: find-subseq? ( seq subseq -- ? ) find-subseq >boolean ; inline
 
-: subseq-start ( subseq seq -- i ) 0 subseq-start-from ; inline
+: subseq-start ( subseq seq -- i/f ) swap find-subseq ; inline
 
-: subseq? ( subseq seq -- ? ) subseq-start >boolean ;
+: subseq? ( subseq seq -- ? ) subseq-start >boolean ; inline
 
 : drop-prefix ( seq1 seq2 -- slice1 slice2 )
     2dup mismatch [ 2dup min-length ] unless*