sequences: redo find words

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

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index a7b77133794482d7d14a7489fe8b1543325de5ea..356d96e8c10a0062094a6610b060e9468c9a021e 100644 (file)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -135,12 +135,6 @@ INSTANCE: iota immutable-sequence
     [ [ nth-unsafe ] curry bi@ ]
     [ [ set-nth-unsafe ] curry bi@ ] 3bi ; inline
 
-: (head) ( seq n -- from to seq ) [ 0 ] 2dip swap ; inline
-
-: (tail) ( seq n -- from to seq ) swap [ length ] keep ; inline
-
-: from-end ( seq n -- seq n' ) [ dup length ] dip - ; inline
-
 : (1sequence) ( obj seq -- seq )
     [ 0 swap set-nth-unsafe ] keep ; inline
 
@@ -155,6 +149,12 @@ INSTANCE: iota immutable-sequence
 
 PRIVATE>
 
+: head-to-index ( seq to -- zero to seq ) [ 0 ] 2dip swap ; inline
+
+: index-to-tail ( seq from -- from length seq ) swap [ length ] keep ; inline
+
+: from-tail ( seq n -- seq n' ) [ dup length ] dip - ; inline
+
 : 1sequence ( obj exemplar -- seq )
     1 swap [ (1sequence) ] new-like ; inline
 
@@ -182,6 +182,9 @@ PRIVATE>
 : ?set-nth ( elt n seq -- )
     2dup bounds-check? [ set-nth-unsafe ] [ 3drop ] if ; inline
 
+: maybe-nth ( i/f seq -- elt/f )
+    over [ nth ] [ 2drop f ] if ; inline
+
 : ?first ( seq -- elt/f ) 0 swap ?nth ; inline
 : ?second ( seq -- elt/f ) 1 swap ?nth ; inline
 : ?last ( seq -- elt/f )
@@ -247,17 +250,17 @@ M: slice virtual@ [ from>> + ] [ seq>> ] bi ; inline
 
 M: slice length [ to>> ] [ from>> ] bi - ; inline
 
-: short ( seq n -- seq n' ) over length min ; inline
+: bound ( seq n -- seq n' ) over length min ; inline
 
-: head-slice ( seq n -- slice ) (head) <slice> ; inline
+: head-slice ( seq n -- slice ) head-to-index <slice> ; inline
 
-: tail-slice ( seq n -- slice ) (tail) <slice> ; inline
+: tail-slice ( seq n -- slice ) index-to-tail <slice> ; inline
 
 : rest-slice ( seq -- slice ) 1 tail-slice ; inline
 
-: head-slice* ( seq n -- slice ) from-end head-slice ; inline
+: head-slice* ( seq n -- slice ) from-tail head-slice ; inline
 
-: tail-slice* ( seq n -- slice ) from-end tail-slice ; inline
+: tail-slice* ( seq n -- slice ) from-tail tail-slice ; inline
 
 : but-last-slice ( seq -- slice ) 1 head-slice* ; inline
 
@@ -291,7 +294,7 @@ ERROR: integer-length-expected obj ;
 : length-sequence ( seq -- n seq )
     [ length check-length ] [ ] bi ; inline
 
-: >range-iterator< ( slice/seq -- i n slice/seq )
+: >underlying< ( slice/seq -- i n slice/seq )
     dup slice? [ >slice< ] [ >sequence< ] if ; inline
 
 TUPLE: copier
@@ -339,15 +342,15 @@ PRIVATE>
 : subseq ( from to seq -- subseq )
     dup subseq-as ;
 
-: head ( seq n -- headseq ) (head) subseq ;
+: head ( seq n -- headseq ) head-to-index subseq ;
 
-: tail ( seq n -- tailseq ) (tail) subseq ;
+: tail ( seq n -- tailseq ) index-to-tail subseq ;
 
 : rest ( seq -- tailseq ) 1 tail ;
 
-: head* ( seq n -- headseq ) from-end head ;
+: head* ( seq n -- headseq ) from-tail head ;
 
-: tail* ( seq n -- tailseq ) from-end tail ;
+: tail* ( seq n -- tailseq ) from-tail tail ;
 
 : but-last ( seq -- headseq ) 1 head* ;
 
@@ -409,24 +412,28 @@ PRIVATE>
 
 <PRIVATE
 
-: sequence-iterator ( seq quot -- i n quot' )
-    [ >range-iterator< [ nth-unsafe ] curry ] dip compose ; inline
+: sequence-operator ( seq quot -- i n quot' )
+    [ >underlying< [ nth-unsafe ] curry ] dip compose ; inline
 
-! setup-1each
-: length-iterator ( seq quot -- n quot' )
+: length-iterator ( seq -- n quot' )
     length-sequence [ nth-unsafe ] curry ; inline
 
-! (1each)
 : length-operator ( seq quot -- n quot' )
     [ length-iterator ] dip compose ; inline
 
-: sequence-iterator-from ( seq quot i -- i n quot' )
+: length-operator-last ( seq quot -- n quot' )
+    length-operator [ 1 - ] dip ; inline
+
+: sequence-operator-from ( seq quot i -- i n quot' )
     -rot length-operator ; inline
 
+: sequence-operator-last-from ( seq quot i -- n quot' )
+    -rot length-operator-last nip ; inline
+
 : collect ( n quot into -- )
     [ [ keep ] dip set-nth-unsafe ] 2curry each-integer ; inline
 
-: sequence-index-iterator ( seq quot -- n quot' )
+: sequence-index-operator ( seq quot -- n quot' )
     [ length-iterator [ keep ] curry ] dip compose ; inline
 
 : map-into ( seq quot into -- )
@@ -451,51 +458,43 @@ PRIVATE>
 : (3each) ( seq1 seq2 seq3 quot -- n quot' )
     [ setup-3each ] dip compose ; inline
 
-: finish-find ( i seq -- i elt )
-    over [ dupd nth-unsafe ] [ drop f ] if ; inline
+: element/index ( i/f seq -- elt/f i/f )
+    [ maybe-nth ] [ drop ] 2bi ; inline
 
-: (find) ( seq quot quot' -- i elt )
-    pick [ [ length-operator ] dip call ] dip finish-find ; inline
+: index/element ( i/f seq -- elt/f i/f )
+    [ drop ] [ maybe-nth ] 2bi ; inline
 
-: (find-from) ( n seq quot quot' -- i elt )
-    [ 2dup bounds-check? ] 2dip
-    '[ _ _ (find) ] [ 2drop f f ] if ; inline
-
-: (find-index) ( seq quot quot' -- i elt )
-    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) ] [ 2drop f f ] if ; inline
-
-: (accumulate) ( seq identity quot -- identity seq quot )
+: (accumulate) ( seq identity quot -- identity seq quot' )
     swapd [ keepd ] curry ; inline
 
-: (accumulate*) ( seq identity quot -- identity seq quot )
+: (accumulate*) ( seq identity quot -- identity seq quot' )
     swapd [ dup ] compose ; inline
 
 PRIVATE>
 
 : each ( ... seq quot: ( ... x -- ... ) -- ... )
-    sequence-iterator each-integer-from ; inline
+    sequence-operator each-integer-from ; inline
 
 : each-from ( ... seq quot: ( ... x -- ... ) i -- ... )
-    sequence-iterator-from each-integer-from ; inline
+    sequence-operator-from each-integer-from ; inline
 
 : reduce ( ... seq identity quot: ( ... prev elt -- ... next ) -- ... result )
     swapd each ; inline
 
-: map-integers ( ... len quot: ( ... i -- ... elt ) exemplar -- ... newseq )
+: map-integers-as ( ... len quot: ( ... i -- ... elt ) exemplar -- ... newseq )
     overd [ [ collect ] keep ] new-like ; inline
 
+: map-integers ( ... len quot: ( ... i -- ... elt ) -- ... newseq )
+    { } map-integers-as ; inline
+
 : map-as ( ... seq quot: ( ... elt -- ... newelt ) exemplar -- ... newseq )
-    [ length-operator ] dip map-integers ; inline
+    [ length-operator ] dip map-integers-as ; inline
 
 : map ( ... seq quot: ( ... elt -- ... newelt ) -- ... newseq )
     over map-as ; inline
 
 : replicate-as ( ... len quot: ( ... -- ... newelt ) exemplar -- ... newseq )
-    [ [ drop ] prepose ] dip map-integers ; inline
+    [ [ drop ] prepose ] dip map-integers-as ; inline
 
 : replicate ( ... len quot: ( ... -- ... newelt ) -- ... newseq )
     { } replicate-as ; inline
@@ -531,7 +530,7 @@ PRIVATE>
     -rotd 2each ; inline
 
 : 2map-as ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... newelt ) exemplar -- ... newseq )
-    [ (2each) ] dip map-integers ; inline
+    [ (2each) ] dip map-integers-as ; inline
 
 : 2map ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... newelt ) -- ... newseq )
     pick 2map-as ; inline
@@ -540,37 +539,49 @@ PRIVATE>
     (2each) all-integers? ; inline
 
 : 2any? ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... ? ) -- ... ? )
-    [ not ] compose 2all? not ; inline
+    negate 2all? not ; inline
 
 : 3each ( ... seq1 seq2 seq3 quot: ( ... elt1 elt2 elt3 -- ... ) -- ... )
     (3each) each-integer ; inline
 
 : 3map-as ( ... seq1 seq2 seq3 quot: ( ... elt1 elt2 elt3 -- ... newelt ) exemplar -- ... newseq )
-    [ (3each) ] dip map-integers ; inline
+    [ (3each) ] dip map-integers-as ; inline
 
 : 3map ( ... seq1 seq2 seq3 quot: ( ... elt1 elt2 elt3 -- ... newelt ) -- ... newseq )
     pickd swap 3map-as ; inline
 
+: bounds-check-find ( n seq quot -- elt i )
+    2over bounds-check? [ call ] [ 3drop f f ] if ; inline
+
 : find-from ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt )
-    [ find-integer-from ] (find-from) ; inline
+    '[
+        _ [ rot sequence-operator-from find-integer-from ] keepd
+        index/element
+    ] bounds-check-find ; inline
 
 : find ( ... seq quot: ( ... elt -- ... ? ) -- ... i elt )
-    [ find-integer ] (find) ; inline
+    [ 0 ] 2dip find-from ; inline
 
 : find-last-from ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt )
-    [ nip find-last-integer ] (find-from) ; inline
+    '[
+        _ [ rot sequence-operator-last-from find-last-integer ] keepd
+        index/element
+    ] bounds-check-find ; inline
 
 : find-last ( ... seq quot: ( ... elt -- ... ? ) -- ... i elt )
-    [ [ 1 - ] dip find-last-integer ] (find) ; inline
+    [ [ length 1 - ] keep ] dip find-last-from ; inline
 
 : find-index-from ( ... n seq quot: ( ... elt i -- ... ? ) -- ... i elt )
-    [ find-integer-from ] (find-index-from) ; inline
+    '[
+        _ [ sequence-index-operator find-integer-from ] keepd
+        index/element
+    ] bounds-check-find ; inline
 
 : find-index ( ... seq quot: ( ... elt i -- ... ? ) -- ... i elt )
-    [ find-integer ] (find-index) ; inline
+    [ 0 ] 2dip find-index-from ; inline
 
 : all? ( ... seq quot: ( ... elt -- ... ? ) -- ... ? )
-    sequence-iterator all-integers-from? ; inline
+    sequence-operator all-integers-from? ; inline
 
 : push-if ( ..a elt quot: ( ..a elt -- ..b ? ) accum -- ..b )
     [ keep ] dip rot [ push ] [ 2drop ] if ; inline
@@ -595,7 +606,7 @@ PRIVATE>
     over filter-as ; inline
 
 : reject-as ( ... seq quot: ( ... elt -- ... ? ) exemplar -- ... subseq )
-    [ [ not ] compose ] [ filter-as ] bi* ; inline
+    [ negate ] [ filter-as ] bi* ; inline
 
 : reject ( ... seq quot: ( ... elt -- ... ? ) -- ... subseq )
     over reject-as ; inline
@@ -631,7 +642,7 @@ PRIVATE>
     [ dup ] swap [ keep ] curry produce nip ; inline
 
 : each-index ( ... seq quot: ( ... elt index -- ... ) -- ... )
-    sequence-index-iterator each-integer ; inline
+    sequence-index-operator each-integer ; inline
 
 : map-index-as ( ... seq quot: ( ... elt index -- ... newelt ) exemplar -- ... newseq )
     [ dup length <iota> ] 2dip 2map-as ; inline
@@ -787,7 +798,7 @@ PRIVATE>
     swap [ [ 0 0 ] dip (filter!) ] keep ; inline
 
 : reject! ( ... seq quot: ( ... elt -- ... ? ) -- ... seq )
-    [ not ] compose filter! ; inline
+    negate filter! ; inline
 
 : remove! ( elt seq -- seq )
     [ = ] with reject! ;
@@ -1093,11 +1104,11 @@ PRIVATE>
 <PRIVATE
 
 : (trim-head) ( seq quot -- seq n )
-    over [ [ not ] compose find drop ] dip swap
+    over [ negate find drop ] dip swap
     [ dup length ] unless* ; inline
 
 : (trim-tail) ( seq quot -- seq n )
-    over [ [ not ] compose find-last drop ?1+ ] dip
+    over [ negate find-last drop ?1+ ] dip
     swap ; inline
 
 PRIVATE>
@@ -1182,14 +1193,14 @@ PRIVATE>
 
 : generic-flip ( matrix -- newmatrix )
     [ [ length ] [ min ] map-reduce ] keep
-    '[ _ [ nth-unsafe ] with { } map-as ] { } map-integers ; inline
+    '[ _ [ nth-unsafe ] with { } map-as ] map-integers ; inline
 
 USE: arrays
 
 : array-flip ( matrix -- newmatrix )
     { array } declare
     [ [ { array } declare length>> ] [ min ] map-reduce ] keep
-    '[ _ [ { array } declare array-nth ] with { } map-as ] { } map-integers ;
+    '[ _ [ { array } declare array-nth ] with { } map-as ] map-integers ;
 
 PRIVATE>