From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 15 Jul 1988 22:28:01 +0000 (+0000)
Subject: Change handling of `=>' option to `cond' special form so that it
X-Git-Tag: 20090517-FFI~12661
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a9f0cb448f88ed7aa6dfd26608d3dec90f0581b6;p=mit-scheme.git

Change handling of `=>' option to `cond' special form so that it
conforms to standard.  Eliminate `syntaxer/cond-=>-helper' in favor of
using uninterned variable.
---

diff --git a/v7/src/runtime/syntax.scm b/v7/src/runtime/syntax.scm
index 6e3d77337..8028b6a6b 100644
--- a/v7/src/runtime/syntax.scm
+++ b/v7/src/runtime/syntax.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/syntax.scm,v 14.2 1988/06/16 06:29:40 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/syntax.scm,v 14.3 1988/07/15 22:28:01 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -303,7 +303,8 @@ MIT in each case. |#
 (define (syntax/if predicate consequent . rest)
   (make-conditional (syntax-expression predicate)
 		    (syntax-expression consequent)
-		    (cond ((null? rest) undefined-conditional-branch)
+		    (cond ((null? rest)
+			   undefined-conditional-branch)
 			  ((null? (cdr rest))
 			   (syntax-expression (car rest)))
 			  (else
@@ -313,38 +314,39 @@ MIT in each case. |#
   (expand-disjunction expressions))
 
 (define (syntax/cond clause . rest)
-  (let loop ((clause clause) (rest rest))
+  (define (loop clause rest)
     (cond ((eq? (car clause) 'ELSE)
 	   (if (null? rest)
-	       (syntax-sequence (cdr clause))
-	       (syntax-error "ELSE not last clause" rest)))
+	       (syntax-error "ELSE not last clause" rest))
+	   (syntax-sequence (cdr clause)))
 	  ((null? (cdr clause))
-	   (make-disjunction (syntax-expression (car clause))
-			     (if (null? rest)
-				 undefined-conditional-branch
-				 (loop (car rest) (cdr rest)))))
+	   (make-disjunction (syntax-expression (car clause)) (next rest)))
 	  ((and (pair? (cdr clause))
 		(eq? (cadr clause) '=>))
-	   (syntax-expression
-	    `((ACCESS SYNTAXER/COND-=>-HELPER '())
-	      ,(car clause)
-	      (LAMBDA () ,@(cddr clause))
-	      (LAMBDA ()
-		,(if (null? rest)
-		     undefined-conditional-branch
-		     `(COND ,@rest))))))
+	   (if (not (and (pair? (cddr clause))
+			 (null? (cdddr clause))))
+	       (syntax-error "Misformed => clause" clause))
+	   (let ((predicate (string->uninterned-symbol "PREDICATE")))
+	     (make-closed-block lambda-tag:let
+				(list predicate)
+				(list (syntax-expression (car clause)))
+	       (let ((predicate (syntax-expression predicate)))
+		 (make-conditional
+		  predicate
+		  (make-combination* (syntax-expression (caddr clause))
+				     predicate)
+		  (next rest))))))
 	  (else
 	   (make-conditional (syntax-expression (car clause))
 			     (syntax-sequence (cdr clause))
-			     (if (null? rest)
-				 undefined-conditional-branch
-				 (loop (car rest) (cdr rest))))))))
-
-(define (syntaxer/cond-=>-helper form1-result thunk2 thunk3)
-  (if form1-result
-      ((thunk2) form1-result)
-      (thunk3)))
-
+			     (next rest)))))
+
+  (define (next rest)
+    (if (null? rest)
+	undefined-conditional-branch
+	(loop (car rest) (cdr rest))))
+
+  (loop clause rest))
 ;;;; Procedures
 
 (define (syntax/lambda pattern . body)