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

take-until doesnt pass the element to the quotation anymore

db4
Doug Coleman 2009-04-01 03:13:38 -05:00
parent f994654af3
commit 20df429a50
3 changed files with 14 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
extra/html/parser/parser.factor
View File

@ -42,10 +42,10 @@ SYMBOL: tagstack
: make-dtd-tag ( string -- tag ) dtd new-tag ; inline : make-dtd-tag ( string -- tag ) dtd new-tag ; inline
: read-single-quote ( state-parser -- string ) : read-single-quote ( state-parser -- string )
[ [ CHAR: ' = ] take-until ] [ next drop ] bi ; [ [ current CHAR: ' = ] take-until ] [ next drop ] bi ;
: read-double-quote ( state-parser -- string ) : read-double-quote ( state-parser -- string )
[ [ CHAR: " = ] take-until ] [ next drop ] bi ; [ [ current CHAR: " = ] take-until ] [ next drop ] bi ;
: read-quote ( state-parser -- string ) : read-quote ( state-parser -- string )
dup get+increment CHAR: ' = dup get+increment CHAR: ' =
@ -53,14 +53,14 @@ SYMBOL: tagstack
: read-key ( state-parser -- string ) : read-key ( state-parser -- string )
skip-whitespace skip-whitespace
[ { [ CHAR: = = ] [ blank? ] } 1|| ] take-until ; [ current { [ CHAR: = = ] [ blank? ] } 1|| ] take-until ;
: read-= ( state-parser -- ) : read-= ( state-parser -- )
skip-whitespace skip-whitespace
[ [ CHAR: = = ] take-until drop ] [ next drop ] bi ; [ [ current CHAR: = = ] take-until drop ] [ next drop ] bi ;
: read-token ( state-parser -- string ) : read-token ( state-parser -- string )
[ blank? ] take-until ; [ current blank? ] take-until ;
: read-value ( state-parser -- string ) : read-value ( state-parser -- string )
skip-whitespace skip-whitespace
@ -82,11 +82,11 @@ SYMBOL: tagstack
] if ; ] if ;
: read-tag ( state-parser -- string ) : read-tag ( state-parser -- string )
[ [ "><" member? ] take-until ] [ [ current "><" member? ] take-until ]
[ dup current CHAR: < = [ next ] unless drop ] bi ; [ dup current CHAR: < = [ next ] unless drop ] bi ;
: read-until-< ( state-parser -- string ) : read-until-< ( state-parser -- string )
[ CHAR: < = ] take-until ; [ current CHAR: < = ] take-until ;
: parse-text ( state-parser -- ) : parse-text ( state-parser -- )
read-until-< [ make-text-tag push-tag ] unless-empty ; read-until-< [ make-text-tag push-tag ] unless-empty ;

4
extra/html/parser/state/state-tests.factor
View File

@ -7,7 +7,7 @@ IN: html.parser.state.tests
[ "hi" " how are you?" ] [ "hi" " how are you?" ]
[ [
"hi how are you?" "hi how are you?"
[ [ [ blank? ] take-until ] [ take-rest ] bi ] state-parse [ [ [ current blank? ] take-until ] [ take-rest ] bi ] state-parse
] unit-test ] unit-test
[ "foo" ";bar" ] [ "foo" ";bar" ]
@ -30,7 +30,7 @@ IN: html.parser.state.tests
] unit-test ] unit-test
[ { 1 2 } ] [ { 1 2 } ]
[ { 1 2 3 } <state-parser> [ 3 = ] take-until ] unit-test [ { 1 2 3 } <state-parser> [ current 3 = ] take-until ] unit-test
[ { 1 2 } ] [ { 1 2 } ]
[ { 1 2 3 4 } <state-parser> { 3 4 } take-until-sequence ] unit-test [ { 1 2 3 4 } <state-parser> { 3 4 } take-until-sequence ] unit-test

10
extra/html/parser/state/state.factor
View File

@ -32,8 +32,8 @@ TUPLE: state-parser sequence n ;
:: skip-until ( state quot: ( obj -- ? ) -- ) :: skip-until ( state quot: ( obj -- ? ) -- )
state current [ state current [
quot call [ state next quot skip-until ] unless state quot call [ state next quot skip-until ] unless
] when* ; inline recursive ] when ; inline recursive
: state-parse-end? ( state -- ? ) peek-next not ; : state-parse-end? ( state -- ? ) peek-next not ;
@ -53,7 +53,7 @@ TUPLE: state-parser sequence n ;
sequence length <growing-circular> :> growing sequence length <growing-circular> :> growing
state-parser state-parser
[ [
growing push-growing-circular current growing push-growing-circular
sequence growing sequence= sequence growing sequence=
] take-until :> found ] take-until :> found
found dup length found dup length
@ -61,13 +61,13 @@ TUPLE: state-parser sequence n ;
state-parser next drop ; state-parser next drop ;
: skip-whitespace ( state -- state ) : skip-whitespace ( state -- state )
[ [ blank? not ] take-until drop ] keep ; [ [ current blank? not ] take-until drop ] keep ;
: take-rest ( state -- sequence ) : take-rest ( state -- sequence )
[ drop f ] take-until ; inline [ drop f ] take-until ; inline
: take-until-object ( state obj -- sequence ) : take-until-object ( state obj -- sequence )
'[ _ = ] take-until ; '[ current _ = ] take-until ;
: state-parse ( sequence quot -- ) : state-parse ( sequence quot -- )
[ <state-parser> ] dip call ; inline [ <state-parser> ] dip call ; inline