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{"a?"}
|
||||||
|
|
||||||
@code{(body lit a ?)}
|
@code{(? a)}
|
||||||
@end deftp
|
@end deftp
|
||||||
|
|
||||||
@deftp {PEG Pattern} {and predicate} a
|
@deftp {PEG Pattern} {and predicate} a
|
||||||
|
|
|
@ -277,6 +277,26 @@ return EXP."
|
||||||
#,(cggr (baf accum) 'cg-body
|
#,(cggr (baf accum) 'cg-body
|
||||||
#'(reverse body) #'new-end)))))))))))
|
#'(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
|
;; Association list of functions to handle different expressions as PEGs
|
||||||
(define peg-compiler-alist '())
|
(define peg-compiler-alist '())
|
||||||
|
|
||||||
|
@ -292,6 +312,7 @@ return EXP."
|
||||||
(add-peg-compiler! 'body cg-body)
|
(add-peg-compiler! 'body cg-body)
|
||||||
(add-peg-compiler! '* cg-*)
|
(add-peg-compiler! '* cg-*)
|
||||||
(add-peg-compiler! '+ cg-+)
|
(add-peg-compiler! '+ cg-+)
|
||||||
|
(add-peg-compiler! '? cg-?)
|
||||||
|
|
||||||
;; Takes an arbitrary expressions and accumulation variable, then parses it.
|
;; Takes an arbitrary expressions and accumulation variable, then parses it.
|
||||||
;; E.g.: (peg-sexp-compile syntax '(and "abc" (or "-" (range #\a #\z))) 'all)
|
;; E.g.: (peg-sexp-compile syntax '(and "abc" (or "-" (range #\a #\z))) 'all)
|
||||||
|
|
|
@ -70,7 +70,7 @@ RB < ']'
|
||||||
(and peg-alternative
|
(and peg-alternative
|
||||||
(* (and (ignore "/") peg-sp peg-alternative))))
|
(* (and (ignore "/") peg-sp peg-alternative))))
|
||||||
(define-sexp-parser peg-alternative all
|
(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
|
(define-sexp-parser peg-suffix all
|
||||||
(and peg-primary (* (and (or "*" "+" "?") peg-sp))))
|
(and peg-primary (* (and (or "*" "+" "?") peg-sp))))
|
||||||
(define-sexp-parser peg-primary all
|
(define-sexp-parser peg-primary all
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue