mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

PEG Cache Module

Browse source 
* 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
This commit is contained in:
Noah Lavine 2011-04-01 19:45:54 -04:00 • committed by Andy Wingo
parent 172ac609c4
commit 22d4c9d99a
2 changed files with 48 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

23
module/ice-9/peg.scm
View file

@ -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 ()

45
module/ice-9/peg/cache.scm Normal file
View file

@ -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))))))