Fix problem with syntaxing of DO.

This wouldn't work correctly in some weird edge cases.  Specifically, it was
trying to detect the 'else and '=> keywords, but comparing them in the syntactic
environment outside of the DO, not the one inside of it.  Fixed by rewriting the
macro to defer the cond-clause processing until the interior environment was
available.

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index 4a985e3856ca95483c62cd1bc7e2d15eadf4f3dd..79ba7249a793f719958f4430a09cd2ff74d237b3 100644 (file)
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -344,7 +344,7 @@ USA.
    (delay
      (scons-rule
         `((subform (* (subform (list id any (? any)))))
-          ,cond-clause-pattern
+          (subform (+ any))
           (* any))
        (lambda (bindings test-clause actions)
         (let ((loop-name (new-identifier 'do-loop)))
@@ -353,16 +353,16 @@ USA.
                      (list (car binding)
                            (cadr binding)))
                    bindings)
-            (expand-cond-clause test-clause
-                                (scons-begin
-                                  (apply scons-begin actions)
-                                  (apply scons-call
-                                         loop-name
-                                         (map (lambda (binding)
-                                                (if (pair? (cddr binding))
-                                                    (caddr binding)
-                                                    (car binding)))
-                                              bindings)))))))))))
+            (scons-cond test-clause
+                        (list (scons-close 'else)
+                              (apply scons-begin actions)
+                              (apply scons-call
+                                     loop-name
+                                     (map (lambda (binding)
+                                            (if (pair? (cddr binding))
+                                                (caddr binding)
+                                                (car binding)))
+                                          bindings)))))))))))
 \f
 (define $case
   (spar-transformer->runtime

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index b51baf1c7f557a6f5c0e12de5fc9f5b9f4b018b7..0056b3ee42bf39c128243003df8726b13a475b95 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4830,6 +4830,7 @@ USA.
          scons-begin
          scons-call
          scons-close
+         scons-cond
          scons-declare
          scons-define
          scons-delay

diff --git a/src/runtime/syntax-constructor.scm b/src/runtime/syntax-constructor.scm
index 07d924d753b015fc79cabf55a0a57e236793afdb..b1b1e9e58da42399189d315f78cee720a8cac16c 100644 (file)
--- a/src/runtime/syntax-constructor.scm
+++ b/src/runtime/syntax-constructor.scm
@@ -78,6 +78,14 @@ USA.
      (cons (close-part close operator)
           (close-parts close operands)))))
 
+(define (scons-cond . clauses)
+  (make-open-expr
+   (lambda (close)
+     (cons (close 'cond)
+          (map (lambda (clause)
+                 (close-parts close clause))
+               clauses)))))
+
 (define (scons-declare . decls)
   (make-open-expr
    (lambda (close)
@@ -96,7 +104,7 @@ USA.
    (lambda (close)
      (list (close 'delay)
           (close-part close expr)))))
-
+\f
 (define (scons-if predicate consequent alternative)
   (make-open-expr
    (lambda (close)
@@ -104,7 +112,7 @@ USA.
           (close-part close predicate)
           (close-part close consequent)
           (close-part close alternative)))))
-\f
+
 (define (scons-lambda bvl . body-forms)
   (make-open-expr
    (lambda (close)