moontalk/server/eventloop-server-experiment/libs/parser/parser.4th

\ 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!) ;