Changed error report for duplicate names to explicitly mention the

duplicated names.

diff --git a/v7/src/runtime/lambda.scm b/v7/src/runtime/lambda.scm
index 0ef5996993066467da944d1e1cafd00aa53fad62..ca96186d375979dd7edb31637dbcad00cbfa5cad 100644 (file)
--- a/v7/src/runtime/lambda.scm
+++ b/v7/src/runtime/lambda.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: lambda.scm,v 14.12 1994/02/18 22:33:05 gjr Exp $
+$Id: lambda.scm,v 14.13 1997/12/02 05:52:52 adams Exp $
 
-Copyright (c) 1988-1994 Massachusetts Institute of Technology
+Copyright (c) 1988-1997 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -375,12 +375,30 @@ MIT in each case. |#
       (xlambda? object)))
 
 (define (make-lambda name required optional rest auxiliary declarations body)
-  (if (list-has-duplicates? (append required
-                                   optional
-                                   (if rest (list rest) '())
-                                   auxiliary))
-      (error "one or more duplicate parameters"
-            required optional rest auxiliary))
+
+  (let ((interface (append required optional (if rest (list rest) '()))))
+    (let ((dup-interface (find-list-duplicates interface))
+         (dup-auxiliary (find-list-duplicates auxiliary)))
+      (cond ((not (null? dup-interface))
+            ;; Syntax.scm gets this case in usual usage
+            (error "duplicate parameters" dup-interface
+                   (error-irritant/noise " in") interface))
+           ((not (null? dup-auxiliary))
+            (error "duplicate internal definitions for" dup-auxiliary
+                   (error-irritant/noise " in")
+                   name))
+           (else
+            (let ((dup (find-list-duplicates (append interface auxiliary))))
+              (if (not (null? dup))
+                  (error "duplicate parameters" dup
+                         (error-irritant/noise " in")
+                         (append required
+                                 (if (pair? optional) '(#!optional) '()) 
+                                 optional
+                                 (if rest `(#!rest ,rest) '())
+                                 (if (pair? auxiliary) `(#!aux) '())
+                                 auxiliary))))))))
+
   (let ((body* (if (null? declarations)
                   body
                   (make-sequence (list (make-block-declaration declarations)
@@ -410,11 +428,15 @@ MIT in each case. |#
                      (make-sequence (cdr actions)))
            (receiver name required optional rest auxiliary '() body))))))
 
-(define (list-has-duplicates? items)
-  (and (not (null? items))
-       (if (memq (car items) (cdr items))
-          true
-          (list-has-duplicates? (cdr items)))))
+(define (find-list-duplicates items)
+  (let loop ((items items) (duplicates '()))
+    (cond ((null? items) (reverse! duplicates))
+         ((memq (car items) (cdr items))
+          (if (memq (car items) duplicates)
+              (loop (cdr items) duplicates)
+              (loop (cdr items) (cons (car items) duplicates))))
+         (else
+          (loop (cdr items) duplicates)))))
 \f
 (define ((dispatch-0 op-name clambda-op clexpr-op xlambda-op) *lambda)
   ((cond ((slambda? *lambda) clambda-op)

diff --git a/v7/src/runtime/syntax.scm b/v7/src/runtime/syntax.scm
index d25857c4f5578e145d639514df8b83241bbd9bd5..ed7a11e9a8e29d97b1a9970ad2c15e28f2605bc5 100644 (file)
--- a/v7/src/runtime/syntax.scm
+++ b/v7/src/runtime/syntax.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: syntax.scm,v 14.27 1995/07/06 22:07:23 cph Exp $
+$Id: syntax.scm,v 14.28 1997/12/02 05:53:21 adams Exp $
 
-Copyright (c) 1988-95 Massachusetts Institute of Technology
+Copyright (c) 1988-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -728,7 +728,9 @@ MIT in each case. |#
              (cdr parameters)))
            ((null? parameters))
          (if (memq (car parameters) (cdr parameters))
-             (syntax-error "lambda list has duplicate parameters"
+             (syntax-error "lambda list has duplicate parameter:"
+                           (car parameters)
+                           (error-irritant/noise " in")
                            lambda-list)))
        (receiver required optional rest)))