Merge git://double.co.nz/git/factor

Slava Pestov 2008-03-27 17:45:09 -05:00
commit 3b0e2b412c
5 changed files with 129 additions and 16 deletions

View File

@ -142,4 +142,32 @@ IN: peg.ebnf.tests
{ f } [
"Z" [EBNF foo=[^A-Z] EBNF] call
] unit-test
] unit-test
[
#! Test direct left recursion. Currently left recursion should cause a
#! failure of that parser.
#! Not using packrat, so recursion causes data stack overflow
"1+1" [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call
] must-fail
{ V{ 49 } } [
#! Test direct left recursion. Currently left recursion should cause a
#! failure of that parser.
#! Using packrat, so first part of expr fails, causing 2nd choice to be used
"1+1" [ [EBNF num=([0-9])+ expr=expr "+" num | num EBNF] call ] with-packrat parse-result-ast
] unit-test
[
#! Test indirect left recursion. Currently left recursion should cause a
#! failure of that parser.
#! Not using packrat, so recursion causes data stack overflow
"1+1" [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call
] must-fail
{ V{ 49 } } [
#! Test indirect left recursion. Currently left recursion should cause a
#! failure of that parser.
#! Using packrat, so first part of expr fails, causing 2nd choice to be used
"1+1" [ [EBNF num=([0-9])+ x=expr expr=x "+" num | num EBNF] call ] with-packrat parse-result-ast
] unit-test

View File

@ -266,7 +266,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
] [ ] make delay sp ;
: transform-ebnf ( string -- object )
'ebnf' parse parse-result-ast transform ;
'ebnf' packrat-parse parse-result-ast transform ;
: check-parse-result ( result -- result )
dup [
@ -281,7 +281,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
] if ;
: ebnf>quot ( string -- hashtable quot )
'ebnf' parse check-parse-result
'ebnf' packrat-parse check-parse-result
parse-result-ast transform dup main swap at compile 1quotation ;
: [EBNF "EBNF]" parse-multiline-string ebnf>quot nip parsed ; parsing

View File

@ -12,7 +12,7 @@ HELP: parse
{ $description
"Given the input string, parse it using the given parser. The result is a <parse-result> object if "
"the parse was successful, otherwise it is f." }
{ $see-also compile with-packrat } ;
{ $see-also compile with-packrat packrat-parse } ;
HELP: with-packrat
{ $values
@ -23,8 +23,30 @@ HELP: with-packrat
"Calls the quotation with a packrat cache in scope. Usually the quotation will "
"call " { $link parse } " or call a word produced by " { $link compile } "."
"The cache is used to avoid the possible exponential time performace that pegs "
"can have, instead giving linear time at the cost of increased memory usage." }
{ $see-also compile parse } ;
"can have, instead giving linear time at the cost of increased memory usage. "
"Use of this packrat option also allows direct and indirect recursion to "
"be handled in the parser without entering an infinite loop." }
{ $see-also compile parse packrat-parse packrat-call } ;
HELP: packrat-parse
{ $values
{ "input" "a string" }
{ "parser" "a parser" }
{ "result" "a parse-result or f" }
}
{ $description
"Compiles and calls the parser with a packrat cache in scope." }
{ $see-also compile parse packrat-call with-packrat } ;
HELP: packrat-call
{ $values
{ "input" "a string" }
{ "quot" "a quotation with stack effect ( input -- result )" }
{ "result" "a parse-result or f" }
}
{ $description
"Calls the compiled parser with a packrat cache in scope." }
{ $see-also compile packrat-call packrat-parse with-packrat } ;
HELP: compile
{ $values
@ -36,7 +58,7 @@ HELP: compile
"The mapping from parser to compiled word is kept in a cache. If you later change "
"the definition of a parser you'll need to clear this cache with "
{ $link reset-compiled-parsers } " before using " { $link compile } " on that parser again." }
{ $see-also compile with-packrat reset-compiled-parsers } ;
{ $see-also compile with-packrat reset-compiled-parsers packrat-call packrat-parse } ;
HELP: reset-compiled-parsers
{ $description

View File

@ -158,3 +158,41 @@ IN: peg.tests
"a]" "[" token hide "a" token "]" token hide 3array seq parse
] unit-test
{ V{ "1" "-" "1" } V{ "1" "+" "1" } } [
[
[ "1" token , "-" token , "1" token , ] seq* ,
[ "1" token , "+" token , "1" token , ] seq* ,
] choice*
"1-1" over parse parse-result-ast swap
"1+1" swap parse parse-result-ast
] unit-test
{ V{ "1" "-" "1" } V{ "1" "+" "1" } } [
[
[
[ "1" token , "-" token , "1" token , ] seq* ,
[ "1" token , "+" token , "1" token , ] seq* ,
] choice*
"1-1" over parse parse-result-ast swap
] with-packrat
[
"1+1" swap parse parse-result-ast
] with-packrat
] unit-test
: expr ( -- parser )
#! Test direct left recursion. Currently left recursion should cause a
#! failure of that parser.
[ expr ] delay "+" token "1" token 3seq "1" token 2choice ;
[
#! Not using packrat, so recursion causes data stack overflow
"1+1" expr parse parse-result-ast
] must-fail
{ "1" } [
#! Using packrat, so expr fails, causing the 2nd choice to be used.
"1+1" expr [ parse ] with-packrat parse-result-ast
] unit-test

View File

@ -24,13 +24,32 @@ SYMBOL: packrat
GENERIC: (compile) ( parser -- quot )
:: run-packrat-parser ( input quot c -- result )
input slice? [ input slice-from ] [ 0 ] if
quot c [ drop H{ } clone ] cache
[
drop input quot call
: input-from ( input -- n )
#! Return the index from the original string that the
#! input slice is based on.
dup slice? [ slice-from ] [ drop 0 ] if ;
: input-cache ( quot cache -- cache )
#! From the packrat cache, obtain the cache for the parser quotation
#! that maps the input string position to the parser result.
[ drop H{ } clone ] cache ;
:: cached-result ( n input-cache input quot -- result )
#! Get the cached result for input position n
#! from the input cache. If the item is not in the cache,
#! call 'quot' with 'input' on the stack to get the result
#! and store that in the cache and return it.
n input-cache [
drop
f n input-cache set-at
input quot call
] cache ; inline
:: run-packrat-parser ( input quot c -- result )
input input-from
quot c input-cache
input quot cached-result ; inline
: run-parser ( input quot -- result )
#! If a packrat cache is available, use memoization for
#! packrat parsing, otherwise do a standard peg call.
@ -48,11 +67,17 @@ GENERIC: (compile) ( parser -- quot )
[ compiled-parser ] with-compilation-unit ;
: parse ( state parser -- result )
compile execute ;
compile execute ; inline
: with-packrat ( quot -- result )
#! Run the quotation with a packrat cache active.
[ H{ } clone packrat ] dip with-variable ;
[ H{ } clone packrat ] dip with-variable ; inline
: packrat-parse ( state parser -- result )
[ parse ] with-packrat ;
: packrat-call ( state quot -- result )
with-packrat ; inline
<PRIVATE
@ -313,7 +338,7 @@ MEMO: 3seq ( parser1 parser2 parser3 -- parser )
MEMO: 4seq ( parser1 parser2 parser3 parser4 -- parser )
4array seq ;
MEMO: seq* ( quot -- paser )
: seq* ( quot -- paser )
{ } make seq ; inline
MEMO: choice ( seq -- parser )
@ -328,7 +353,7 @@ MEMO: 3choice ( parser1 parser2 parser3 -- parser )
MEMO: 4choice ( parser1 parser2 parser3 parser4 -- parser )
4array choice ;
MEMO: choice* ( quot -- paser )
: choice* ( quot -- paser )
{ } make choice ; inline
MEMO: repeat0 ( parser -- parser )