USING: accessors arrays assocs classes combinators
combinators.short-circuit compiler.units effects.parser fry
-generalizations kernel locals make math math.order namespaces
-quotations sequences sets splitting unicode vectors
-vocabs.loader words ;
+kernel make math math.order namespaces quotations sequences
+sets splitting unicode vectors vocabs.loader words ;
IN: peg
pos get apply-rule process-parser-result ;
: preset-parser-word ( parser -- word parser )
- gensym swap over >>compiled ;
+ gensym tuck >>compiled ;
: define-parser-word ( word parser -- )
! Return the body of the word that is the compiled version
: compile ( parser -- word )
[
H{ } clone delayed [
- compile-parser-quot ( -- result ) define-temp fixup-delayed
+ compile-parser fixup-delayed
] with-variable
] with-compilation-unit ;
: compiled-parse ( state word -- result )
swap [
- execute( -- result )
+ execute-parser
[ error-stack get ?first [ throw ]
[ pos get input get f <parse-error> throw ] if* ] unless*
] with-packrat ;
: (parse) ( input parser -- result )
- dup word? [ compile ] unless compiled-parse ;
+ compile compiled-parse ;
: parse ( input parser -- ast )
(parse) ast>> ;
[ seq>> pos get swap ] dip "'" "'" surround 1vector add-error f
] if ;
-M: token-parser (compile) ( peg -- quot )
+M: token-parser (compile)
symbol>> '[ input-slice _ parse-token ] ;
TUPLE: satisfy-parser quot ;
TUPLE: repeat0-parser parser ;
-: (repeat) ( quot: ( -- result ) result -- result )
+: (repeat) ( quot: ( -- result/f ) result -- result )
over call [
[ remaining>> >>remaining ] [ ast>> ] bi
over ast>> push (repeat)
: 4seq ( parser1 parser2 parser3 parser4 -- parser )
4array seq ;
-: seq* ( quot -- paser )
+: seq* ( quot -- parser )
{ } make seq ; inline
: choice ( seq -- parser )
: 4choice ( parser1 parser2 parser3 parser4 -- parser )
4array choice ;
-: choice* ( quot -- paser )
+: choice* ( quot -- parser )
{ } make choice ; inline
: repeat0 ( parser -- parser )