mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-21 12:10:26 +02:00
Code Activity

Remove 'body' PEG

Browse source 
module/ice-9/peg/string-peg.scm: update S-expression generators to use the
  new *, +, ?, followed-by, and not-followed-by forms.
module/ice-9/peg/codegen.scm: remove the 'body' form in the PEG s-expression
  representation.
This commit is contained in:
Noah Lavine 2011-09-19 10:36:06 -04:00 • committed by Andy Wingo
parent 72287411e9
commit cdeb5a7826
2 changed files with 17 additions and 57 deletions
Download patch file Download diff file Expand all files Collapse all files

41
module/ice-9/peg/codegen.scm
View file

@ -197,46 +197,6 @@ return EXP."
#`(or (#,(peg-sexp-compile #'first accum) #,str #,strlen #,at) #`(or (#,(peg-sexp-compile #'first accum) #,str #,strlen #,at)
#,(cg-or-int #'(rest ...) accum str strlen at))))) #,(cg-or-int #'(rest ...) accum str strlen at)))))
;; Returns a function that parses a BODY element.
(define (cg-body args accum)
(syntax-case args ()
((type pat num)
#`(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)
#,(syntax-case #'num (+ * ?)
(n (number? (syntax->datum #'n))
#'(< count n))
(+ #t)
(* #t)
(? #'(< count 1))))
(lp new-end count)
(let ((success #,(syntax-case #'num (+ * ?)
(n (number? (syntax->datum #'n))
#'(= count n))
(+ #'(>= count 1))
(* #t)
(? #t))))
#,(syntax-case #'type (! & lit)
(!
#`(if success
#f
#,(cggr (baf accum) 'cg-body #''() #'at)))
(&
#`(and success
#,(cggr (baf accum) 'cg-body #''() #'at)))
(lit
#`(and success
#,(cggr (baf accum) 'cg-body
#'(reverse body) #'new-end)))))))))))))
(define (cg-* args accum) (define (cg-* args accum)
(syntax-case args () (syntax-case args ()
((pat) ((pat)
@ -348,7 +308,6 @@ return EXP."
(add-peg-compiler! 'capture cg-capture) (add-peg-compiler! 'capture cg-capture)
(add-peg-compiler! 'and cg-and) (add-peg-compiler! 'and cg-and)
(add-peg-compiler! 'or cg-or) (add-peg-compiler! 'or cg-or)
(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-?) (add-peg-compiler! '? cg-?)

33
module/ice-9/peg/string-peg.scm
View file

@ -154,26 +154,27 @@ RB < ']'
;; Parse a body. ;; Parse a body.
(define (peg-body->defn lst for-syntax) (define (peg-body->defn lst for-syntax)
(let ((suffix '())
(front (datum->syntax for-syntax 'lit)))
(cond (cond
((eq? (car lst) 'peg-suffix) ((equal? (car lst) "&")
(set! suffix lst)) #`(followed-by #,(peg-suffix->defn (cadr lst) for-syntax)))
((string? (car lst)) ((equal? (car lst) "!")
(begin (set! front (datum->syntax for-syntax #`(not-followed-by #,(peg-suffix->defn (cadr lst) for-syntax)))
(string->symbol (car lst)))) ((eq? (car lst) 'peg-suffix)
(set! suffix (cadr lst)))) (peg-suffix->defn lst for-syntax))
(else `(peg-parse-body-fail ,lst))) (else `(peg-parse-body-fail ,lst))))
#`(body #,front #,@(peg-suffix->defn
suffix
for-syntax))))
;; Parse a suffix. ;; Parse a suffix.
(define (peg-suffix->defn lst for-syntax) (define (peg-suffix->defn lst for-syntax)
#`(#,(peg-primary->defn (cadr lst) for-syntax) (let ((inner-defn (peg-primary->defn (cadr lst) for-syntax)))
#,(if (null? (cddr lst)) (cond
1 ((null? (cddr lst))
(datum->syntax for-syntax (string->symbol (caddr lst)))))) inner-defn)
((equal? (caddr lst) "*")
#`(* #,inner-defn))
((equal? (caddr lst) "?")
#`(? #,inner-defn))
((equal? (caddr lst) "+")
#`(+ #,inner-defn)))))
;; Parse a primary. ;; Parse a primary.
(define (peg-primary->defn lst for-syntax) (define (peg-primary->defn lst for-syntax)