From 9ada7de60f7021d2270dc645bbcce6fbb4d73019 Mon Sep 17 00:00:00 2001
From: "Taylor R. Campbell" <net/mumble/campbell>
Date: Wed, 27 Dec 2006 06:53:04 +0000
Subject: [PATCH] Improve code generated for segment variable matching in
 SYNTAX-RULES. Before it used an idiom of

  ((LET ((LOOP #F)) (SET! LOOP (LAMBDA () ...)) LOOP)
   ...),

which caused spurious & confusing `Possible inapplicable operator #f'
warnings from the compiler's flow analyzer.  Now it uses

  ((LET () (DEFINE LOOP (LAMBDA () ...)) LOOP)
   ...),

like the code generated for named LET.
---
 v7/src/runtime/syntax-rules.scm | 34 +++++++++++++++------------------
 1 file changed, 15 insertions(+), 19 deletions(-)

diff --git a/v7/src/runtime/syntax-rules.scm b/v7/src/runtime/syntax-rules.scm
index 17fedae93..1a636a53f 100644
--- a/v7/src/runtime/syntax-rules.scm
+++ b/v7/src/runtime/syntax-rules.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: syntax-rules.scm,v 14.6 2003/03/07 21:13:29 cph Exp $
+$Id: syntax-rules.scm,v 14.7 2006/12/27 06:53:04 riastradh Exp $
 
 Copyright 1989,1990,1991,2001,2002,2003 Massachusetts Institute of Technology
 
@@ -155,21 +155,19 @@ USA.
 		(r-l (rename 'L))
 		(r-lambda (rename 'LAMBDA)))
 	    `(((,r-lambda
-		(,r-loop)
-		(,(rename 'BEGIN)
-		 (,(rename 'SET!)
-		  ,r-loop
-		  (,r-lambda
-		   (,r-l)
-		   (,(rename 'IF)
-		    (,(rename 'NULL?) ,r-l)
-		    #T
-		    ,(conjunction
-		      `(,(rename 'PAIR?) ,r-l)
-		      (conjunction (loop pattern `(,(rename 'CAR) ,r-l))
-				   `(,r-loop (,(rename 'CDR) ,r-l)))))))
-		 ,r-loop))
-	       #F)
+		()
+		(,(rename 'DEFINE)
+		 ,r-loop
+		 (,r-lambda
+		  (,r-l)
+		  (,(rename 'IF)
+		   (,(rename 'NULL?) ,r-l)
+		   #T
+		   ,(conjunction
+		     `(,(rename 'PAIR?) ,r-l)
+		     (conjunction (loop pattern `(,(rename 'CAR) ,r-l))
+				  `(,r-loop (,(rename 'CDR) ,r-l)))))))
+		,r-loop))
 	      ,expression))))
        (conjunction
 	(lambda (predicate consequent)
@@ -223,9 +221,7 @@ USA.
 			  (error "illegal control/ellipsis combination"
 				 control sids))))
 		 (syntax-error "Missing ellipsis in expansion." #f))
-	     (loop control (cdr ellipses)))
-	    ((pair? ellipses)
-	     (syntax-error "Extra ellipsis in expansion." #f))))))
+	     (loop control (cdr ellipses)))))))
 
 (define (generate-ellipsis rename ellipsis body syntax-error)
   (let ((sids (ellipsis-sids ellipsis)))
-- 
2.25.1