summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNoah Lavine <nlavine@haverford.edu>2011-03-31 17:42:36 -0400
committerAndy Wingo <wingo@pobox.com>2013-01-16 10:11:44 +0100
commit172ac609c4580bb73094fffaf8abee8d727d4be1 (patch)
treeab975ec57075e255c727535345233726e9fb6ab6
parent94e8517c16f75466d0e1ab8f9bcf9473dd28b15f (diff)
downloadguile-172ac609c4580bb73094fffaf8abee8d727d4be1.tar.gz
Update String PEGs
* module/ice-9/peg/string-peg.scm: use new interface for extending PEG syntax * module/ice-9/peg.scm: remove peg-extended-compile
-rw-r--r--module/ice-9/peg.scm20
-rw-r--r--module/ice-9/peg/string-peg.scm25
2 files changed, 22 insertions, 23 deletions
diff --git a/module/ice-9/peg.scm b/module/ice-9/peg.scm
index 58e35cef8..730e048da 100644
--- a/module/ice-9/peg.scm
+++ b/module/ice-9/peg.scm
@@ -22,7 +22,6 @@
define-nonterm
; define-nonterm-f
peg-match)
-; #:export-syntax (define-nonterm)
#:use-module (ice-9 peg codegen)
#:use-module (ice-9 peg string-peg)
#:use-module (ice-9 peg simplify-tree)
@@ -30,7 +29,6 @@
#:re-export (peg-sexp-compile
define-grammar
define-grammar-f
-; define-nonterm
keyword-flatten
context-flatten
peg:start
@@ -67,13 +65,6 @@ 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
@@ -85,7 +76,7 @@ execute the STMTs and try again."
(lambda (x)
(syntax-case x ()
((_ sym accum pat)
- (let ((matchf (peg-extended-compile #'pat (syntax->datum #'accum)))
+ (let ((matchf (peg-sexp-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.
@@ -103,6 +94,11 @@ execute the STMTs and try again."
(list str at fres))
fres)))))))))))
+(define (peg-like->peg pat)
+ (syntax-case pat ()
+ (str (string? (syntax->datum #'str)) #'(peg str))
+ (else pat)))
+
;; Searches through STRING for something that parses to PEG-MATCHER. Think
;; regexp search.
(define-syntax peg-match
@@ -110,9 +106,7 @@ execute the STMTs and try again."
(syntax-case x ()
((_ pattern string-uncopied)
(let ((pmsym (syntax->datum #'pattern)))
- (let ((matcher (if (string? (syntax->datum #'pattern))
- (peg-string-compile #'pattern 'body)
- (peg-sexp-compile #'pattern 'body))))
+ (let ((matcher (peg-sexp-compile (peg-like->peg #'pattern) 'body)))
;; We copy the string before using it because it might have been
;; modified in-place since the last time it was parsed, which would
;; invalidate the cache. Guile uses copy-on-write for strings, so
diff --git a/module/ice-9/peg/string-peg.scm b/module/ice-9/peg/string-peg.scm
index a899727b4..181ec0530 100644
--- a/module/ice-9/peg/string-peg.scm
+++ b/module/ice-9/peg/string-peg.scm
@@ -18,8 +18,7 @@
;;;;
(define-module (ice-9 peg string-peg)
- #:export (peg-string-compile
- peg-as-peg
+ #:export (peg-as-peg
define-grammar
define-grammar-f
peg-grammar)
@@ -248,11 +247,17 @@ RB < ']'
(compressor-core (syntax->datum syn))))
;; Builds a lambda-expressions for the pattern STR using accum.
-(define (peg-string-compile str-stx accum)
- (let ((string (syntax->datum str-stx)))
- (peg-sexp-compile
- (compressor
- (peg-pattern->defn
- (peg:tree (peg-parse peg-pattern string)) str-stx)
- str-stx)
- accum)))
+(define (peg-string-compile args accum)
+ (syntax-case args ()
+ ((str-stx) (string? (syntax->datum #'str-stx))
+ (let ((string (syntax->datum #'str-stx)))
+ (peg-sexp-compile
+ (compressor
+ (peg-pattern->defn
+ (peg:tree (peg-parse peg-pattern string)) #'str-stx)
+ #'str-stx)
+ (if (eq? accum 'all) 'body accum))))
+ (else (error "Bad embedded PEG string" args))))
+
+(add-peg-compiler! 'peg peg-string-compile)
+