From 22d4c9d99af1d3a1e5587055b5e885d25209984b Mon Sep 17 00:00:00 2001
From: Noah Lavine <nlavine@haverford.edu>
Date: Fri, 1 Apr 2011 19:45:54 -0400
Subject: [PATCH] PEG Cache Module

* module/ice-9/peg/cache.scm: add module to hold cache logic for PEG
   parsers
* module/ice-9/peg.scm: move cache logic out of here
---
 module/ice-9/peg.scm       | 23 +++----------------
 module/ice-9/peg/cache.scm | 45 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 48 insertions(+), 20 deletions(-)
 create mode 100644 module/ice-9/peg/cache.scm

diff --git a/module/ice-9/peg.scm b/module/ice-9/peg.scm
index 730e048da..c1b4e406f 100644
--- a/module/ice-9/peg.scm
+++ b/module/ice-9/peg.scm
@@ -26,6 +26,7 @@
   #:use-module (ice-9 peg string-peg)
   #:use-module (ice-9 peg simplify-tree)
   #:use-module (ice-9 peg match-record)
+  #:use-module (ice-9 peg cache)
   #:re-export (peg-sexp-compile
                define-grammar
                define-grammar-f
@@ -65,34 +66,16 @@ execute the STMTs and try again."
         #f
         (make-prec 0 (car res) string (string-collapse (cadr res))))))
 
-;; 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
-;; the point of diminishing returns on my box.
-(define *cache-size* 512)
-
 ;; Defines a new nonterminal symbol accumulating with ACCUM.
 (define-syntax define-nonterm
   (lambda (x)
     (syntax-case x ()
       ((_ sym accum pat)
        (let ((matchf (peg-sexp-compile #'pat (syntax->datum #'accum)))
-             (accumsym (syntax->datum #'accum))
-             (c (datum->syntax x (gensym))));; the cache
+             (accumsym (syntax->datum #'accum)))
          ;; CODE is the code to parse the string if the result isn't cached.
          (let ((syn (wrap-parser-for-users x matchf accumsym #'sym)))
-           #`(begin
-               (define #,c (make-vector *cache-size* #f));; the cache
-               (define (sym str strlen at)
-                 (let* ((vref (vector-ref #,c (modulo at *cache-size*))))
-                   ;; Check to see whether the value is cached.
-                   (if (and vref (eq? (car vref) str) (= (cadr vref) at))
-                       (caddr vref);; If it is return it.
-                       (let ((fres ;; Else calculate it and cache it.
-                              (#,syn str strlen at)))
-                         (vector-set! #,c (modulo at *cache-size*)
-                                      (list str at fres))
-                         fres)))))))))))
+           #`(define sym #,(cg-cached-parser syn))))))))
 
 (define (peg-like->peg pat)
   (syntax-case pat ()
diff --git a/module/ice-9/peg/cache.scm b/module/ice-9/peg/cache.scm
new file mode 100644
index 000000000..f45432b35
--- /dev/null
+++ b/module/ice-9/peg/cache.scm
@@ -0,0 +1,45 @@
+;;;; cache.scm --- cache the results of parsing
+;;;;
+;;;; 	Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+;;;;
+
+(define-module (ice-9 peg cache)
+  #:export (cg-cached-parser))
+
+;; 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
+;; the point of diminishing returns on my box.
+(define *cache-size* 512)
+
+(define (make-cache)
+  (make-vector *cache-size* #f))
+
+;; given a syntax object which is a parser function, returns syntax
+;; which, if evaluated, will become a parser function that uses a cache.
+(define (cg-cached-parser parser)
+  #`(let ((cache (make-cache)))
+      (lambda (str strlen at)
+        (let* ((vref (vector-ref cache (modulo at *cache-size*))))
+          ;; Check to see whether the value is cached.
+          (if (and vref (eq? (car vref) str) (= (cadr vref) at))
+              (caddr vref);; If it is return it.
+              (let ((fres ;; Else calculate it and cache it.
+                     (#,parser str strlen at)))
+                (vector-set! cache (modulo at *cache-size*)
+                             (list str at fres))
+                fres))))))