0.pre7.82:

[sbcl.git] / src / code / parse-defmacro-errors.lisp

diff --git a/src/code/parse-defmacro-errors.lisp b/src/code/parse-defmacro-errors.lisp
index 883cb0d..62972d4 100644 (file)
--- a/src/code/parse-defmacro-errors.lisp
+++ b/src/code/parse-defmacro-errors.lisp
@@ -1,8 +1,6 @@
-;;;; error-handling machinery for PARSE-DEFMACRO, separated from PARSE-DEFMACRO
-;;;; code itself because the happy path can be handled earlier in the bootstrap
-;;;; sequence than DEFINE-CONDITION can be, and because some of the error
-;;;; handling depends on SBCL extensions, while PARSE-DEFMACRO needs to run in
-;;;; the cross-compiler on the host Common Lisp
+;;;; error-handling machinery for PARSE-DEFMACRO, separated from
+;;;; PARSE-DEFMACRO code itself because the happy path can be handled
+;;;; earlier in the bootstrap sequence than DEFINE-CONDITION can be
 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.
@@ -15,15 +13,12 @@
 
 (in-package "SB!KERNEL")
 
-(file-comment
-  "$Header$")
-
 ;;; We save space in macro definitions by calling this function.
-(defun do-arg-count-error (error-kind name arg lambda-list minimum maximum)
-  (multiple-value-bind (fname sb!debug:*stack-top-hint*) (find-caller-name)
-    (error 'defmacro-ll-arg-count-error
+(defun arg-count-error (error-kind name arg 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
-          :function-name fname
           :name name
           :argument arg
           :lambda-list lambda-list
@@ -37,15 +32,10 @@
         :initform nil)))
 
 (defun print-defmacro-ll-bind-error-intro (condition stream)
-  (if (null (defmacro-lambda-list-bind-error-name condition))
-      (format stream
-             "error while parsing arguments to ~A in ~S:~%"
-             (defmacro-lambda-list-bind-error-kind condition)
-             (condition-function-name condition))
-      (format stream
-             "error while parsing arguments to ~A ~S:~%"
-             (defmacro-lambda-list-bind-error-kind condition)
-             (defmacro-lambda-list-bind-error-name condition))))
+  (format stream
+         "error while parsing arguments to ~A~@[ ~S~]:~%"
+         (defmacro-lambda-list-bind-error-kind condition)
+         (defmacro-lambda-list-bind-error-name condition)))
 
 (define-condition defmacro-bogus-sublist-error
                  (defmacro-lambda-list-bind-error)
@@ -60,33 +50,33 @@
             (defmacro-bogus-sublist-error-object condition)
             (defmacro-bogus-sublist-error-lambda-list condition)))))
 
-(define-condition defmacro-ll-arg-count-error (defmacro-lambda-list-bind-error)
-  ((argument :reader defmacro-ll-arg-count-error-argument :initarg :argument)
-   (lambda-list :reader defmacro-ll-arg-count-error-lambda-list
+(define-condition arg-count-error (defmacro-lambda-list-bind-error)
+  ((argument :reader arg-count-error-argument :initarg :argument)
+   (lambda-list :reader arg-count-error-lambda-list
                :initarg :lambda-list)
-   (minimum :reader defmacro-ll-arg-count-error-minimum :initarg :minimum)
-   (maximum :reader defmacro-ll-arg-count-error-maximum :initarg :maximum))
+   (minimum :reader arg-count-error-minimum :initarg :minimum)
+   (maximum :reader arg-count-error-maximum :initarg :maximum))
   (:report
    (lambda (condition stream)
      (print-defmacro-ll-bind-error-intro condition stream)
      (format stream
             "invalid number of elements in:~%  ~:S~%~
-            to satisfy lambda-list:~%  ~:S~%"
-            (defmacro-ll-arg-count-error-argument condition)
-            (defmacro-ll-arg-count-error-lambda-list condition))
-     (cond ((null (defmacro-ll-arg-count-error-maximum condition))
+            to satisfy lambda list:~%  ~:S~%"
+            (arg-count-error-argument condition)
+            (arg-count-error-lambda-list condition))
+     (cond ((null (arg-count-error-maximum condition))
            (format stream "at least ~D expected"
-                   (defmacro-ll-arg-count-error-minimum condition)))
-          ((= (defmacro-ll-arg-count-error-minimum condition)
-              (defmacro-ll-arg-count-error-maximum condition))
+                   (arg-count-error-minimum condition)))
+          ((= (arg-count-error-minimum condition)
+              (arg-count-error-maximum condition))
            (format stream "exactly ~D expected"
-                   (defmacro-ll-arg-count-error-minimum condition)))
+                   (arg-count-error-minimum condition)))
           (t
            (format stream "between ~D and ~D expected"
-                   (defmacro-ll-arg-count-error-minimum condition)
-                   (defmacro-ll-arg-count-error-maximum condition))))
+                   (arg-count-error-minimum condition)
+                   (arg-count-error-maximum condition))))
      (format stream ", but ~D found"
-            (length (defmacro-ll-arg-count-error-argument condition))))))
+            (length (arg-count-error-argument condition))))))
 
 (define-condition defmacro-ll-broken-key-list-error
                  (defmacro-lambda-list-bind-error)
@@ -96,14 +86,16 @@
   (:report (lambda (condition stream)
             (print-defmacro-ll-bind-error-intro condition stream)
             (format stream
+                    ;; FIXME: These should probably just be three
+                    ;; subclasses of the base class, so that we don't
+                    ;; need to maintain the set of tags both here and
+                    ;; implicitly wherever this macro is used.
                     (ecase
                         (defmacro-ll-broken-key-list-error-problem condition)
                       (:dotted-list
                        "dotted keyword/value list: ~S")
                       (:odd-length
                        "odd number of elements in keyword/value list: ~S")
-                      (:duplicate
-                       "duplicate keyword: ~S")
                       (:unknown-keyword
                        "~{unknown keyword: ~S; expected one of ~{~S~^, ~}~}"))
                     (defmacro-ll-broken-key-list-error-info condition)))))