diff --git a/doc/ref/api-peg.texi b/doc/ref/api-peg.texi index c2b4cfc2d..b05a2cf85 100644 --- a/doc/ref/api-peg.texi +++ b/doc/ref/api-peg.texi @@ -87,7 +87,7 @@ Tries to parse @var{a}. Succeeds if @var{a} succeeds. @code{"a?"} -@code{(body lit a ?)} +@code{(? a)} @end deftp @deftp {PEG Pattern} {and predicate} a diff --git a/module/ice-9/peg/codegen.scm b/module/ice-9/peg/codegen.scm index 2a61324f6..91e499d0c 100644 --- a/module/ice-9/peg/codegen.scm +++ b/module/ice-9/peg/codegen.scm @@ -277,6 +277,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) + #,#'(< count 1)) + (lp new-end count) + (let ((success #,#t)) + #,#`(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 '()) @@ -292,6 +312,7 @@ return EXP." (add-peg-compiler! 'body cg-body) (add-peg-compiler! '* cg-*) (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 4f6c6cd53..ccd405656 100644 --- a/module/ice-9/peg/string-peg.scm +++ b/module/ice-9/peg/string-peg.scm @@ -70,7 +70,7 @@ RB < ']' (and peg-alternative (* (and (ignore "/") peg-sp peg-alternative)))) (define-sexp-parser peg-alternative all - (+ (and (body lit (or "!" "&") ?) peg-sp peg-suffix))) + (+ (and (? (or "!" "&")) peg-sp peg-suffix))) (define-sexp-parser peg-suffix all (and peg-primary (* (and (or "*" "+" "?") peg-sp)))) (define-sexp-parser peg-primary all