65 lines
1.9 KiB
Plaintext
65 lines
1.9 KiB
Plaintext
|
\ Simple stateful parsing module.
|
||
|
|
|
||
|
|
0
|
||
|
|
cell +field parser-string
|
||
|
|
cell +field parser-size
|
||
|
|
cell +field parser-marker
|
||
|
|
cell +field parser-cursor
|
||
|
|
constant PARSER_SIZE
|
||
|
|
|
||
|
|
variable context
|
||
|
|
: (context@) ( -- parser-addr ) context @ ;
|
||
|
|
: (context!) ( parser-addr -- ) context ! ;
|
||
|
|
|
||
|
|
: (string@) ( -- c-addr ) (context@) parser-string @ ;
|
||
|
|
: (string!) ( c-addr -- ) (context@) parser-string ! ;
|
||
|
|
: (size@) ( -- u ) (context@) parser-size @ ;
|
||
|
|
: (size!) ( u -- ) (context@) parser-size ! ;
|
||
|
|
: (marker@) ( -- u ) (context@) parser-marker @ ;
|
||
|
|
: (marker!) ( u -- ) (context@) parser-marker ! ;
|
||
|
|
: (cursor@) ( -- u ) (context@) parser-cursor @ ;
|
||
|
|
: (cursor!) ( u -- ) (context@) parser-cursor ! ;
|
||
|
|
|
||
|
|
: new-parser ( c-addr u parser-addr -- )
|
||
|
|
(context!) (size!) (string!) 0 dup (marker!) (cursor!) ;
|
||
|
|
: restore-parser ( parser-addr -- ) (context!) ;
|
||
|
|
: current-parser ( -- parser-addr ) (context@) ;
|
||
|
|
|
||
|
|
: parser-here ( -- u ) (cursor@) ;
|
||
|
|
: parser-marker ( -- u ) (marker@) ;
|
||
|
|
: parser-mark ( -- ) (cursor@) (marker!) ;
|
||
|
|
: parser-backtrack ( -- ) (marker@) (cursor!) ;
|
||
|
|
|
||
|
|
: parser-remaining ( -- c-addr u )
|
||
|
|
(string@) (cursor@) + (size@) (cursor@) - ;
|
||
|
|
|
||
|
|
: parser-extract ( -- c-addr u )
|
||
|
|
(string@) (marker@) + (cursor@) (marker@) - ;
|
||
|
|
|
||
|
|
: parser>>| ( -- ) (size@) (cursor!) ;
|
||
|
|
: parser|<< ( -- ) 0 (cursor!) ;
|
||
|
|
: parser>> ( u -- ) (cursor@) + (size@) min 0 max (cursor!) ;
|
||
|
|
: parser<< ( u -- ) negate parser>> ;
|
||
|
|
|
||
|
|
: parser>>string ( c-addr u -- flag )
|
||
|
|
parser-remaining 2swap search IF
|
||
|
|
drop (string@) - (cursor!) true
|
||
|
|
ELSE
|
||
|
|
2drop false
|
||
|
|
THEN ;
|
||
|
|
|
||
|
|
: parser>>|string ( c-addr u -- flag )
|
||
|
|
parser>>string ;
|
||
|
|
|
||
|
|
: parser>>string| ( c-addr u -- flag )
|
||
|
|
dup -rot parser>>string IF
|
||
|
|
parser>> true
|
||
|
|
ELSE
|
||
|
|
drop false
|
||
|
|
THEN ;
|
||
|
|
|
||
|
|
: with-parser ( xt parser-addr -- )
|
||
|
|
(context@) >r (context!) execute r> (context!) ;
|
||
|
|
: with-new-parser ( xt str parser-addr -- )
|
||
|
|
(context@) >r new-parser execute r> (context!) ;
|