diff options
author | Noah Lavine <nlavine@haverford.edu> | 2011-09-19 10:26:56 -0400 |
---|---|---|
committer | Noah Lavine <noah.b.lavine@gmail.com> | 2012-01-20 08:27:14 -0500 |
commit | 7e896619f22c2b521bdfafa030af93e6f4928bed (patch) | |
tree | ef4d387682946b4b0bd8e883927ac4aee4a09db6 | |
parent | 6724915c8f55c5e84ef5080abe7c9cb250bdef79 (diff) | |
download | guile-7e896619f22c2b521bdfafa030af93e6f4928bed.tar.gz |
Add '+' PEG
The PEG s-expression syntax now uses '(+ ...)' instead of '(body lit ... +)'.
-rw-r--r-- | doc/ref/api-peg.texi | 2 | ||||
-rw-r--r-- | module/ice-9/peg/codegen.scm | 21 | ||||
-rw-r--r-- | module/ice-9/peg/string-peg.scm | 6 |
3 files changed, 25 insertions, 4 deletions
diff --git a/doc/ref/api-peg.texi b/doc/ref/api-peg.texi index 63387f463..c2b4cfc2d 100644 --- a/doc/ref/api-peg.texi +++ b/doc/ref/api-peg.texi @@ -79,7 +79,7 @@ least one @var{a} was parsed. @code{"a+"} -@code{(body lit a +)} +@code{(+ a)} @end deftp @deftp {PEG Pattern} optional a diff --git a/module/ice-9/peg/codegen.scm b/module/ice-9/peg/codegen.scm index 9ef3a407c..2a61324f6 100644 --- a/module/ice-9/peg/codegen.scm +++ b/module/ice-9/peg/codegen.scm @@ -257,6 +257,26 @@ return EXP." #,(cggr (baf accum) 'cg-body #'(reverse body) #'new-end))))))))))) +(define (cg-+ args accum) + (syntax-case args () + ((pat) + #`(lambda (str strlen at) + (let ((body '())) + (let lp ((end at) (count 0)) + (let* ((match (#,(peg-sexp-compile #'pat (baf accum)) + str strlen end)) + (new-end (if match (car match) end)) + (count (if (> new-end end) (1+ count) count))) + (if (> new-end end) + (push-not-null! body (single-filter (cadr match)))) + (if (and (> new-end end) + #,#t) + (lp new-end count) + (let ((success #,#'(>= count 1))) + #,#`(and success + #,(cggr (baf accum) 'cg-body + #'(reverse body) #'new-end))))))))))) + ;; Association list of functions to handle different expressions as PEGs (define peg-compiler-alist '()) @@ -271,6 +291,7 @@ return EXP." (add-peg-compiler! 'or cg-or) (add-peg-compiler! 'body cg-body) (add-peg-compiler! '* cg-*) +(add-peg-compiler! '+ cg-+) ;; Takes an arbitrary expressions and accumulation variable, then parses it. ;; E.g.: (peg-sexp-compile syntax '(and "abc" (or "-" (range #\a #\z))) 'all) diff --git a/module/ice-9/peg/string-peg.scm b/module/ice-9/peg/string-peg.scm index 390394649..4f6c6cd53 100644 --- a/module/ice-9/peg/string-peg.scm +++ b/module/ice-9/peg/string-peg.scm @@ -65,12 +65,12 @@ RB < ']' #`(define sym #,syn)))))) (define-sexp-parser peg-grammar all - (body lit (and peg-nonterminal (or "<--" "<-" "<") peg-sp peg-pattern) +)) + (+ (and peg-nonterminal (or "<--" "<-" "<") peg-sp peg-pattern))) (define-sexp-parser peg-pattern all (and peg-alternative (* (and (ignore "/") peg-sp peg-alternative)))) (define-sexp-parser peg-alternative all - (body lit (and (body lit (or "!" "&") ?) peg-sp peg-suffix) +)) + (+ (and (body lit (or "!" "&") ?) peg-sp peg-suffix))) (define-sexp-parser peg-suffix all (and peg-primary (* (and (or "*" "+" "?") peg-sp)))) (define-sexp-parser peg-primary all @@ -90,7 +90,7 @@ RB < ']' (define-sexp-parser charclass-range all (and peg-any "-" peg-any)) (define-sexp-parser charclass-single all peg-any) (define-sexp-parser peg-nonterminal all - (and (body lit (or (range #\a #\z) (range #\A #\Z) (range #\0 #\9) "-") +) peg-sp)) + (and (+ (or (range #\a #\z) (range #\A #\Z) (range #\0 #\9) "-")) peg-sp)) (define-sexp-parser peg-sp none (* (or " " "\t" "\n"))) |