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
: 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 < [
{ $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?
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
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
(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
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
[ [ 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
: 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 ;
: 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*
<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
{ 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
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