mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
Add '?' PEG
The PEG s-expression syntax now uses '(? ...)' instead of '(body lit ... ?)'.
This commit is contained in:
parent
3d19969d74
commit
8e97edd5d3
3 changed files with 23 additions and 2 deletions
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue