sequences: add find* variants that return index/f as last param for better use with...

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index a2bf15cbe6a7e0b32705d7ca60d142861daac2a6..e6717e23a1b993aa5a3c2183f6804e06a92ca897 100644 (file)
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -595,27 +595,25 @@ PRIVATE>
 
 <PRIVATE
 
-: bounds-check-call ( n seq quot -- elt i )
+: bounds-check-call ( n seq quot -- obj1 obj2 )
     2over bounds-check? [ call ] [ 3drop f f ] if ; inline
 
-: find-from-unsafe ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt )
-    [ length-operator find-integer-from ] keepd
-    index/element ; inline
+: find-from-unsafe ( ... n seq quot: ( ... elt -- ... ? ) -- ... i/f seq )
+    [ length-operator find-integer-from ] keepd ; inline
 
-: find-last-from-unsafe ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt )
-    [ length-operator nip find-last-integer ] keepd
-    index/element ; inline
+: find-last-from-unsafe ( ... n seq quot: ( ... elt -- ... ? ) -- ... i/f seq )
+    [ length-operator nip find-last-integer ] keepd ; inline
 
 PRIVATE>
 
 : find-from ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt )
-    '[ _ find-from-unsafe ] bounds-check-call ; inline
+    '[ _ find-from-unsafe index/element ] bounds-check-call ; inline
 
 : find ( ... seq quot: ( ... elt -- ... ? ) -- ... i elt )
-    [ 0 ] 2dip find-from-unsafe ; inline
+    [ 0 ] 2dip find-from-unsafe index/element ; inline
 
 : find-last-from ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt )
-    '[ _ find-last-from-unsafe ] bounds-check-call ; inline
+    '[ _ find-last-from-unsafe index/element ] bounds-check-call ; inline
 
 : find-last ( ... seq quot: ( ... elt -- ... ? ) -- ... i elt )
     [ index-of-last ] dip find-last-from ; inline
@@ -635,9 +633,6 @@ PRIVATE>
 : push-when ( ..a elt quot: ( ..a elt -- ..b ? ) accum -- ..b )
     [ keep ] dip rot [ push ] [ 2drop ] if ; inline
 
