steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

more work on sequence-parser

db4
Doug Coleman 2009-04-09 21:32:57 -05:00
parent 2179b4bca1
commit 732065d775
2 changed files with 29 additions and 1 deletions

12
extra/sequence-parser/sequence-parser-tests.factor
View File

@ -138,3 +138,15 @@ IN: sequence-parser.tests
[ 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
[ "asdfasdf" ] [
"/*asdfasdf*/" <sequence-parser> take-c-comment
] unit-test
[ "k" ] [
"/*asdfasdf*/k" <sequence-parser> [ take-c-comment drop ] [ take-rest ] bi
] unit-test
[ "/*asdfasdf" ] [
"/*asdfasdf" <sequence-parser> [ take-c-comment drop ] [ take-rest ] bi
] unit-test

18
extra/sequence-parser/sequence-parser.factor
View File

@ -12,6 +12,12 @@ TUPLE: sequence-parser sequence n ;
swap >>sequence
0 >>n ;
:: with-sequence-parser ( sequence-parser quot -- seq/f )
sequence-parser n>> :> n
sequence-parser quot call [
n sequence-parser (>>n) f
] unless* ; inline
: offset ( sequence-parser offset -- char/f )
swap
[ n>> + ] [ sequence>> ?nth ] bi ; inline
@ -33,7 +39,8 @@ TUPLE: sequence-parser sequence n ;
:: skip-until ( sequence-parser quot: ( obj -- ? ) -- )
sequence-parser current [
sequence-parser quot call [ sequence-parser advance quot skip-until ] unless
sequence-parser quot call
[ sequence-parser advance quot skip-until ] unless
] when ; inline recursive
: sequence-parse-end? ( sequence-parser -- ? ) current not ;
@ -149,5 +156,14 @@ TUPLE: sequence-parser sequence n ;
sequence-parser [ n + ] change-n drop
] if ;
: take-c-comment ( sequence-parser -- seq/f )
[
dup "/*" take-sequence [
"*/" take-until-sequence*
] [
drop f
] if
] with-sequence-parser ;
: write-full ( sequence-parser -- ) sequence>> write ;
: write-rest ( sequence-parser -- ) take-rest write ;