Rip out packrat stuff

It was broken since the transition to generating compiled quotations. As far as I know, no one was using packrat-parse anyway.
Rework in progress...

extra/peg/parsers/parsers.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences strings namespaces math assocs shuffle 
-     vectors arrays combinators.lib memoize math.parser match
+     vectors arrays combinators.lib math.parser match
      unicode.categories sequences.deep peg peg.private 
      peg.search math.ranges ;
 IN: peg.parsers
@@ -19,26 +19,26 @@ TUPLE: just-parser p1 ;
 M: just-parser compile ( parser -- quot )
   just-parser-p1 compile just-pattern append ;
 
-MEMO: just ( parser -- parser )
+: just ( parser -- parser )
-  just-parser construct-boa init-parser ;
+  just-parser construct-boa ;
 
-MEMO: 1token ( ch -- parser ) 1string token ;
+: 1token ( ch -- parser ) 1string token ;
 
 <PRIVATE
-MEMO: (list-of) ( items separator repeat1? -- parser )
+: (list-of) ( items separator repeat1? -- parser )
   >r over 2seq r> [ repeat1 ] [ repeat0 ] if [ concat ] action 2seq
   [ unclip 1vector swap first append ] action ;
 PRIVATE>
 
-MEMO: list-of ( items separator -- parser )
+: list-of ( items separator -- parser )
   hide f (list-of) ;
 
-MEMO: list-of-many ( items separator -- parser )
+: list-of-many ( items separator -- parser )
   hide t (list-of) ;
 
-MEMO: epsilon ( -- parser ) V{ } token ;
+: epsilon ( -- parser ) V{ } token ;
 
-MEMO: any-char ( -- parser ) [ drop t ] satisfy ;
+: any-char ( -- parser ) [ drop t ] satisfy ;
 
 <PRIVATE
 
@@ -47,10 +47,10 @@ MEMO: any-char ( -- parser ) [ drop t ] satisfy ;
 
 PRIVATE>
 
