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

peg: hygiene in cg-and, cg-and-int

Browse source 
* module/ice-9/peg.scm (cg-and, cg-and-int): Use cggr-syn instead of
  cggr, and also return syntax now instead of s-expressions.
This commit is contained in:
Noah Lavine 2011-01-31 15:04:59 -05:00 • committed by Andy Wingo
parent 8b52357e88
commit 00e227f779
1 changed files with 21 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -265,7 +265,6 @@
;; anything besides a string, symbol, or list is an error ;; anything besides a string, symbol, or list is an error
(datum->syntax for-syntax (datum->syntax for-syntax
(error-val `(peg-sexp-compile-error-1 ,match ,accum)))) (error-val `(peg-sexp-compile-error-1 ,match ,accum))))
((eq? (car match) 'range) ;; range of characters (e.g. [a-z]) ((eq? (car match) 'range) ;; range of characters (e.g. [a-z])
(cg-range for-syntax (cadr match) (caddr match) (baf accum))) (cg-range for-syntax (cadr match) (caddr match) (baf accum)))
((eq? (car match) 'ignore) ;; match but don't parse ((eq? (car match) 'ignore) ;; match but don't parse
@ -275,8 +274,7 @@
((eq? (car match) 'peg) ;; embedded PEG string ((eq? (car match) 'peg) ;; embedded PEG string
(peg-string-compile for-syntax (cadr match) (baf accum))) (peg-string-compile for-syntax (cadr match) (baf accum)))
((eq? (car match) 'and) ((eq? (car match) 'and)
(datum->syntax for-syntax (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 (datum->syntax for-syntax
(cg-or for-syntax (cdr match) (baf accum)))) (cg-or for-syntax (cdr match) (baf accum))))
@ -305,29 +303,31 @@
;; Top-level function builder for AND. Reduces to a call to CG-AND-INT. ;; Top-level function builder for AND. Reduces to a call to CG-AND-INT.
(define (cg-and for-syntax arglst accum) (define (cg-and for-syntax arglst accum)
(safe-bind (let ((str (syntax str))
(str strlen at body) (strlen (syntax strlen))
`(lambda (,str ,strlen ,at) (at (syntax at))
(let ((,body '())) (body (syntax body)))
,(cg-and-int for-syntax arglst accum str strlen at body))))) #`(lambda (#,str #,strlen #,at)
(let ((#,body '()))
#,(cg-and-int for-syntax arglst accum str strlen at body)))))
;; Internal function builder for AND (calls itself). ;; Internal function builder for AND (calls itself).
(define (cg-and-int for-syntax arglst accum str strlen at body) (define (cg-and-int for-syntax arglst accum str strlen at body)
(safe-bind (let ((res (syntax res))
(res newat newbody) (newat (syntax newat))
(newbody (syntax newbody)))
(if (null? arglst) (if (null? arglst)
(cggr for-syntax accum 'cg-and `(reverse ,body) at) ;; base case (cggr-syn for-syntax accum 'cg-and #`(reverse #,body) at) ;; base case
(let ((mf (syntax->datum (let ((mf (peg-sexp-compile for-syntax (car arglst) accum))) ;; match function
(peg-sexp-compile for-syntax (car arglst) accum)))) ;; match function #`(let ((#,res (#,mf #,str #,strlen #,at)))
`(let ((,res (,mf ,str ,strlen ,at))) (if (not #,res)
(if (not ,res)
#f ;; if the match failed, the and failed #f ;; if the match failed, the and failed
;; otherwise update AT and BODY then recurse ;; otherwise update AT and BODY then recurse
(let ((,newat (car ,res)) (let ((#,newat (car #,res))
(,newbody (cadr ,res))) (#,newbody (cadr #,res)))
(set! ,at ,newat) (set! #,at #,newat)
((@@ (ice-9 peg) push-not-null!) ,body ((@@ (ice-9 peg) single-filter) ,newbody)) ((@@ (ice-9 peg) push-not-null!) #,body ((@@ (ice-9 peg) single-filter) #,newbody))
,(cg-and-int for-syntax (cdr arglst) accum str strlen at body)))))))) #,(cg-and-int for-syntax (cdr arglst) accum str strlen at body))))))))
;; 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)