-: call-push-when ( ..a elt quot: ( ..a elt -- ..b elt' ? ) accum -- ..b )
-    [ call ] dip swap [ push ] [ 2drop ] if ; inline
-
 <PRIVATE
 
 : (selector-as) ( quot length exemplar -- selector accum )

diff --git a/extra/sequences/extras/extras-tests.factor b/extra/sequences/extras/extras-tests.factor
index 4e1b7fd28869f94653fd656daca343a8bc5f2bca..c18401ef65c3217940ccd51575e2ae0629dc6607 100644 (file)
--- a/extra/sequences/extras/extras-tests.factor
+++ b/extra/sequences/extras/extras-tests.factor
@@ -464,3 +464,26 @@ strings tools.test ;
     [ 2dup [ odd? ] bi@ or [ * ] [ 2drop f ] if  ]
     2nested-filter*
 ] unit-test
+
+{ 20 1 } [ { 10 20 30 } [ 20 = ] find* ] unit-test
+{ f f } [ { 10 20 30 } [ 21 = ] find* ] unit-test
+
+{ 20 1 } [ 0 { 10 20 30 } [ 20 = ] find-from* ] unit-test
+{ f f } [ 0 { 10 20 30 } [ 21 = ] find-from* ] unit-test
+{ 20 1 } [ 0 { 10 20 30 } [ 20 = ] find-from* ] unit-test
+{ 20 1 } [ 1 { 10 20 30 } [ 20 = ] find-from* ] unit-test
+{ f f } [ 2 { 10 20 30 } [ 20 = ] find-from* ] unit-test
+
+{ 20 1 } [ { 10 20 30 } [ 20 = ] find-last* ] unit-test
+{ f f } [ { } [ 21 = ] find-last* ] unit-test
+{ f f } [ { 10 20 30 } [ 21 = ] find-last* ] unit-test
+
+{ f f } [ 0 { 10 20 30 } [ 20 = ] find-last-from* ] unit-test
+{ 20 1 } [ 1 { 10 20 30 } [ 20 = ] find-last-from* ] unit-test
+{ 20 1 } [ 2 { 10 20 30 } [ 20 = ] find-last-from* ] unit-test
+
+{ 20 1 } [ { 10 20 30 } [ drop 20 = ] find-index* ] unit-test
+{ f f } [ { 10 20 30 } [ drop 21 = ] find-index* ] unit-test
+
+{ 20 1 } [ 0 { 10 20 30 } [ drop 20 = ] find-index-from* ] unit-test
+{ f f } [ 0 { 10 20 30 } [ drop 21 = ] find-index-from* ] unit-test

diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor
index 77a535100cfe37582b727e3d0ac2e1fcc4d8a91c..2ec7576c0e6a0beebc694461aad98623cb6002b4 100644 (file)
--- a/extra/sequences/extras/extras.factor
+++ b/extra/sequences/extras/extras.factor
@@ -709,8 +709,6 @@ PRIVATE>
 
 PRIVATE>
 
-: index-of ( seq obj -- n ) '[ _ = ] find drop ;
-
 ERROR: slice-error-of from to seq ;
 
 : check-slice-of ( seq from to -- seq from to )
@@ -733,11 +731,27 @@ ERROR: slice-error-of from to seq ;
 : snip-slice-of ( seq from to -- head tail )
     [ head-slice ] [ tail-slice ] bi-curry* bi ; inline
 
+: index* ( seq obj -- n ) [ = ] curry find drop ;
+
+: index-from* ( i seq obj -- n )
+    [ = ] curry find-from drop ;
+
+: last-index* ( seq obj -- n )
+    [ = ] curry find-last drop ;
+
+: last-index-from* ( i seq obj -- n )
+    [ = ] curry find-last-from drop ;
+
+: indices* ( seq obj -- indices )
+    [ = ] curry [ swap ] prepose V{ } clone [
+        [ push ] curry [ [ drop ] if ] curry compose each-index
+    ] keep ;
+
 : remove-first ( obj seq -- seq' )
     [ index ] keep over [ remove-nth ] [ nip ] if ;
 
 : remove-first-of ( seq obj -- seq' )
-    dupd index-of [ remove-nth-of ] when* ;
+    dupd index* [ remove-nth-of ] when* ;
 
 : remove-first! ( obj seq -- seq )
     [ index ] keep over [ remove-nth! ] [ nip ] if ;
@@ -1098,3 +1112,27 @@ M: virtual-zip-index nth-unsafe
     over [ seq>> nth-unsafe ] [ 2array ] bi* ; inline
 
 INSTANCE: virtual-zip-index immutable-sequence
+
+: call-push-when ( ..a elt quot: ( ..a elt -- ..b elt' ? ) accum -- ..b )
+    [ call ] dip swap [ push ] [ 2drop ] if ; inline
+
+: find-from* ( ... n seq quot: ( ... elt -- ... ? ) -- ... elt i/f )
+    '[ _ find-from-unsafe element/index ] bounds-check-call ; inline
+
+: find* ( ... seq quot: ( ... elt -- ... ? ) -- ... elt i/f )
+    [ 0 ] 2dip find-from-unsafe element/index ; inline
+
+: find-last-from* ( ... n seq quot: ( ... elt -- ... ? ) -- ... elt i/f )
+    '[ _ find-last-from-unsafe element/index ] bounds-check-call ; inline
+
+: find-last* ( ... seq quot: ( ... elt -- ... ? ) -- ... elt i/f )
+    [ index-of-last ] dip find-last-from* ; inline
+
+: find-index-from* ( ... n seq quot: ( ... elt i -- ... ? ) -- ... elt i/f )
+    '[
+        _ [ sequence-index-operator find-integer-from ] keepd
+        element/index
+    ] bounds-check-call ; inline
+
+: find-index* ( ... seq quot: ( ... elt i -- ... ? ) -- ... elt i/f )
+    [ 0 ] 2dip find-index-from* ; inline