]> gitweb.factorcode.org Git - factor.git/commitdiff
sequences: rename some helper words and subseq/member variants
authorDoug Coleman <doug.coleman@gmail.com>
Thu, 21 Jul 2022 06:39:39 +0000 (01:39 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Sun, 31 Jul 2022 18:24:55 +0000 (13:24 -0500)
(each-integer) -> each-integer-from
(find-integer) -> find-integer-from
(all-integers?) -> all-integers-from?
subseq == swap find-subseq
add: find-subseq-from subseq-starts-at?

core/growable/growable.factor
core/math/math.factor
core/sequences/sequences-docs.factor
core/sequences/sequences.factor
core/splitting/splitting.factor
core/strings/strings-tests.factor
core/system/system-tests.factor

index e6daa965a4cdae3cc709e0662c8cbd4556d5b019..f2662ddfe74db5a52b2143f491879729ccd39c90 100644 (file)
@@ -35,7 +35,7 @@ GENERIC: contract ( len seq -- )
 M: growable contract
     [ length ] keep
     [ [ 0 ] 2dip set-nth-unsafe ] curry
-    (each-integer) ; inline
+    each-integer-from ; inline
 
 M: growable set-length
     bounds-check-head
index de463a357915081702e122787d9f4d428d6acd08..c4178b0f0984049ae429bc71f0376e91b02f72ca 100644 (file)
@@ -247,43 +247,43 @@ GENERIC: prev-float ( m -- n )
 : align ( m w -- n )
     1 - [ + ] keep bitnot bitand ; inline
 
-: (each-integer) ( ... i n quot: ( ... i -- ... ) -- ... )
+: each-integer-from ( ... i n quot: ( ... i -- ... ) -- ... )
     2over < [
         [ nip call ] 3keep
-        [ 1 + ] 2dip (each-integer)
+        [ 1 + ] 2dip each-integer-from
     ] [
         3drop
     ] if ; inline recursive
 
-: (find-integer) ( ... i n quot: ( ... i -- ... ? ) -- ... i/f )
+: find-integer-from ( ... i n quot: ( ... i -- ... ? ) -- ... i/f )
     2over < [
         [ nip call ] 3keep roll
         [ 2drop ]
-        [ [ 1 + ] 2dip (find-integer) ] if
+        [ [ 1 + ] 2dip find-integer-from ] if
     ] [
         3drop f
     ] if ; inline recursive
 
-: (all-integers?) ( ... i n quot: ( ... i -- ... ? ) -- ... ? )
+: all-integers-from? ( ... i n quot: ( ... i -- ... ? ) -- ... ? )
     2over < [
         [ nip call ] 3keep roll
-        [ [ 1 + ] 2dip (all-integers?) ]
+        [ [ 1 + ] 2dip all-integers-from? ]
         [ 3drop f ] if
     ] [
         3drop t
     ] if ; inline recursive
 
 : each-integer ( ... n quot: ( ... i -- ... ) -- ... )
-    [ 0 ] 2dip (each-integer) ; inline
+    [ 0 ] 2dip each-integer-from ; inline
 
 : times ( ... n quot: ( ... -- ... ) -- ... )
     [ drop ] prepose each-integer ; inline
 
 : find-integer ( ... n quot: ( ... i -- ... ? ) -- ... i/f )
-    [ 0 ] 2dip (find-integer) ; inline
+    [ 0 ] 2dip find-integer-from ; inline
 
 : all-integers? ( ... n quot: ( ... i -- ... ? ) -- ... ? )
-    [ 0 ] 2dip (all-integers?) ; inline
+    [ 0 ] 2dip all-integers-from? ; inline
 
 : find-last-integer ( ... n quot: ( ... i -- ... ? ) -- ... i/f )
     over 0 < [
index 2b725c50b49bc11954e588462b383a63a0a356bd..8c185d586c188c946192bc19c339f8d09fb32f27 100644 (file)
@@ -1190,12 +1190,20 @@ HELP: cut*
 { $values { "seq" sequence } { "n" "a non-negative integer" } { "before" sequence } { "after" sequence } }
 { $description "Outputs a pair of sequences, where " { $snippet "after" } " consists of the last " { $snippet "n" } " elements of " { $snippet "seq" } ", while " { $snippet "before" } " holds the remaining elements. Both output sequences have the same type as " { $snippet "seq" } "." } ;
 
-HELP: subseq-start-from
-{ $values { "subseq" sequence } { "seq" sequence } { "n" "a start index" } { "i" "a start index" } }
+HELP: subseq-starts-at?
+{ $values { "i" "a start index" } { "seq" sequence } { "subseq" sequence } { "?" boolean } }
+{ $description "Outputs " { $snippet "t" } " if the subseq starts at the " { $snippet "i" } "th element or outputs " { $link f } " if the sequence is not at that position." } ;
+
+HELP: find-subseq
+{ $values { "seq" sequence } { "subseq" sequence } { "i/f" "a start index or " { $snippet "f" } } }
+{ $description "Outputs the start index of the first contiguous subsequence equal to " { $snippet "subseq" } ", starting the search from the " { $snippet "n" } "th element. If no matching subsequence is found, outputs " { $link f } "." } ;
+
+HELP: find-subseq-from
+{ $values { "n" "a start index" } { "seq" sequence } { "subseq" sequence } { "i/f" "a start index or " { $snippet "f" } } }
 { $description "Outputs the start index of the first contiguous subsequence equal to " { $snippet "subseq" } ", starting the search from the " { $snippet "n" } "th element. If no matching subsequence is found, outputs " { $link f } "." } ;
 
 HELP: subseq-start
-{ $values { "subseq" sequence } { "seq" sequence } { "i" "a start index" } }
+{ $values { "subseq" sequence } { "seq" sequence } { "i/f" "a start index or " { $snippet "f" } } }
 { $description "Outputs the start index of the first contiguous subsequence equal to " { $snippet "subseq" } ", or " { $link f } " if no matching subsequence is found." } ;
 
 HELP: subseq?
@@ -1937,7 +1945,12 @@ ARTICLE: "sequences-search" "Searching sequences"
     last-index-from
 }
 "Finding the start of a subsequence:"
-{ $subsections subseq-start subseq-start-from }
+{ $subsections
+    subseq-start
+    find-subseq
+    find-subseq-from
+    subseq-starts-at?
+}
 "Finding the index of an element satisfying a predicate:"
 { $subsections
     find
index 6605e6f88e2dda355f308d1d970d3715d3dfe325..1891149396dd92c96a934096078dda1e38272dd4 100644 (file)
@@ -473,10 +473,10 @@ PRIVATE>
 PRIVATE>
 
 : each ( ... seq quot: ( ... x -- ... ) -- ... )
-    (each) (each-integer) ; inline
+    (each) each-integer-from ; inline
 
 : each-from ( ... seq quot: ( ... x -- ... ) i -- ... )
-    (each-from) (each-integer) ; inline
+    (each-from) each-integer-from ; inline
 
 : reduce ( ... seq identity quot: ( ... prev elt -- ... next ) -- ... result )
     swapd each ; inline
@@ -521,7 +521,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
@@ -548,7 +548,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
@@ -560,13 +560,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
+    (each) all-integers-from? ; inline
 
 : push-if ( ..a elt quot: ( ..a elt -- ..b ? ) accum -- ..b )
     [ keep ] dip rot [ push ] [ 2drop ] if ; inline
@@ -681,15 +681,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 ;
 
@@ -1017,22 +1029,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*
index 588e731a900b970010e3e520ec2bb8966b6c4efb..b72aae53bd6d344b9b722140b5232119f6984650 100644 (file)
@@ -28,7 +28,7 @@ PRIVATE>
 <PRIVATE
 
 : subseq-range ( seq subseq -- from/f to/f )
-    [ swap subseq-start ] keep '[ dup _ length + ] [ f f ] if* ; inline
+    [ find-subseq ] keep '[ dup _ length + ] [ f f ] if* ; inline
 
 : (split1) ( seq subseq snip-quot -- before after )
     [ [ subseq-range ] keepd over ] dip [ 2nip f ] if ; inline
index 28feb10d15b976af2544c67cd694c3871d094285..79f8c06c77853a895ec8444bc4de0e71c577737e 100644 (file)
@@ -26,6 +26,8 @@ vectors ;
 { f } [ CHAR: I "team" member? ] unit-test
 { t } [ "ea" "team" subseq? ] unit-test
 { f } [ "actore" "Factor" subseq? ] unit-test
+{ t } [ "team" "ea" find-subseq? ] unit-test
+{ f } [ "Factor" "actore" find-subseq? ] unit-test
 
 { "end" } [ "Beginning and end" 14 tail ] unit-test
 
index 4e927777d5f20545b7e6d4b232b901d0c527f2b4..44d58ab02209d9d116eadcda5f500bca844dc048 100644 (file)
@@ -1,6 +1,7 @@
 USING: arrays sequences system tools.test ;
 
 { { t t t } } [
+    version-info
     vm-version vm-compiler vm-compile-time 3array
-    [ version-info subseq? ] map
+    [ find-subseq? ] with map
 ] unit-test