diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor index 3efe2d6979..c1e2ce8546 100644 --- a/extra/peg/ebnf/ebnf.factor +++ b/extra/peg/ebnf/ebnf.factor @@ -262,8 +262,8 @@ M: ebnf-terminal (transform) ( ast -- parser ) M: ebnf-non-terminal (transform) ( ast -- parser ) symbol>> [ - , parser get , \ at , - ] [ ] make delay sp ; + , parser get , \ at , \ sp , + ] [ ] make box ; : transform-ebnf ( string -- object ) 'ebnf' parse parse-result-ast transform ; @@ -282,7 +282,8 @@ M: ebnf-non-terminal (transform) ( ast -- parser ) : ebnf>quot ( string -- hashtable quot ) 'ebnf' parse check-parse-result - parse-result-ast transform dup main swap at compile [ parse ] curry ; + parse-result-ast transform dup dup parser [ main swap at compile ] with-variable + [ compiled-parse ] curry ; : [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing diff --git a/extra/peg/peg-docs.factor b/extra/peg/peg-docs.factor index d2ca353ba1..7b13e06d5a 100644 --- a/extra/peg/peg-docs.factor +++ b/extra/peg/peg-docs.factor @@ -159,4 +159,17 @@ HELP: delay { $description "Delays the construction of a parser until it is actually required to parse. This " "allows for calling a parser that results in a recursive call to itself. The quotation " - "should return the constructed parser." } ; + "should return the constructed parser and is called the first time the parser is run." + "The compiled result is memoized for future runs. See " { $link box } " for a word " + "that calls the quotation at compile time." } ; + +HELP: box +{ $values + { "quot" "a quotation" } + { "parser" "a parser" } +} +{ $description + "Delays the construction of a parser until the parser is compiled. The quotation " + "should return the constructed parser and is called when the parser is compiled." + "The compiled result is memoized for future runs. See " { $link delay } " for a word " + "that calls the quotation at runtime." } ; diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 47ca60eef9..c9de46aa86 100755 --- a/extra/peg/peg.factor +++ b/extra/peg/peg.factor @@ -191,7 +191,7 @@ C: peg-head f lrstack set H{ } clone heads set H{ } clone packrat set - ] H{ } make-assoc swap bind ; + ] H{ } make-assoc swap bind ; inline : compiled-parsers ( -- cache ) @@ -235,9 +235,11 @@ GENERIC: (compile) ( parser -- quot ) : compile ( parser -- word ) [ compiled-parser ] with-compilation-unit ; +: compiled-parse ( state word -- result ) + swap [ execute ] with-packrat ; inline + : parse ( state parser -- result ) - dup word? [ compile ] unless - [ execute ] curry with-packrat ; + dup word? [ compile ] unless compiled-parse ; memoize-quot [ % \ execute , ] [ ] make ; +TUPLE: box-parser quot ; + +M: box-parser (compile) ( parser -- quot ) + #! Calls the quotation at compile time + #! to produce the parser to be compiled. + #! This differs from 'delay' which calls + #! it at run time. + quot>> call compiled-parser 1quotation ; + PRIVATE> : token ( string -- parser ) @@ -554,10 +565,13 @@ PRIVATE> : delay ( quot -- parser ) delay-parser construct-boa init-parser ; +: box ( quot -- parser ) + box-parser construct-boa init-parser ; + : PEG: (:) [ [ - call compile 1quotation + call compile [ compiled-parse ] curry [ dup [ parse-result-ast ] [ "Parse failed" throw ] if ] append define ] with-compilation-unit