From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 28 Mar 2018 00:17:36 +0000 (-0700)
Subject: Use folding to eliminate loops in macros.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~171
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c5139a6103df0d294fbc120ae5c1af8c54a7f17a;p=mit-scheme.git

Use folding to eliminate loops in macros.
---

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index dc6c5edb1..9f780f920 100644
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -335,12 +335,10 @@ USA.
    system-global-environment))
 
 (define (expand-let* scons-let bindings body-forms)
-  (if (pair? bindings)
-      (let loop ((bindings bindings))
-	(if (pair? (cdr bindings))
-	    (scons-let (list (car bindings)) (loop (cdr bindings)))
-	    (apply scons-let (list (car bindings)) body-forms)))
-      (apply scons-let '() body-forms)))
+  (fold-right (lambda (binding expr)
+		(scons-let (list binding) expr))
+	      (apply scons-let '() body-forms)
+	      bindings))
 
 (define :letrec
   (spar-transformer->runtime
@@ -382,14 +380,10 @@ USA.
    (delay
      (scons-rule '((list (* any)))
        (lambda (exprs)
-	 (if (pair? exprs)
-	     (let loop ((exprs exprs))
-	       (if (pair? (cdr exprs))
-		   (scons-if (car exprs)
-			     (loop (cdr exprs))
-			     #f)
-		   (car exprs)))
-	     #t))))
+	 (reduce-right (lambda (expr1 expr2)
+			 (scons-if expr1 expr2 #f))
+		       #t
+		       exprs))))
    system-global-environment))
 
 (define :case
@@ -410,15 +404,6 @@ USA.
        (lambda (expr clauses else-clause)
 	 (let ((temp (new-identifier 'key)))
 
-	   (define (process-clauses clauses)
-	     (cond ((pair? clauses)
-		    (process-clause (car clauses)
-				    (process-clauses (cdr clauses))))
-		   (else-clause
-		    (process-action (car else-clause) (cdr else-clause)))
-		   (else
-		    (unspecific-expression))))
-
 	   (define (process-clause clause rest)
 	     (if (pair? (car clause))
 		 (scons-if (process-predicate (car clause))
@@ -447,7 +432,12 @@ USA.
 		   (else (error "Unrecognized action type:" type))))
 
 	   (scons-let (list (list temp expr))
-	     (process-clauses clauses))))))
+	     (fold-right process-clause
+			 (if else-clause
+			     (process-action (car else-clause)
+					     (cdr else-clause))
+			     (unspecific-expression))
+			 clauses))))))
    system-global-environment))
 
 (define :cond
@@ -459,12 +449,11 @@ USA.
 			  (+ any)))
 	       (values #f)))
        (lambda (clauses else-actions)
-	 (let loop ((clauses clauses))
-	   (cond ((pair? clauses)
-		  (expand-cond-clause (car clauses)
-				      (loop (cdr clauses))))
-		 (else-actions (apply scons-begin else-actions))
-		 (else (unspecific-expression)))))))
+	 (fold-right expand-cond-clause
+		     (if else-actions
+			 (apply scons-begin else-actions)
+			 (unspecific-expression))
+		     clauses))))
    system-global-environment))
 
 (define cons-clause-pattern