Handle compilation of circular parsers

extra/peg/peg-tests.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 !
-USING: kernel tools.test strings namespaces arrays sequences peg peg.private ;
+USING: kernel tools.test strings namespaces arrays sequences peg peg.private accessors words ;
 IN: peg.tests
 
 { f } [
@@ -196,3 +196,9 @@ IN: peg.tests
   "1+1" expr [ parse ] with-packrat parse-result-ast   
 ] unit-test
 
+{ t } [
+  #! Ensure a circular parser doesn't loop infinitely
+  [ f , "a" token , ] seq*
+  dup parsers>>
+  dupd 0 swap set-nth compile word?
+] unit-test

extra/peg/peg.factor

@@ -73,10 +73,14 @@ GENERIC: (compile) ( parser -- quot )
   #! Look to see if the given parser has been compiled.
   #! If not, compile it to a temporary word, cache it,
   #! and return it. Otherwise return the existing one.
-  compiled-parsers [
-    dup parser-body define-temp 
-    tuck swap "peg" set-word-prop
-  ] cache ;
+  #! Circular parsers are supported by getting the word
+  #! name and storing it in the cache, before compiling, 
+  #! so it is picked up when re-entered.
+  dup id>> compiled-parsers [
+    drop dup gensym swap 2dup id>> compiled-parsers set-at
+    2dup parser-body define 
+    dupd "peg" set-word-prop
+  ] cache nip ;
 
 : compile ( parser -- word )
   [ compiled-parser ] with-compilation-unit ;