mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
Add 'not-followed-by' PEG
The PEG s-expression syntax now uses '(not-followed-by ...)' instead of '(body ! ... 1)'.
This commit is contained in:
parent
66ba3de0a6
commit
72287411e9
3 changed files with 26 additions and 5 deletions
|
@ -99,13 +99,13 @@ it. Succeeds if @var{a} would succeed.
|
||||||
@code{(followed-by a)}
|
@code{(followed-by a)}
|
||||||
@end deftp
|
@end deftp
|
||||||
|
|
||||||
@deftp {PEG Pattern} {not predicate} a
|
@deftp {PEG Pattern} {not followed by} a
|
||||||
Makes sure it is impossible to parse @var{a}, but does not actually
|
Makes sure it is impossible to parse @var{a}, but does not actually
|
||||||
parse it. Succeeds if @var{a} would fail.
|
parse it. Succeeds if @var{a} would fail.
|
||||||
|
|
||||||
@code{"!a"}
|
@code{"!a"}
|
||||||
|
|
||||||
@code{(body ! a 1)}
|
@code{(not-followed-by a)}
|
||||||
@end deftp
|
@end deftp
|
||||||
|
|
||||||
@deftp {PEG Pattern} {string literal} ``abc''
|
@deftp {PEG Pattern} {string literal} ``abc''
|
||||||
|
|
|
@ -316,6 +316,26 @@ return EXP."
|
||||||
#,#`(and success
|
#,#`(and success
|
||||||
#,(cggr (baf accum) 'cg-body #''() #'at)))))))))))
|
#,(cggr (baf accum) 'cg-body #''() #'at)))))))))))
|
||||||
|
|
||||||
|
(define (cg-not-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)))
|
||||||
|
#,#`(if success
|
||||||
|
#f
|
||||||
|
#,(cggr (baf accum) 'cg-body #''() #'at)))))))))))
|
||||||
|
|
||||||
;; 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 '())
|
||||||
|
|
||||||
|
@ -333,6 +353,7 @@ return EXP."
|
||||||
(add-peg-compiler! '+ cg-+)
|
(add-peg-compiler! '+ cg-+)
|
||||||
(add-peg-compiler! '? cg-?)
|
(add-peg-compiler! '? cg-?)
|
||||||
(add-peg-compiler! 'followed-by cg-followed-by)
|
(add-peg-compiler! 'followed-by cg-followed-by)
|
||||||
|
(add-peg-compiler! 'not-followed-by cg-not-followed-by)
|
||||||
|
|
||||||
;; 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)
|
||||||
|
|
|
@ -78,12 +78,12 @@ RB < ']'
|
||||||
(and "." peg-sp)
|
(and "." peg-sp)
|
||||||
peg-literal
|
peg-literal
|
||||||
peg-charclass
|
peg-charclass
|
||||||
(and peg-nonterminal (body ! "<" 1))))
|
(and peg-nonterminal (not-followed-by "<"))))
|
||||||
(define-sexp-parser peg-literal all
|
(define-sexp-parser peg-literal all
|
||||||
(and "'" (* (and (body ! "'" 1) peg-any)) "'" peg-sp))
|
(and "'" (* (and (not-followed-by "'") peg-any)) "'" peg-sp))
|
||||||
(define-sexp-parser peg-charclass all
|
(define-sexp-parser peg-charclass all
|
||||||
(and (ignore "[")
|
(and (ignore "[")
|
||||||
(* (and (body ! "]" 1)
|
(* (and (not-followed-by "]")
|
||||||
(or charclass-range charclass-single)))
|
(or charclass-range charclass-single)))
|
||||||
(ignore "]")
|
(ignore "]")
|
||||||
peg-sp))
|
peg-sp))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue