diff --git a/doc/ref/api-peg.texi b/doc/ref/api-peg.texi index b05a2cf85..4976b59c9 100644 --- a/doc/ref/api-peg.texi +++ b/doc/ref/api-peg.texi @@ -90,13 +90,13 @@ Tries to parse @var{a}. Succeeds if @var{a} succeeds. @code{(? a)} @end deftp -@deftp {PEG Pattern} {and predicate} a +@deftp {PEG Pattern} {followed by} a Makes sure it is possible to parse @var{a}, but does not actually parse it. Succeeds if @var{a} would succeed. @code{"&a"} -@code{(body & a 1)} +@code{(followed-by a)} @end deftp @deftp {PEG Pattern} {not predicate} a diff --git a/module/ice-9/peg/codegen.scm b/module/ice-9/peg/codegen.scm index 91e499d0c..22fb1953d 100644 --- a/module/ice-9/peg/codegen.scm +++ b/module/ice-9/peg/codegen.scm @@ -297,6 +297,25 @@ return EXP." #,(cggr (baf accum) 'cg-body #'(reverse body) #'new-end))))))))))) +(define (cg-followed-by 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 #,#'(= count 1))) + #,#`(and success + #,(cggr (baf accum) 'cg-body #''() #'at))))))))))) + ;; Association list of functions to handle different expressions as PEGs (define peg-compiler-alist '()) @@ -313,6 +332,7 @@ return EXP." (add-peg-compiler! '* cg-*) (add-peg-compiler! '+ cg-+) (add-peg-compiler! '? cg-?) +(add-peg-compiler! 'followed-by cg-followed-by) ;; Takes an arbitrary expressions and accumulation variable, then parses it. ;; E.g.: (peg-sexp-compile syntax '(and "abc" (or "-" (range #\a #\z))) 'all)