summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNoah Lavine <nlavine@haverford.edu>2011-01-29 13:36:41 -0500
committerAndy Wingo <wingo@pobox.com>2011-03-24 21:10:02 +0100
commit44c8b60761fba90f58dd18696372289956df58ad (patch)
treed7c9ade950e55166aa7ccd7d1189a78e24a61059
parentbccbdc5b36ff0c6cd85486bb61080094f75884d6 (diff)
downloadguile-44c8b60761fba90f58dd18696372289956df58ad.tar.gz
peg: clean up syntax-for-non-cache-case
* module/ice-9/peg.scm (syntax-for-non-cache-case): Cleanups.
-rw-r--r--module/ice-9/peg.scm37
1 files changed, 16 insertions, 21 deletions
diff --git a/module/ice-9/peg.scm b/module/ice-9/peg.scm
index 20f9edc24..296c0e901 100644
--- a/module/ice-9/peg.scm
+++ b/module/ice-9/peg.scm
@@ -368,34 +368,29 @@
(define (syntax-for-non-cache-case for-syntax matchf accumsym symsym)
(let ((m-syn (datum->syntax for-syntax matchf))
(a-syn (datum->syntax for-syntax accumsym))
- (s-syn (datum->syntax for-syntax symsym))
- (str-syn (syntax str))
- (strlen-syn (syntax strlen))
- (at-syn (syntax at))
- (res-syn (syntax res))
- (body-syn (syntax body)))
- #`(lambda (#,str-syn #,strlen-syn #,at-syn)
- (let ((#,res-syn (#,m-syn #,str-syn #,strlen-syn #,at-syn)))
+ (s-syn (datum->syntax for-syntax symsym)))
+ #`(lambda (str strlen at)
+ (let ((res (#,m-syn str strlen at)))
;; Try to match the nonterminal.
- (if #,res-syn
+ (if res
;; If we matched, do some post-processing to figure out
;; what data to propagate upward.
- (let ((#,at-syn (car #,res-syn))
- (#,body-syn (cadr #,res-syn)))
+ (let ((at (car res))
+ (body (cadr res)))
#,(cond
((eq? accumsym 'name)
- #`(list #,at-syn '#,s-syn))
+ #`(list at '#,s-syn))
((eq? accumsym 'all)
- #`(list (car #,res-syn)
+ #`(list (car res)
(cond
- ((not (list? #,body-syn))
- (list '#,s-syn #,body-syn))
- ((null? #,body-syn) '#,s-syn)
- ((symbol? (car #,body-syn))
- (list '#,s-syn #,body-syn))
- (#t (cons '#,s-syn #,body-syn)))))
- ((eq? accumsym 'none) #`(list (car #,res-syn) '()))
- (#t #`(begin #,res-syn))))
+ ((not (list? body))
+ (list '#,s-syn body))
+ ((null? body) '#,s-syn)
+ ((symbol? (car body))
+ (list '#,s-syn body))
+ (#t (cons '#,s-syn body)))))
+ ((eq? accumsym 'none) #`(list (car res) '()))
+ (#t #`(begin res))))
;; If we didn't match, just return false.
#f)))))