X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fparse-defmacro.lisp;h=378d0ec3546da260a7ce214d6cb458fd15488394;hb=6c4d4d984b1af6b2a73568cec3ab9c8795cff2da;hp=a4eb1bcca8d24fa5443ccc99382c6bd16278122d;hpb=80304981972c91c1b3f3fca75f36dacf1fecf307;p=sbcl.git

diff --git a/src/code/parse-defmacro.lisp b/src/code/parse-defmacro.lisp
index a4eb1bc..378d0ec 100644
--- a/src/code/parse-defmacro.lisp
+++ b/src/code/parse-defmacro.lisp
@@ -199,41 +199,57 @@
 		  (push-let-binding var nil nil))))
 	      (t
 	       (error "non-symbol in lambda-list: ~S" var)))))
-    (push `(unless ,(if restp
-			;; (If RESTP, then the argument list might be
-			;; dotted, in which case ordinary LENGTH won't
-			;; work.)
-			`(list-of-length-at-least-p ,path-0 ,minimum)
-			`(proper-list-of-length-p ,path-0 ,minimum ,maximum))
-	     ,(if (eq error-fun '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))
-			       :args ,path-0
-			       :lambda-list ',lambda-list
-			       :minimum ,minimum
-			       ,@(unless restp
-				   `(:maximum ,maximum)))))
-	  *arg-tests*)
-    (when keys
-      (let ((problem (gensym "KEY-PROBLEM-"))
-	    (info (gensym "INFO-")))
-	(push `(multiple-value-bind (,problem ,info)
-		   (verify-keywords ,rest-name
-				    ',keys
-				    ',allow-other-keys-p)
-		 (when ,problem
-		   (,error-fun
-		    'defmacro-ll-broken-key-list-error
-		    :kind ',error-kind
-		    ,@(when name `(:name ',name))
-		    :problem ,problem
-		    :info ,info)))
-	      *arg-tests*)))
-    (values env-arg-used minimum (if (null restp) maximum nil))))
+    (let (;; common subexpression, suitable for passing to functions
+	  ;; which expect a MAXIMUM argument regardless of whether
+	  ;; there actually is a maximum number of arguments
+	  ;; (expecting MAXIMUM=NIL when there is no maximum)
+	  (explicit-maximum (and (not restp) maximum)))
+      (push `(unless ,(if restp
+			  ;; (If RESTP, then the argument list might be
+			  ;; dotted, in which case ordinary LENGTH won't
+			  ;; work.)
+			  `(list-of-length-at-least-p ,path-0 ,minimum)
+			  `(proper-list-of-length-p ,path-0 ,minimum ,maximum))
+	       ,(if (eq error-fun 'error)
+		    `(arg-count-error ',error-kind ',name ,path-0
+				      ',lambda-list ,minimum
+				      ,explicit-maximum)
+		    `(,error-fun 'arg-count-error
+				 :kind ',error-kind
+				 ,@(when name `(:name ',name))
+				 :args ,path-0
+				 :lambda-list ',lambda-list
+				 :minimum ,minimum
+				 :maximum ,explicit-maximum)))
+	    *arg-tests*)
+      (when keys
+	(let ((problem (gensym "KEY-PROBLEM-"))
+	      (info (gensym "INFO-")))
+	  (push `(multiple-value-bind (,problem ,info)
+		     (verify-keywords ,rest-name
+				      ',keys
+				      ',allow-other-keys-p)
+		   (when ,problem
+		     (,error-fun
+		      'defmacro-lambda-list-broken-key-list-error
+		      :kind ',error-kind
+		      ,@(when name `(:name ',name))
+		      :problem ,problem
+		      :info ,info)))
+		*arg-tests*)))
+      (values env-arg-used minimum explicit-maximum))))
+
+;;; We save space in macro definitions by calling this function.
+(defun arg-count-error (error-kind name args lambda-list minimum maximum)
+  (let (#-sb-xc-host
+	(sb!debug:*stack-top-hint* (nth-value 1 (find-caller-name-and-frame))))
+    (error 'arg-count-error
+	   :kind error-kind
+	   :name name
+	   :args args
+	   :lambda-list lambda-list
+	   :minimum minimum
+	   :maximum maximum)))
 
 (defun push-sub-list-binding (variable path object name error-kind error-fun)
   (let ((var (gensym "TEMP-")))