X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fparse-defmacro-errors.lisp;h=104fd18bd659f1f95cd9ed697f0ac52e1b57055d;hb=90ca09b75fbc3b63b2f7d09c67b04b866dd783f6;hp=cea6ca629ea7c87f34a88555632a8281ca715878;hpb=de201aeb12169d0bd377eca4da6116c2797a66ad;p=sbcl.git diff --git a/src/code/parse-defmacro-errors.lisp b/src/code/parse-defmacro-errors.lisp index cea6ca6..104fd18 100644 --- 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. @@ -16,11 +14,11 @@ (in-package "SB!KERNEL") ;;; 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 @@ -34,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) @@ -57,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)) - (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)) - (format stream "exactly ~D expected" - (defmacro-ll-arg-count-error-minimum 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 ~W expected" + (arg-count-error-minimum condition))) + ((= (arg-count-error-minimum condition) + (arg-count-error-maximum condition)) + (format stream "exactly ~W expected" + (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)))) - (format stream ", but ~D found" - (length (defmacro-ll-arg-count-error-argument condition)))))) + (format stream "between ~W and ~W expected" + (arg-count-error-minimum condition) + (arg-count-error-maximum condition)))) + (format stream ", but ~W found" + (length (arg-count-error-argument condition)))))) (define-condition defmacro-ll-broken-key-list-error (defmacro-lambda-list-bind-error)