From bbc5564c423e8a080754f822831fdf44f3799a2c Mon Sep 17 00:00:00 2001
From: Noah Lavine <nlavine@haverford.edu>
Date: Mon, 28 Mar 2011 15:18:27 -0400
Subject: [PATCH] Separate PEG Concerns

* module/ice-9/peg/codegen.scm: peg-sexp-compile no longer knows about
   string PEGs
* module/ice-9/peg.scm: add a new function peg-extended-compile that
   calls peg-sexp-compile or peg-string-compile on its argument as
   appropriate
---
 module/ice-9/peg.scm         | 9 ++++++++-
 module/ice-9/peg/codegen.scm | 3 ---
 2 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/module/ice-9/peg.scm b/module/ice-9/peg.scm
index 4f4bbf877..58e35cef8 100644
--- a/module/ice-9/peg.scm
+++ b/module/ice-9/peg.scm
@@ -67,6 +67,13 @@ execute the STMTs and try again."
         #f
         (make-prec 0 (car res) string (string-collapse (cadr res))))))
 
+(define (peg-extended-compile pattern accum)
+  (syntax-case pattern (peg)
+    ((peg str)
+     (string? (syntax->datum #'str))
+     (peg-string-compile #'str (if (eq? accum 'all) 'body accum)))
+    (else (peg-sexp-compile pattern accum))))
+
 ;; The results of parsing using a nonterminal are cached.  Think of it like a
 ;; hash with no conflict resolution.  Process for deciding on the cache size
 ;; wasn't very scientific; just ran the benchmarks and stopped a little after
@@ -78,7 +85,7 @@ execute the STMTs and try again."
   (lambda (x)
     (syntax-case x ()
       ((_ sym accum pat)
-       (let ((matchf (peg-sexp-compile #'pat (syntax->datum #'accum)))
+       (let ((matchf (peg-extended-compile #'pat (syntax->datum #'accum)))
              (accumsym (syntax->datum #'accum))
              (c (datum->syntax x (gensym))));; the cache
          ;; CODE is the code to parse the string if the result isn't cached.
diff --git a/module/ice-9/peg/codegen.scm b/module/ice-9/peg/codegen.scm
index 0804d1ed4..8dd507cb7 100644
--- a/module/ice-9/peg/codegen.scm
+++ b/module/ice-9/peg/codegen.scm
@@ -164,9 +164,6 @@ return EXP."
      (peg-sexp-compile #'pat 'none))
     ((capture pat) ;; parse
      (peg-sexp-compile #'pat 'body))
-    ((peg pat)  ;; embedded PEG string
-     (string? (syntax->datum #'pat))
-     (peg-string-compile #'pat (baf accum)))
     ((and pat ...)
      (cg-and #'(pat ...) (baf accum)))
     ((or pat ...)