peg: clean up syntax-for-non-cache-case
authorNoah Lavine <nlavine@haverford.edu>
Sat, 29 Jan 2011 18:36:41 +0000 (13:36 -0500)
committerAndy Wingo <wingo@pobox.com>
Wed, 16 Jan 2013 09:11:28 +0000 (10:11 +0100)
* module/ice-9/peg.scm (syntax-for-non-cache-case): Cleanups.

module/ice-9/peg.scm

index 20f9edc..296c0e9 100644 (file)
 (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)))))