diff --git a/extra/sequence-parser/sequence-parser-tests.factor b/extra/sequence-parser/sequence-parser-tests.factor index 915d119abe..715beae5da 100644 --- a/extra/sequence-parser/sequence-parser-tests.factor +++ b/extra/sequence-parser/sequence-parser-tests.factor @@ -17,13 +17,39 @@ IN: sequence-parser.tests ] 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 @@ -32,9 +58,6 @@ IN: sequence-parser.tests [ { 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 @@ -102,3 +125,16 @@ IN: sequence-parser.tests [ 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 diff --git a/extra/sequence-parser/sequence-parser.factor b/extra/sequence-parser/sequence-parser.factor index ad49982d88..22f133bf70 100644 --- a/extra/sequence-parser/sequence-parser.factor +++ b/extra/sequence-parser/sequence-parser.factor @@ -2,7 +2,7 @@ ! 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 ; @@ -66,17 +66,33 @@ 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 ; @@ -122,5 +138,16 @@ TUPLE: sequence-parser sequence n ; : 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 ;