sequences: redo find words

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

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 4b47ef755f565de0ee92dba950bbb6993f62a374..356d96e8c10a0062094a6610b060e9468c9a021e 100644 (file)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -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,7 +250,7 @@ M: slice virtual@ [ from>> + ] [ seq>> ] bi ; inline
 
 M: slice length [ to>> ] [ from>> ] bi - ; inline
 
-: cramp ( seq n -- seq n' ) over length min ; inline
+: bound ( seq n -- seq n' ) over length min ; inline
 
 : head-slice ( seq n -- slice ) head-to-index <slice> ; inline
 
@@ -418,13 +421,19 @@ PRIVATE>
 : length-operator ( seq quot -- n quot' )
     [ length-iterator ] dip compose ; inline
 
+: 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 -- )
@@ -449,27 +458,16 @@ 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
-
-: (find) ( seq quot quot' -- i elt )
-    pick [ [ length-operator ] dip call ] dip finish-find ; 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
+: element/index ( i/f seq -- elt/f i/f )
+    [ maybe-nth ] [ drop ] 2bi ; inline
 
-: (find-index-from) ( n seq quot quot' -- i elt )
-    [ 2dup bounds-check? ] 2dip
-    '[ _ _ (find-index) ] [ 2drop f f ] if ; inline
+: index/element ( i/f seq -- elt/f i/f )
+    [ drop ] [ maybe-nth ] 2bi ; 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>
@@ -483,17 +481,20 @@ PRIVATE>
 : 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
@@ -529,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
@@ -544,28 +545,40 @@ PRIVATE>
     (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-operator all-integers-from? ; inline
@@ -629,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
@@ -1180,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>