1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 13:30:26 +02:00

peg: cg-or, cg-or-int return syntax

* module/ice-9/peg.scm (cg-or, cg-or-int): Return syntax instead of
  s-expressions.
  (peg-sexp-compile): Adapt.
This commit is contained in:
Noah Lavine 2011-01-31 15:08:32 -05:00 committed by Andy Wingo
parent 00e227f779
commit 8e8de46ec6

View file

@ -276,8 +276,7 @@
((eq? (car match) 'and)
(cg-and for-syntax (cdr match) (baf accum)))
((eq? (car match) 'or)
(datum->syntax for-syntax
(cg-or for-syntax (cdr match) (baf accum))))
(cg-or for-syntax (cdr match) (baf accum)))
((eq? (car match) 'body)
(if (not (= (length match) 4))
(datum->syntax for-syntax
@ -331,23 +330,23 @@
;; Top-level function builder for OR. Reduces to a call to CG-OR-INT.
(define (cg-or for-syntax arglst accum)
(safe-bind
(str strlen at body)
`(lambda (,str ,strlen ,at)
,(cg-or-int for-syntax arglst accum str strlen at body))))
(let ((str (syntax str))
(strlen (syntax strlen))
(at (syntax at))
(body (syntax body)))
#`(lambda (#,str #,strlen #,at)
#,(cg-or-int for-syntax arglst accum str strlen at body))))
;; Internal function builder for OR (calls itself).
(define (cg-or-int for-syntax arglst accum str strlen at body)
(safe-bind
(res)
(let ((res (syntax res)))
(if (null? arglst)
#f ;; base case
(let ((mf (syntax->datum
(peg-sexp-compile for-syntax (car arglst) accum))))
`(let ((,res (,mf ,str ,strlen ,at)))
(if ,res ;; if the match succeeds, we're done
,(cggr for-syntax accum 'cg-or `(cadr ,res) `(car ,res))
,(cg-or-int for-syntax (cdr arglst) accum str strlen at body)))))))
(let ((mf (peg-sexp-compile for-syntax (car arglst) accum)))
#`(let ((#,res (#,mf #,str #,strlen #,at)))
(if #,res ;; if the match succeeds, we're done
#,(cggr-syn for-syntax accum 'cg-or #`(cadr #,res) #`(car #,res))
#,(cg-or-int for-syntax (cdr arglst) accum str strlen at body)))))))
;; Returns a block of code that tries to match MATCH, and on success updates AT
;; and BODY, return #f on failure and #t on success.