improve sequence-parser

db4
Doug Coleman 2009-04-09 21:03:18 -05:00
parent a6989d3087
commit a761d57019
2 changed files with 73 additions and 10 deletions

View File

@ -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

View File

@ -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 ;