steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://double.co.nz/git/factor

db4
Slava Pestov 2008-03-29 00:38:31 -05:00
parent e300fd10ea ca4f775756
commit 2aafe074b2
3 changed files with 36 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
extra/peg/ebnf/ebnf.factor
View File

@ -262,8 +262,8 @@ M: ebnf-terminal (transform) ( ast -- parser )
M: ebnf-non-terminal (transform) ( ast -- parser ) M: ebnf-non-terminal (transform) ( ast -- parser )
symbol>> [ symbol>> [
, parser get , \ at , , parser get , \ at , \ sp ,
] [ ] make delay sp ; ] [ ] make box ;
: transform-ebnf ( string -- object ) : transform-ebnf ( string -- object )
'ebnf' parse parse-result-ast transform ; 'ebnf' parse parse-result-ast transform ;
@ -282,7 +282,8 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
: ebnf>quot ( string -- hashtable quot ) : ebnf>quot ( string -- hashtable quot )
'ebnf' parse check-parse-result '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 : [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing

15
extra/peg/peg-docs.factor
View File

@ -159,4 +159,17 @@ HELP: delay
{ $description { $description
"Delays the construction of a parser until it is actually required to parse. This " "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 " "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." } ;

22
extra/peg/peg.factor
View File

@ -191,7 +191,7 @@ C: <head> peg-head
f lrstack set f lrstack set
H{ } clone heads set H{ } clone heads set
H{ } clone packrat set H{ } clone packrat set
] H{ } make-assoc swap bind ; ] H{ } make-assoc swap bind ; inline
: compiled-parsers ( -- cache ) : compiled-parsers ( -- cache )
@ -235,9 +235,11 @@ GENERIC: (compile) ( parser -- quot )
: compile ( parser -- word ) : compile ( parser -- word )
[ compiled-parser ] with-compilation-unit ; [ compiled-parser ] with-compilation-unit ;
: compiled-parse ( state word -- result )
swap [ execute ] with-packrat ; inline
: parse ( state parser -- result ) : parse ( state parser -- result )
dup word? [ compile ] unless dup word? [ compile ] unless compiled-parse ;
[ execute ] curry with-packrat ;
<PRIVATE <PRIVATE
@ -486,6 +488,15 @@ M: delay-parser (compile) ( parser -- quot )
{ } { "word" } <effect> memoize-quot { } { "word" } <effect> memoize-quot
[ % \ execute , ] [ ] make ; [ % \ 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> PRIVATE>
: token ( string -- parser ) : token ( string -- parser )
@ -554,10 +565,13 @@ PRIVATE>
: delay ( quot -- parser ) : delay ( quot -- parser )
delay-parser construct-boa init-parser ; delay-parser construct-boa init-parser ;
: box ( quot -- parser )
box-parser construct-boa init-parser ;
: PEG: : PEG:
(:) [ (:) [
[ [
call compile 1quotation call compile [ compiled-parse ] curry
[ dup [ parse-result-ast ] [ "Parse failed" throw ] if ] [ dup [ parse-result-ast ] [ "Parse failed" throw ] if ]
append define append define
] with-compilation-unit ] with-compilation-unit