74 lines
1.9 KiB
Factor
74 lines
1.9 KiB
Factor
! Copyright (C) 2005, 2009 Daniel Ehrenberg
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: namespaces math kernel sequences accessors fry circular
|
|
unicode.case unicode.categories locals ;
|
|
|
|
IN: html.parser.state
|
|
|
|
TUPLE: state-parser sequence n ;
|
|
|
|
: <state-parser> ( sequence -- state-parser )
|
|
state-parser new
|
|
swap >>sequence
|
|
0 >>n ;
|
|
|
|
: state-parser-nth ( n state -- char/f )
|
|
sequence>> ?nth ; inline
|
|
|
|
: current ( state -- char/f )
|
|
[ n>> ] keep state-parser-nth ; inline
|
|
|
|
: previous ( state -- char/f )
|
|
[ n>> 1 - ] keep state-parser-nth ; inline
|
|
|
|
: peek-next ( state -- char/f )
|
|
[ n>> 1 + ] keep state-parser-nth ; inline
|
|
|
|
: next ( state -- state )
|
|
[ 1 + ] change-n ; inline
|
|
|
|
: get+increment ( state -- char/f )
|
|
[ current ] [ next drop ] bi ; inline
|
|
|
|
:: skip-until ( state quot: ( obj -- ? ) -- )
|
|
state current [
|
|
quot call [ state next quot skip-until ] unless
|
|
] when* ; inline recursive
|
|
|
|
: state-parse-end? ( state -- ? ) peek-next not ;
|
|
|
|
: take-until ( state quot: ( obj -- ? ) -- sequence/f )
|
|
over state-parse-end? [
|
|
2drop f
|
|
] [
|
|
[ drop n>> ]
|
|
[ skip-until ]
|
|
[ drop [ n>> ] [ sequence>> ] bi ] 2tri subseq
|
|
] if ; inline
|
|
|
|
: take-while ( state quot: ( obj -- ? ) -- sequence/f )
|
|
[ not ] compose take-until ; inline
|
|
|
|
:: take-until-sequence ( state-parser sequence -- sequence' )
|
|
sequence length <growing-circular> :> growing
|
|
state-parser
|
|
[
|
|
growing push-growing-circular
|
|
sequence growing sequence=
|
|
] take-until :> found
|
|
found dup length
|
|
growing length 1- - head
|
|
state-parser next drop ;
|
|
|
|
: skip-whitespace ( state -- state )
|
|
[ [ blank? not ] take-until drop ] keep ;
|
|
|
|
: take-rest ( state -- sequence )
|
|
[ drop f ] take-until ; inline
|
|
|
|
: take-until-object ( state obj -- sequence )
|
|
'[ _ = ] take-until ;
|
|
|
|
: state-parse ( sequence quot -- )
|
|
[ <state-parser> ] dip call ; inline
|