From: Taylor R. Campbell <net/mumble/campbell>
Date: Wed, 27 Dec 2006 06:53:04 +0000 (+0000)
Subject: Improve code generated for segment variable matching in SYNTAX-RULES.
X-Git-Tag: 20090517-FFI~827
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9ada7de60f7021d2270dc645bbcce6fbb4d73019;p=mit-scheme.git

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.
---

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)))