From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 31 Jan 2003 06:04:38 +0000 (+0000)
Subject: Generate appropriate error message when ellipsis appears in template
X-Git-Tag: 20090517-FFI~2047
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e14b4a07f9bb29cd39c878b602097d8be933e6fc;p=mit-scheme.git

Generate appropriate error message when ellipsis appears in template
but not in pattern.
---

diff --git a/v7/src/runtime/syntax-rules.scm b/v7/src/runtime/syntax-rules.scm
index 86455f0b6..2eef9018a 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.3 2003/01/31 05:00:52 cph Exp $
+$Id: syntax-rules.scm,v 14.4 2003/01/31 06:04:38 cph Exp $
 
 Copyright 1989,1990,1991,2001,2002,2003 Massachusetts Institute of Technology
 
@@ -199,7 +199,8 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 						  ellipsis
 						  (loop (car template)
 							(cons ellipsis
-							      ellipses))))
+							      ellipses))
+						  syntax-error))
 			     (loop (cddr template) ellipses)))
 	  ((pair? template)
 	   (optimized-cons rename compare
@@ -225,22 +226,25 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 	    ((pair? ellipses)
 	     (syntax-error "Extra ellipsis in expansion." #f))))))
 
-(define (generate-ellipsis rename ellipsis body)
+(define (generate-ellipsis rename ellipsis body syntax-error)
   (let ((sids (ellipsis-sids ellipsis)))
-    (let ((name (sid-name (car sids)))
-	  (expression (sid-expression (car sids))))
-      (cond ((and (null? (cdr sids))
-		  (eq? body name))
-	     expression)
-	    ((and (null? (cdr sids))
-		  (pair? body)
-		  (pair? (cdr body))
-		  (eq? (cadr body) name)
-		  (null? (cddr body)))
-	     `(,(rename 'MAP) ,(car body) ,expression))
-	    (else
-	     `(,(rename 'MAP) (,(rename 'LAMBDA) ,(map sid-name sids) ,body)
-			      ,@(map sid-expression sids)))))))
+    (if (pair? sids)
+	(let ((name (sid-name (car sids)))
+	      (expression (sid-expression (car sids))))
+	  (cond ((and (null? (cdr sids))
+		      (eq? body name))
+		 expression)
+		((and (null? (cdr sids))
+		      (pair? body)
+		      (pair? (cdr body))
+		      (eq? (cadr body) name)
+		      (null? (cddr body)))
+		 `(,(rename 'MAP) ,(car body) ,expression))
+		(else
+		 `(,(rename 'MAP) (,(rename 'LAMBDA) ,(map sid-name sids)
+						     ,body)
+				  ,@(map sid-expression sids)))))
+	(syntax-error "Missing ellipsis in expansion." #f))))
 
 (define (zero-or-more? pattern rename compare)
   (and (pair? pattern)