state-parser works with sequences, not strings

fix bug with take-until
db4
Doug Coleman 2009-03-31 18:49:41 -05:00
parent e22823f2c4
commit 8e26b19cc0
3 changed files with 44 additions and 33 deletions

View File

@ -68,10 +68,10 @@ SYMBOL: tagstack
[ blank? ] trim ; [ blank? ] trim ;
: read-comment ( state-parser -- ) : read-comment ( state-parser -- )
"-->" take-until-string make-comment-tag push-tag ; "-->" take-until-sequence make-comment-tag push-tag ;
: read-dtd ( state-parser -- ) : read-dtd ( state-parser -- )
">" take-until-string make-dtd-tag push-tag ; ">" take-until-sequence make-dtd-tag push-tag ;
: read-bang ( state-parser -- ) : read-bang ( state-parser -- )
next dup { [ get-char CHAR: - = ] [ get-next CHAR: - = ] } 1&& [ next dup { [ get-char CHAR: - = ] [ get-next CHAR: - = ] } 1&& [
@ -93,7 +93,7 @@ SYMBOL: tagstack
: (parse-attributes) ( state-parser -- ) : (parse-attributes) ( state-parser -- )
skip-whitespace skip-whitespace
dup string-parse-end? [ dup state-parse-end? [
drop drop
] [ ] [
[ [
@ -108,7 +108,7 @@ SYMBOL: tagstack
: (parse-tag) ( string -- string' hashtable ) : (parse-tag) ( string -- string' hashtable )
[ [
[ read-token >lower ] [ parse-attributes ] bi [ read-token >lower ] [ parse-attributes ] bi
] string-parse ; ] state-parse ;
: read-< ( state-parser -- string/f ) : read-< ( state-parser -- string/f )
next dup get-char [ next dup get-char [
@ -126,7 +126,7 @@ SYMBOL: tagstack
] [ drop ] if ; ] [ drop ] if ;
: tag-parse ( quot -- vector ) : tag-parse ( quot -- vector )
V{ } clone tagstack [ string-parse ] with-variable ; inline V{ } clone tagstack [ state-parse ] with-variable ; inline
: parse-html ( string -- vector ) : parse-html ( string -- vector )
[ (parse-html) tagstack get ] tag-parse ; [ (parse-html) tagstack get ] tag-parse ;

View File

@ -2,29 +2,35 @@ USING: tools.test html.parser.state ascii kernel accessors ;
IN: html.parser.state.tests IN: html.parser.state.tests
[ "hello" ] [ "hello" ]
[ "hello" [ take-rest ] string-parse ] unit-test [ "hello" [ take-rest ] state-parse ] unit-test
[ "hi" " how are you?" ] [ "hi" " how are you?" ]
[ [
"hi how are you?" "hi how are you?"
[ [ [ blank? ] take-until ] [ take-rest ] bi ] string-parse [ [ [ blank? ] take-until ] [ take-rest ] bi ] state-parse
] unit-test ] unit-test
[ "foo" ";bar" ] [ "foo" ";bar" ]
[ [
"foo;bar" [ "foo;bar" [
[ CHAR: ; take-until-char ] [ take-rest ] bi [ CHAR: ; take-until-object ] [ take-rest ] bi
] string-parse ] state-parse
] unit-test ] unit-test
[ "foo " " bar" ] [ "foo " " bar" ]
[ [
"foo and bar" [ "foo and bar" [
[ "and" take-until-string ] [ take-rest ] bi [ "and" take-until-sequence ] [ take-rest ] bi
] string-parse ] state-parse
] unit-test ] unit-test
[ 6 ] [ 6 ]
[ [
" foo " [ skip-whitespace i>> ] string-parse " foo " [ skip-whitespace n>> ] state-parse
] unit-test ] unit-test
[ { 1 2 } ]
[ { 1 2 3 } <state-parser> [ 3 = ] take-until ] unit-test
[ { 1 2 } ]
[ { 1 2 3 4 } <state-parser> { 3 4 } take-until-sequence ] unit-test

View File

@ -2,31 +2,32 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: namespaces math kernel sequences accessors fry circular USING: namespaces math kernel sequences accessors fry circular
unicode.case unicode.categories locals ; unicode.case unicode.categories locals ;
IN: html.parser.state IN: html.parser.state
TUPLE: state-parser string i ; TUPLE: state-parser sequence n ;
: <state-parser> ( string -- state-parser ) : <state-parser> ( sequence -- state-parser )
state-parser new state-parser new
swap >>string swap >>sequence
0 >>i ; 0 >>n ;
: (get-char) ( i state -- char/f ) : (get-char) ( n state -- char/f )
string>> ?nth ; inline sequence>> ?nth ; inline
: get-char ( state -- char/f ) : get-char ( state -- char/f )
[ i>> ] keep (get-char) ; inline [ n>> ] keep (get-char) ; inline
: get-next ( state -- char/f ) : get-next ( state -- char/f )
[ i>> 1+ ] keep (get-char) ; inline [ n>> 1 + ] keep (get-char) ; inline
: next ( state -- state ) : next ( state -- state )
[ 1+ ] change-i ; inline [ 1 + ] change-n ; inline
: get+increment ( state -- char/f ) : get+increment ( state -- char/f )
[ get-char ] [ next drop ] bi ; inline [ get-char ] [ next drop ] bi ; inline
: string-parse ( string quot -- ) : state-parse ( sequence quot -- )
[ <state-parser> ] dip call ; inline [ <state-parser> ] dip call ; inline
:: skip-until ( state quot: ( obj -- ? ) -- ) :: skip-until ( state quot: ( obj -- ? ) -- )
@ -34,17 +35,23 @@ TUPLE: state-parser string i ;
quot call [ state next quot skip-until ] unless quot call [ state next quot skip-until ] unless
] when* ; inline recursive ] when* ; inline recursive
: take-until ( state quot: ( obj -- ? ) -- string ) : state-parse-end? ( state -- ? ) get-next not ;
[ drop i>> ]
[ skip-until ]
[ drop [ i>> ] [ string>> ] bi ] 2tri subseq ; inline
:: take-until-string ( state-parser string -- string' ) : take-until ( state quot: ( obj -- ? ) -- sequence/f )
string length <growing-circular> :> growing over state-parse-end? [
2drop f
] [
[ drop n>> ]
[ skip-until ]
[ drop [ n>> ] [ sequence>> ] bi ] 2tri subseq
] if ; inline
:: take-until-sequence ( state-parser sequence -- sequence' )
sequence length <growing-circular> :> growing
state-parser state-parser
[ [
growing push-growing-circular growing push-growing-circular
string growing sequence= sequence growing sequence=
] take-until :> found ] take-until :> found
found dup length found dup length
growing length 1- - head growing length 1- - head
@ -53,10 +60,8 @@ TUPLE: state-parser string i ;
: skip-whitespace ( state -- state ) : skip-whitespace ( state -- state )
[ [ blank? not ] take-until drop ] keep ; [ [ blank? not ] take-until drop ] keep ;
: take-rest ( state -- string ) : take-rest ( state -- sequence )
[ drop f ] take-until ; inline [ drop f ] take-until ; inline
: take-until-char ( state ch -- string ) : take-until-object ( state obj -- sequence )
'[ _ = ] take-until ; '[ _ = ] take-until ;
: string-parse-end? ( state -- ? ) get-next not ;