From 7859810d97f529fdf42773c4629e79e4b844411e Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Mon, 17 May 1993 08:36:48 +0000 Subject: [PATCH] Use an auxiliary function to make the condition for arg count errors to save space in macro definitions. --- code/defmacro.lisp | 38 ++++++++++++++++++++++++++++---------- 1 file changed, 28 insertions(+), 10 deletions(-) diff --git a/code/defmacro.lisp b/code/defmacro.lisp index 372e9b669..3825a8588 100644 --- a/code/defmacro.lisp +++ b/code/defmacro.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defmacro.lisp,v 1.13 1992/08/12 18:56:32 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defmacro.lisp,v 1.14 1993/05/17 08:36:48 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -229,15 +229,19 @@ arg-list-name))) ,@(unless restp (list maximum))) - (,error-fun 'defmacro-ll-arg-count-error - :kind ',error-kind - ,@(when name `(:name ',name)) - :argument ,(if top-level - `(cdr ,arg-list-name) - arg-list-name) - :lambda-list ',lambda-list - :minimum ,minimum - ,@(unless restp `(:maximum ,maximum)))) + ,(let ((arg (if top-level + `(cdr ,arg-list-name) + arg-list-name))) + (if (eq error-fun 'error) + `(do-arg-count-error ',error-kind ',name ,arg ',lambda-list + ,minimum ,(unless restp maximum)) + `(,error-fun 'defmacro-ll-arg-count-error + :kind ',error-kind + ,@(when name `(:name ',name)) + :argument ,arg + :lambda-list ',lambda-list + :minimum ,minimum + ,@(unless restp `(:maximum ,maximum)))))) *arg-tests*) (if keys (let ((problem (gensym "KEY-PROBLEM-")) @@ -255,6 +259,20 @@ *arg-tests*))) (values env-arg-used minimum (if (null restp) maximum nil)))) +;;; We save space in macro definitions by callig this function. +;;; +(defun do-arg-count-error (error-kind name arg lambda-list minimum maximum) + (multiple-value-bind + (fname debug:*stack-top-hint*) + (kernel:find-caller-name) + (error 'defmacro-ll-arg-count-error + :kind error-kind + :function-name fname + :name name + :argument arg + :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-"))) (push `(,variable -- GitLab