module/ice-9/peg/cache.scm

   1 ;;;; cache.scm --- cache the results of parsing
   2 ;;;;
   3 ;;;;    Copyright (C) 2010, 2011 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This library is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU Lesser General Public
   7 ;;;; License as published by the Free Software Foundation; either
   8 ;;;; version 3 of the License, or (at your option) any later version.
   9 ;;;;
  10 ;;;; This library is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; Lesser General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU Lesser General Public
  16 ;;;; License along with this library; if not, write to the Free Software
  17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18 ;;;;
  19
  20 (define-module (ice-9 peg cache)
  21   #:export (cg-cached-parser))
  22
  23 ;; The results of parsing using a nonterminal are cached.  Think of it like a
  24 ;; hash with no conflict resolution.  Process for deciding on the cache size
  25 ;; wasn't very scientific; just ran the benchmarks and stopped a little after
  26 ;; the point of diminishing returns on my box.
  27 (define *cache-size* 512)
  28
  29 (define (make-cache)
  30   (make-vector *cache-size* #f))
  31
  32 ;; given a syntax object which is a parser function, returns syntax
  33 ;; which, if evaluated, will become a parser function that uses a cache.
  34 (define (cg-cached-parser parser)
  35   #`(let ((cache (make-cache)))
  36       (lambda (str strlen at)
  37         (let* ((vref (vector-ref cache (modulo at *cache-size*))))
  38           ;; Check to see whether the value is cached.
  39           (if (and vref (eq? (car vref) str) (= (cadr vref) at))
  40               (caddr vref);; If it is return it.
  41               (let ((fres ;; Else calculate it and cache it.
  42                      (#,parser str strlen at)))
  43                 (vector-set! cache (modulo at *cache-size*)
  44                              (list str at fres))
  45                 fres))))))