mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Add 'followed-by' PEG
The PEG s-expression syntax now uses '(followed-by ...)' instead of '(body & ... 1)'.
This commit is contained in:
parent
8e97edd5d3
commit
66ba3de0a6
2 changed files with 22 additions and 2 deletions
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue