mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

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

Browse source 
* 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
1 changed files with 13 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

27
module/ice-9/peg.scm
View file

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