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