-MEMO: exactly-n ( parser n -- parser' )
+: exactly-n ( parser n -- parser' )
   swap <repetition> seq ;
 
-MEMO: at-most-n ( parser n -- parser' )
+: at-most-n ( parser n -- parser' )
   dup zero? [
     2drop epsilon
   ] [
@@ -58,27 +58,27 @@ MEMO: at-most-n ( parser n -- parser' )
     -rot 1- at-most-n 2choice
   ] if ;
 
-MEMO: at-least-n ( parser n -- parser' )
+: at-least-n ( parser n -- parser' )
   dupd exactly-n swap repeat0 2seq
   [ flatten-vectors ] action ;
 
-MEMO: from-m-to-n ( parser m n -- parser' )
+: from-m-to-n ( parser m n -- parser' )
   >r [ exactly-n ] 2keep r> swap - at-most-n 2seq
   [ flatten-vectors ] action ;
 
-MEMO: pack ( begin body end -- parser )
+: pack ( begin body end -- parser )
   >r >r hide r> r> hide 3seq [ first ] action ;
 
-MEMO: surrounded-by ( parser begin end -- parser' )
+: surrounded-by ( parser begin end -- parser' )
   [ token ] 2apply swapd pack ;
 
-MEMO: 'digit' ( -- parser )
+: 'digit' ( -- parser )
   [ digit? ] satisfy [ digit> ] action ;
 
-MEMO: 'integer' ( -- parser )
+: 'integer' ( -- parser )
   'digit' repeat1 [ 10 digits>integer ] action ;
 
-MEMO: 'string' ( -- parser )
+: 'string' ( -- parser )
   [
     [ CHAR: " = ] satisfy hide ,
     [ CHAR: " = not ] satisfy repeat0 ,
@@ -97,7 +97,7 @@ MEMO: 'string' ( -- parser )
   ] action
   replace ;
 
-MEMO: range-pattern ( pattern -- parser )
+: range-pattern ( pattern -- parser )
   #! 'pattern' is a set of characters describing the
   #! parser to be produced. Any single character in
   #! the pattern matches that character. If the pattern

extra/peg/peg-tests.factor

@@ -4,10 +4,6 @@
 USING: kernel tools.test strings namespaces arrays sequences peg peg.private ;
 IN: peg.tests
 
-{ 0 1 2 } [
-  0 next-id set-global get-next-id get-next-id get-next-id 
-] unit-test
-
 { f } [
   "endbegin" "begin" token parse
 ] unit-test

extra/peg/peg.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences strings namespaces math assocs shuffle 
-       vectors arrays combinators.lib memoize math.parser match
+       vectors arrays combinators.lib math.parser match
        unicode.categories sequences.lib compiler.units parser
        words ;
 IN: peg
@@ -10,70 +10,14 @@ TUPLE: parse-result remaining ast ;
 
 GENERIC: compile ( parser -- quot )
 
-: (parse) ( state parser -- result )
+: parse ( state parser -- result )
   compile call ;
 
-
-<PRIVATE
-
-SYMBOL: packrat-cache
 SYMBOL: ignore 
-SYMBOL: not-in-cache
-
-: not-in-cache? ( result -- ? )
-  not-in-cache = ;
 
 : <parse-result> ( remaining ast -- parse-result )
   parse-result construct-boa ;
 
-SYMBOL: next-id 
-
-: get-next-id ( -- number )
-  next-id get-global 0 or dup 1+ next-id set-global ;
-
-TUPLE: parser id ;
-
-: init-parser ( parser -- parser )
-  get-next-id parser construct-boa over set-delegate ;
-
-: from ( slice-or-string -- index )
-  dup slice? [ slice-from ] [ drop 0 ] if ;
-
-: get-cached ( input parser -- result )
-  [ from ] dip parser-id packrat-cache get at at* [ 
-    drop not-in-cache 
-  ] unless ;
-
-: put-cached ( result input parser -- )
-  parser-id dup packrat-cache get at [ 
-    nip
-  ] [ 
-    H{ } clone dup >r swap packrat-cache get set-at r>
-  ] if* 
-  [ from ] dip set-at ;
-
-PRIVATE>
-
-: parse ( input parser -- result )
-  packrat-cache get [
-    2dup get-cached dup not-in-cache? [ 
-!      "cache missed: " write over parser-id number>string write " - " write nl ! pick .
-      drop 
-      #! Protect against left recursion blowing the callstack
-      #! by storing a failed parse in the cache.
-      [ f ] dipd  [ put-cached ] 2keep
-      [ (parse) dup ] 2keep put-cached
-    ] [ 
-!      "cache hit: " write over parser-id number>string write " - " write nl ! pick . 
-      2nip
-    ] if
-  ] [
-    (parse)
-  ] if ;
-
-: packrat-parse ( input parser -- result )
-  H{ } clone packrat-cache [ parse ] with-variable ;
-
 <PRIVATE
 
 TUPLE: token-parser symbol ;
@@ -295,17 +239,17 @@ M: delay-parser compile ( parser -- quot )
 
 PRIVATE>
 
-MEMO: token ( string -- parser )
+: token ( string -- parser )
-  token-parser construct-boa init-parser ;      
+  token-parser construct-boa ;      
 
 : satisfy ( quot -- parser )
-  satisfy-parser construct-boa init-parser ;
+  satisfy-parser construct-boa ;
 
-MEMO: range ( min max -- parser )
+: range ( min max -- parser )
-  range-parser construct-boa init-parser ;
+  range-parser construct-boa ;
 
 : seq ( seq -- parser )
-  seq-parser construct-boa init-parser ;
+  seq-parser construct-boa ;
 
 : 2seq ( parser1 parser2 -- parser )
   2array seq ;
@@ -320,7 +264,7 @@ MEMO: range ( min max -- parser )
   { } make seq ; inline 
 
 : choice ( seq -- parser )
-  choice-parser construct-boa init-parser ;
+  choice-parser construct-boa ;
 
 : 2choice ( parser1 parser2 -- parser )
   2array choice ;
@@ -334,32 +278,32 @@ MEMO: range ( min max -- parser )
 : choice* ( quot -- paser )
   { } make choice ; inline 
 
-MEMO: repeat0 ( parser -- parser )
+: repeat0 ( parser -- parser )
-  repeat0-parser construct-boa init-parser ;
+  repeat0-parser construct-boa ;
 
-MEMO: repeat1 ( parser -- parser )
+: repeat1 ( parser -- parser )
-  repeat1-parser construct-boa init-parser ;
+  repeat1-parser construct-boa ;
 
-MEMO: optional ( parser -- parser )
+: optional ( parser -- parser )
-  optional-parser construct-boa init-parser ;
+  optional-parser construct-boa ;
 
-MEMO: ensure ( parser -- parser )
+: ensure ( parser -- parser )
-  ensure-parser construct-boa init-parser ;
+  ensure-parser construct-boa ;
 
-MEMO: ensure-not ( parser -- parser )
+: ensure-not ( parser -- parser )
-  ensure-not-parser construct-boa init-parser ;
+  ensure-not-parser construct-boa ;
 
 : action ( parser quot -- parser )
-  action-parser construct-boa init-parser ;
+  action-parser construct-boa ;
 
-MEMO: sp ( parser -- parser )
+: sp ( parser -- parser )
-  sp-parser construct-boa init-parser ;
+  sp-parser construct-boa ;
 
-MEMO: hide ( parser -- parser )
+: hide ( parser -- parser )
   [ drop ignore ] action ;
 
-MEMO: delay ( quot -- parser )
+: delay ( quot -- parser )
-  delay-parser construct-boa init-parser ;
+  delay-parser construct-boa ;
 
 : PEG:
   (:) [