Add 'followed-by' PEG

The PEG s-expression syntax now uses '(followed-by ...)' instead of
'(body & ... 1)'.

2 files changed, 22 insertions, 2 deletions

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)