diff options
author | Noah Lavine <nlavine@haverford.edu> | 2011-02-01 10:36:08 -0500 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-01-16 10:11:33 +0100 |
commit | 84cb143eb4043ae1ccd735fbc6620db328d788dd (patch) | |
tree | ee3ac526c0b675a4ca551a866433e18aa3140638 /module/ice-9 | |
parent | 8e8de46ec60ee61d0b9f6a05cb5d52f55c58dbdd (diff) | |
download | guile-84cb143eb4043ae1ccd735fbc6620db328d788dd.tar.gz |
peg: more helpers returning syntax
* module/ice-9/peg.scm (cg-body, cg-body-success, cg-body-more)
(cg-body-ret): Return syntax instead of s-expressions.
Diffstat (limited to 'module/ice-9')
-rw-r--r-- | module/ice-9/peg.scm | 71 |
1 files changed, 38 insertions, 33 deletions
diff --git a/module/ice-9/peg.scm b/module/ice-9/peg.scm index c21cd78ee..cee0cb3a8 100644 --- a/module/ice-9/peg.scm +++ b/module/ice-9/peg.scm @@ -351,66 +351,71 @@ ;; 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. (define (cg-body-test for-syntax match accum str strlen at body) - (safe-bind - (at2-body2 at2 body2) - (let ((mf (syntax->datum - (peg-sexp-compile for-syntax match accum)))) - `(let ((,at2-body2 (,mf ,str ,strlen ,at))) - (if (or (not ,at2-body2) (= ,at (car ,at2-body2))) + (let ((at2-body2 (syntax at2-body2)) + (at2 (syntax at2)) + (body2 (syntax body2))) + (let ((mf (peg-sexp-compile for-syntax match accum))) + #`(let ((#,at2-body2 (#,mf #,str #,strlen #,at))) + (if (or (not #,at2-body2) (= #,at (car #,at2-body2))) #f - (let ((,at2 (car ,at2-body2)) - (,body2 (cadr ,at2-body2))) - (set! ,at ,at2) + (let ((#,at2 (car #,at2-body2)) + (#,body2 (cadr #,at2-body2))) + (set! #,at #,at2) ((@@ (ice-9 peg) push-not-null!) - ,body - ((@@ (ice-9 peg) single-filter) ,body2)) + #,body + ((@@ (ice-9 peg) single-filter) #,body2)) #t)))))) ;; Returns a block of code that sees whether NUM wants us to try and match more ;; given that we've already matched COUNT. (define (cg-body-more for-syntax num count) - (cond ((number? num) `(< ,count ,num)) + (cond ((number? num) #`(< #,count #,(datum->syntax for-syntax num))) ((eq? num '+) #t) ((eq? num '*) #t) - ((eq? num '?) `(< ,count 1)) + ((eq? num '?) #`(< #,count 1)) (#t (error-val `(cg-body-more-error ,num ,count))))) ;; Returns a function that takes a paramter indicating whether or not the match ;; was succesful and returns what the body expression should return. (define (cg-body-ret for-syntax accum type name body at at2) - (safe-bind - (success) - `(lambda (,success) - ,(cond ((eq? type '!) - `(if ,success #f ,(cggr for-syntax accum name ''() at))) + (let ((success (syntax success))) + #`(lambda (#,success) + #,(cond ((eq? type '!) + #`(if #,success #f #,(cggr-syn for-syntax accum name ''() at))) ((eq? type '&) - `(if ,success ,(cggr for-syntax accum name ''() at) #f)) + #`(if #,success #,(cggr-syn for-syntax accum name ''() at) #f)) ((eq? type 'lit) - `(if ,success - ,(cggr for-syntax accum name `(reverse ,body) at2) #f)) + #`(if #,success + #,(cggr-syn for-syntax accum name #`(reverse #,body) at2) #f)) (#t (error-val `(cg-body-ret-error ,type ,accum ,name ,body ,at ,at2))))))) ;; Returns a block of code that sees whether COUNT satisfies the constraints of ;; NUM. (define (cg-body-success for-syntax num count) - (cond ((number? num) `(= ,count ,num)) - ((eq? num '+) `(>= ,count 1)) + (cond ((number? num) #`(= #,count #,num)) + ((eq? num '+) #`(>= #,count 1)) ((eq? num '*) #t) - ((eq? num '?) `(<= ,count 1)) + ((eq? num '?) #`(<= #,count 1)) (#t `(cg-body-success-error ,num)))) ;; Returns a function that parses a BODY element. (define (cg-body for-syntax accum type match num) - (safe-bind - (str strlen at at2 count body) - `(lambda (,str ,strlen ,at) - (let ((,at2 ,at) (,count 0) (,body '())) - (while (and ,(cg-body-test for-syntax match accum str strlen at2 body) - (set! ,count (+ ,count 1)) - ,(cg-body-more for-syntax num count))) - (,(cg-body-ret for-syntax accum type 'cg-body body at at2) - ,(cg-body-success for-syntax num count)))))) + (let ((str (syntax str)) + (strlen (syntax strlen)) + (at (syntax at)) + ; this next one doesn't work with (syntax at2), and I'd really + ; like to know why. + (at2 (datum->syntax for-syntax (gensym))) + (count (syntax count)) + (body (syntax body))) + #`(lambda (#,str #,strlen #,at) + (let ((#,at2 #,at) (#,count 0) (#,body '())) + (while (and #,(cg-body-test for-syntax match accum str strlen at2 body) + (set! #,count (+ #,count 1)) + #,(cg-body-more for-syntax num count))) + (#,(cg-body-ret for-syntax accum type 'cg-body body at at2) + #,(cg-body-success for-syntax num count)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;; FOR DEFINING AND USING NONTERMINALS |