X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fparse-defmacro.lisp;h=a4eb1bcca8d24fa5443ccc99382c6bd16278122d;hb=63cef087068afc157283c0a05ae1f16b962303aa;hp=eb9efae80fd18daf7b374b315a289888057185bf;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/code/parse-defmacro.lisp b/src/code/parse-defmacro.lisp
index eb9efae..a4eb1bc 100644
--- a/src/code/parse-defmacro.lisp
+++ b/src/code/parse-defmacro.lisp
@@ -11,9 +11,6 @@
 
 (in-package "SB!KERNEL")
 
-(file-comment
- "$Header$")
-
 ;;; variables for accumulating the results of parsing a DEFMACRO. (Declarations
 ;;; in DEFMACRO are the reason this isn't as easy as it sounds.)
 (defvar *arg-tests* nil) ; tests that do argument counting at expansion time
@@ -23,16 +20,16 @@
 (defvar *user-lets* nil) ; LET bindings that the user has explicitly supplied
 (declaim (type list *user-lets*))
 
-;; the default default for unsupplied optional and keyword args
+;; the default default for unsupplied &OPTIONAL and &KEY args
 (defvar *default-default* nil)
 
 ;;; temps that we introduce and might not reference
 (defvar *ignorable-vars*)
 (declaim (type list *ignorable-vars*))
 
-;;; Return, as multiple-values, a body, possibly a declare form to put where
-;;; this code is inserted, the documentation for the parsed body, and bounds
-;;; on the number of arguments.
+;;; Return, as multiple values, a body, possibly a declare form to put
+;;; where this code is inserted, the documentation for the parsed
+;;; body, and bounds on the number of arguments.
 (defun parse-defmacro (lambda-list arg-list-name body name error-kind
 				   &key
 				   (anonymousp nil)
@@ -64,7 +61,7 @@
 		maximum)))))
 
 ;;; partial reverse-engineered documentation:
-;;;   TOP-LEVEL is true for calls through PARSE-DEFMACRO from DEFSETF and
+;;;   TOPLEVEL is true for calls through PARSE-DEFMACRO from DEFSETF and
 ;;;     DESTRUCTURING-BIND, false otherwise.
 ;;; -- WHN 19990620
 (defun parse-defmacro-lambda-list (possibly-dotted-lambda-list
@@ -73,13 +70,13 @@
 				   error-kind
 				   error-fun
 				   &optional
-				   top-level
+				   toplevel
 				   env-illegal
 				   env-arg-name)
   (let* (;; PATH is a sort of pointer into the part of the lambda list we're
 	 ;; considering at this point in the code. PATH-0 is the root of the
 	 ;; lambda list, which is the initial value of PATH.
-	 (path-0 (if top-level
+	 (path-0 (if toplevel
 		   `(cdr ,arg-list-name)
 		   arg-list-name))
 	 (path path-0) ; (will change below)
@@ -113,7 +110,7 @@
 	      ((eq var '&environment)
 	       (cond (env-illegal
 		      (error "&ENVIRONMENT is not valid with ~S." error-kind))
-		     ((not top-level)
+		     ((not toplevel)
 		      (error "&ENVIRONMENT is only valid at top level of ~
 			      lambda-list.")))
 	       (cond ((and (cdr rest-of-args) (symbolp (cadr rest-of-args)))
@@ -154,14 +151,11 @@
 			minimum (1+ minimum)
 			maximum (1+ maximum)))
 		 ((eq now-processing :optionals)
-		  (when (> (length var) 3)
-		    (cerror "Ignore extra noise."
-			    "more than variable, initform, and suppliedp ~
-			    in &optional binding: ~S"
-			    var))
-		  (push-optional-binding (car var) (cadr var) (caddr var)
-					 `(not (null ,path)) `(car ,path)
-					 name error-kind error-fun)
+		  (destructuring-bind (varname &optional initform supplied-p)
+		      var
+		    (push-optional-binding varname initform supplied-p
+					   `(not (null ,path)) `(car ,path)
+					   name error-kind error-fun))
 		  (setq path `(cdr ,path)
 			maximum (1+ maximum)))
 		 ((eq now-processing :keywords)
@@ -212,13 +206,13 @@
 			`(list-of-length-at-least-p ,path-0 ,minimum)
 			`(proper-list-of-length-p ,path-0 ,minimum ,maximum))
 	     ,(if (eq error-fun 'error)
-		  `(do-arg-count-error ',error-kind ',name ,path-0
-				       ',lambda-list ,minimum
-				       ,(unless restp maximum))
-		  `(,error-fun 'defmacro-ll-arg-count-error
+		  `(arg-count-error ',error-kind ',name ,path-0
+				    ',lambda-list ,minimum
+				    ,(unless restp maximum))
+		  `(,error-fun 'arg-count-error
 			       :kind ',error-kind
 			       ,@(when name `(:name ',name))
-			       :argument ,path-0
+			       :args ,path-0
 			       :lambda-list ',lambda-list
 			       :minimum ,minimum
 			       ,@(unless restp
@@ -278,14 +272,15 @@
 	((symbolp value-var)
 	 (push-let-binding value-var path nil supplied-var init-form))
 	(t
-	 (error "Illegal optional variable name: ~S" value-var))))
+	 (error "illegal optional variable name: ~S" value-var))))
 
 (defun defmacro-error (problem kind name)
-  (error "Illegal or ill-formed ~A argument in ~A~@[ ~S~]."
+  (error "illegal or ill-formed ~A argument in ~A~@[ ~S~]"
 	 problem kind name))
 
-;;; Determine whether KEY-LIST is a valid list of keyword/value pairs. Do not
-;;; signal the error directly, 'cause we don't know how it should be signaled.
+;;; Determine whether KEY-LIST is a valid list of keyword/value pairs.
+;;; Do not signal the error directly, 'cause we don't know how it
+;;; should be signaled.
 (defun verify-keywords (key-list valid-keys allow-other-keys)
   (do ((already-processed nil)
        (unknown-keyword nil)
@@ -300,8 +295,6 @@
 	   (return (values :dotted-list key-list)))
 	  ((null (cdr remaining))
 	   (return (values :odd-length key-list)))
-	  ((member (car remaining) already-processed)
-	   (return (values :duplicate (car remaining))))
 	  ((or (eq (car remaining) :allow-other-keys)
 	       (member (car remaining) valid-keys))
 	   (push (car remaining) already-processed))