src/code/parse-defmacro-errors.lisp

   1 ;;;; error-handling machinery for PARSE-DEFMACRO, separated from PARSE-DEFMACRO
   2 ;;;; code itself because the happy path can be handled earlier in the bootstrap
   3 ;;;; sequence than DEFINE-CONDITION can be, and because some of the error
   4 ;;;; handling depends on SBCL extensions, while PARSE-DEFMACRO needs to run in
   5 ;;;; the cross-compiler on the host Common Lisp
   6
   7 ;;;; This software is part of the SBCL system. See the README file for
   8 ;;;; more information.
   9 ;;;;
  10 ;;;; This software is derived from the CMU CL system, which was
  11 ;;;; written at Carnegie Mellon University and released into the
  12 ;;;; public domain. The software is in the public domain and is
  13 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  14 ;;;; files for more information.
  15
  16 (in-package "SB!KERNEL")
  17
  18 (file-comment
  19   "$Header$")
  20
  21 ;;; We save space in macro definitions by calling this function.
  22 (defun do-arg-count-error (error-kind name arg lambda-list minimum maximum)
  23   (multiple-value-bind (fname sb!debug:*stack-top-hint*) (find-caller-name)
  24     (error 'defmacro-ll-arg-count-error
  25            :kind error-kind
  26            :function-name fname
  27            :name name
  28            :argument arg
  29            :lambda-list lambda-list
  30            :minimum minimum :maximum maximum)))
  31
  32 (define-condition defmacro-lambda-list-bind-error (error)
  33   ((kind :reader defmacro-lambda-list-bind-error-kind
  34          :initarg :kind)
  35    (name :reader defmacro-lambda-list-bind-error-name
  36          :initarg :name
  37          :initform nil)))
  38
  39 (defun print-defmacro-ll-bind-error-intro (condition stream)
  40   (if (null (defmacro-lambda-list-bind-error-name condition))
  41       (format stream
  42               "error while parsing arguments to ~A in ~S:~%"
  43               (defmacro-lambda-list-bind-error-kind condition)
  44               (condition-function-name condition))
  45       (format stream
  46               "error while parsing arguments to ~A ~S:~%"
  47               (defmacro-lambda-list-bind-error-kind condition)
  48               (defmacro-lambda-list-bind-error-name condition))))
  49
  50 (define-condition defmacro-bogus-sublist-error
  51                   (defmacro-lambda-list-bind-error)
  52   ((object :reader defmacro-bogus-sublist-error-object :initarg :object)
  53    (lambda-list :reader defmacro-bogus-sublist-error-lambda-list
  54                 :initarg :lambda-list))
  55   (:report
  56    (lambda (condition stream)
  57      (print-defmacro-ll-bind-error-intro condition stream)
  58      (format stream
  59              "bogus sublist:~%  ~S~%to satisfy lambda-list:~%  ~:S~%"
  60              (defmacro-bogus-sublist-error-object condition)
  61              (defmacro-bogus-sublist-error-lambda-list condition)))))
  62
  63 (define-condition defmacro-ll-arg-count-error (defmacro-lambda-list-bind-error)
  64   ((argument :reader defmacro-ll-arg-count-error-argument :initarg :argument)
  65    (lambda-list :reader defmacro-ll-arg-count-error-lambda-list
  66                 :initarg :lambda-list)
  67    (minimum :reader defmacro-ll-arg-count-error-minimum :initarg :minimum)
  68    (maximum :reader defmacro-ll-arg-count-error-maximum :initarg :maximum))
  69   (:report
  70    (lambda (condition stream)
  71      (print-defmacro-ll-bind-error-intro condition stream)
  72      (format stream
  73              "invalid number of elements in:~%  ~:S~%~
  74              to satisfy lambda-list:~%  ~:S~%"
  75              (defmacro-ll-arg-count-error-argument condition)
  76              (defmacro-ll-arg-count-error-lambda-list condition))
  77      (cond ((null (defmacro-ll-arg-count-error-maximum condition))
  78             (format stream "at least ~D expected"
  79                     (defmacro-ll-arg-count-error-minimum condition)))
  80            ((= (defmacro-ll-arg-count-error-minimum condition)
  81                (defmacro-ll-arg-count-error-maximum condition))
  82             (format stream "exactly ~D expected"
  83                     (defmacro-ll-arg-count-error-minimum condition)))
  84            (t
  85             (format stream "between ~D and ~D expected"
  86                     (defmacro-ll-arg-count-error-minimum condition)
  87                     (defmacro-ll-arg-count-error-maximum condition))))
  88      (format stream ", but ~D found"
  89              (length (defmacro-ll-arg-count-error-argument condition))))))
  90
  91 (define-condition defmacro-ll-broken-key-list-error
  92                   (defmacro-lambda-list-bind-error)
  93   ((problem :reader defmacro-ll-broken-key-list-error-problem
  94             :initarg :problem)
  95    (info :reader defmacro-ll-broken-key-list-error-info :initarg :info))
  96   (:report (lambda (condition stream)
  97              (print-defmacro-ll-bind-error-intro condition stream)
  98              (format stream
  99                      (ecase
 100                          (defmacro-ll-broken-key-list-error-problem condition)
 101                        (:dotted-list
 102                         "dotted keyword/value list: ~S")
 103                        (:odd-length
 104                         "odd number of elements in keyword/value list: ~S")
 105                        (:duplicate
 106                         "duplicate keyword: ~S")
 107                        (:unknown-keyword
 108                         "~{unknown keyword: ~S; expected one of ~{~S~^, ~}~}"))
 109                      (defmacro-ll-broken-key-list-error-info condition)))))