] parse-sequence
] unit-test
-[ "foo " " bar" ]
+[ "foo " "and bar" ]
[
"foo and bar" [
[ "and" take-until-sequence ] [ take-rest ] bi
] parse-sequence
] unit-test
+[ "foo " " bar" ]
+[
+ "foo and bar" [
+ [ "and" take-until-sequence ]
+ [ "and" take-sequence drop ]
+ [ take-rest ] tri
+ ] parse-sequence
+] unit-test
+
+[ "foo " " bar" ]
+[
+ "foo and bar" [
+ [ "and" take-until-sequence* ]
+ [ take-rest ] bi
+ ] parse-sequence
+] unit-test
+
+[ { 1 2 } ]
+[ { 1 2 3 4 } <sequence-parser> { 3 4 } take-until-sequence ] unit-test
+
+[ f "aaaa" ]
+[
+ "aaaa" <sequence-parser>
+ [ "b" take-until-sequence ] [ take-rest ] bi
+] unit-test
+
[ 6 ]
[
" foo " [ skip-whitespace n>> ] parse-sequence
[ { 1 2 } ]
[ { 1 2 3 } <sequence-parser> [ current 3 = ] take-until ] unit-test
-[ { 1 2 } ]
-[ { 1 2 3 4 } <sequence-parser> { 3 4 } take-until-sequence ] unit-test
-
[ "ab" ]
[ "abcd" <sequence-parser> "ab" take-sequence ] unit-test
[ f ]
[ "abc" <sequence-parser> "abcdefg" take-sequence ] unit-test
+
+[ 1234 ]
+[ "1234f" <sequence-parser> take-integer ] unit-test
+
+[ "yes" ]
+[
+ "yes1234f" <sequence-parser>
+ [ take-integer drop ] [ "yes" take-sequence ] bi
+] unit-test
+
+[ f ] [ "" <sequence-parser> 4 take-n ] unit-test
+[ "abcd" ] [ "abcd" <sequence-parser> 4 take-n ] unit-test
+[ "abcd" "efg" ] [ "abcdefg" <sequence-parser> [ 4 take-n ] [ take-rest ] bi ] unit-test
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces math kernel sequences accessors fry circular
unicode.case unicode.categories locals combinators.short-circuit
-make combinators io splitting ;
+make combinators io splitting math.parser ;
IN: sequence-parser
TUPLE: sequence-parser sequence n ;
f
] if ;
-:: take-until-sequence ( sequence-parser sequence -- sequence' )
+: take-sequence* ( sequence-parser sequence -- )
+ take-sequence drop ;
+
+:: take-until-sequence ( sequence-parser sequence -- sequence'/f )
+ sequence-parser n>> :> saved
sequence length <growing-circular> :> growing
sequence-parser
[
current growing push-growing-circular
sequence growing sequence=
] take-until :> found
- found dup length
- growing length 1- - head
- sequence-parser advance drop ;
-
+ growing sequence sequence= [
+ found dup length
+ growing length 1- - head
+ sequence-parser [ growing length - 1 + ] change-n drop
+ ! sequence-parser advance drop
+ ] [
+ saved sequence-parser (>>n)
+ f
+ ] if ;
+
+:: take-until-sequence* ( sequence-parser sequence -- sequence'/f )
+ sequence-parser sequence take-until-sequence :> out
+ out [
+ sequence-parser [ sequence length + ] change-n drop
+ ] when out ;
+
: skip-whitespace ( sequence-parser -- sequence-parser )
[ [ current blank? not ] take-until drop ] keep ;
: take-token ( sequence-parser -- string/f )
CHAR: \ CHAR: " take-token* ;
+: take-integer ( sequence-parser -- n/f )
+ [ current digit? ] take-while string>number ;
+
+:: take-n ( sequence-parser n -- seq/f )
+ n sequence-parser [ n>> + ] [ sequence>> length ] bi > [
+ f
+ ] [
+ sequence-parser n>> dup n + sequence-parser sequence>> subseq
+ sequence-parser [ n + ] change-n drop
+ ] if ;
+
: write-full ( sequence-parser -- ) sequence>> write ;
: write-rest ( sequence-parser -- ) take-rest write ;