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

extra/peg/ebnf/ebnf-tests.factor

@@ -143,3 +143,31 @@ IN: peg.ebnf.tests
 { f } [
   "Z" [EBNF foo=[^A-Z] EBNF] call  
 ] 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

extra/peg/ebnf/ebnf.factor

@@ -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

extra/peg/peg-docs.factor

@@ -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."  } 
+    "can have, instead giving linear time at the cost of increased memory usage. "
-{ $see-also compile parse } ;
+    "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 

extra/peg/peg-tests.factor

@@ -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
+

extra/peg/peg.factor

@@ -24,13 +24,32 @@ SYMBOL: packrat
 
 GENERIC: (compile) ( parser -- quot )
 
-:: run-packrat-parser ( input quot c -- result )
+: input-from ( input -- n )
-  input slice? [ input slice-from ] [ 0 ] if
+  #! Return the index from the original string that the
-  quot c [ drop H{ } clone ] cache 
+  #! input slice is based on.
-  [
+  dup slice? [ slice-from ] [ drop 0 ] if ;
-    drop input quot call  
+
+: 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 )