From 30dba2ad2162af1239d96c8a4ab26709d72de72a Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 25 May 2021 12:17:22 -0700 Subject: DEFINE-DOTTED-PROPERTY-MACRO: avoid evaluating default value forms Signed-off-by: Sean Whitton --- src/property.lisp | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/src/property.lisp b/src/property.lisp index 3cc9b04..e34b579 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -232,7 +232,15 @@ through unmodified, so supplied-p information is preserved." (if will-props (setq rest (lastcar main) main (nconc (nbutlast main) (list '&rest rest))) - (nconc (list '&whole whole) (ordinary-ll-without-&aux args))))) + (list* '&whole whole + ;; Strip default values (so we don't evaluate those + ;; forms here and also in the property), and strip + ;; supplied-p parameters for good measure as we will + ;; not use them. + (loop for elt in (ordinary-ll-without-&aux args) + if (listp elt) + collect (list (car elt) nil) + else collect elt))))) `(defmacro ,(format-symbol (symbol-package name) "~A." name) ,new-args ,@(cond ((and first will-props) @@ -243,13 +251,11 @@ through unmodified, so supplied-p information is preserved." :propspec (props eseqprops ,@,rest))))) (first `((declare (ignore ,@(cdr (ordinary-ll-variable-names - (ordinary-ll-without-&aux args) - :include-supplied-p t)))) + (ordinary-ll-without-&aux args))))) (list* ',name ,first (cddr ,whole)))) (t `((declare (ignore ,@(ordinary-ll-variable-names - (ordinary-ll-without-&aux args) - :include-supplied-p t))) + (ordinary-ll-without-&aux args)))) (cons ',name (cdr ,whole))))))))) (defmacro define-property-defining-macro -- cgit v1.2.3