diff --git a/src/cmp/cmplam.lsp b/src/cmp/cmplam.lsp index 9709a7917..a1b666c6a 100644 --- a/src/cmp/cmplam.lsp +++ b/src/cmp/cmplam.lsp @@ -539,8 +539,8 @@ The function thus belongs to the type of functions that ecl_make_cfun accepts." (pop arguments)) (apply-p `(if ,apply-var - (pop ,apply-var) - (si::dm-too-few-arguments))) + (pop ,apply-var) + (si::dm-too-few-arguments nil))) (t (cmperr "Too few arguments for lambda form ~S" (cons 'LAMBDA lambda-form))))) diff --git a/src/cmp/proclamations.lsp b/src/cmp/proclamations.lsp index 1fb9d05dd..24baf612c 100644 --- a/src/cmp/proclamations.lsp +++ b/src/cmp/proclamations.lsp @@ -260,6 +260,9 @@ (proclamation si::etypecase-error (t t) t) (proclamation si::do-check-type (t t t t) t) +(proclamation si::dm-too-many-arguments (t) t) +(proclamation si::dm-too-few-arguments (t) t) + ;;; ;;; 7. OBJECTS ;;; diff --git a/src/cmp/sysfun.lsp b/src/cmp/sysfun.lsp index 616727243..1ddd0b9e0 100644 --- a/src/cmp/sysfun.lsp +++ b/src/cmp/sysfun.lsp @@ -965,7 +965,7 @@ si::ecase-error si::etypecase-error si::do-check-type ccase-error typecase-error-string find-documentation find-declarations si::search-keyword si::check-keyword - si::dm-too-many-arguments si::dm-too-few-arguments si::dm-bad-key + si::dm-too-many-arguments si::dm-too-few-arguments remove-documentation si::get-documentation si::set-documentation si::expand-set-documentation si::packages-iterator diff --git a/src/lsp/defmacro.lsp b/src/lsp/defmacro.lsp index 04d6279ea..1cee7ec98 100644 --- a/src/lsp/defmacro.lsp +++ b/src/lsp/defmacro.lsp @@ -77,16 +77,18 @@ ((not (member head keywords)) (setq err head))))) -(defun dm-too-many-arguments (extra) - (error "Too many arguments supplied to a macro:~%~s" extra)) +(defun dm-too-many-arguments (*current-form*) + (error "Too many arguments supplied to a macro or a destructuring-bind form:~%~s" + *current-form*)) -(defun dm-bad-key (key) - (error "Defmacro-lambda-list contains illegal use of ~s." key)) +(defun dm-too-few-arguments (form-or-nil) + (if form-or-nil + (let ((*current-form* form-or-nil)) + (error "Too few arguments supplied to a macro or a destructuring-bind form:~%~S" + *current-form*)) + (error "Too few arguments supplied to a inlined lambda form."))) -(defun dm-too-few-arguments () - (error "Too few arguments supplied to a macro or a destructuring-bind form.")) - -(defun sys::destructure (vl macro) +(defun sys::destructure (vl macro &aux (basis-form (gensym))) (declare (si::c-local) (special *dl* *arg-check*)) (labels ((dm-vl (vl whole macro) @@ -105,7 +107,7 @@ (dolist (v (cdr reqs)) (dm-v v `(progn (if (null ,pointer) - (dm-too-few-arguments)) + (dm-too-few-arguments ,basis-form)) (prog1 ,unsafe-car ,unsafe-pop)))) (dotimes (i (pop opts)) (let* ((x (first opts)) @@ -143,7 +145,7 @@ ,@(if allow-other-keys '(t) '())) *arg-check*)) ((not no-check) - (push `(if ,pointer (dm-too-many-arguments ,pointer)) + (push `(if ,pointer (dm-too-many-arguments ,basis-form)) *arg-check*))) ppn))) @@ -166,7 +168,7 @@ (push (if init (list temp init) temp) *dl*) (dm-vl v temp nil)))))) - (let* ((whole (gensym)) + (let* ((whole basis-form) (*dl* nil) (*arg-check* nil)) (declare (special *dl* *arg-check*))