diff --git a/pcl/ctor.lisp b/pcl/ctor.lisp index 830cfc64605b484a6fdc4a41ef6845ae93fa2ede..270149b2481750f7a2c6733390a8135cd7e467ca 100644 --- a/pcl/ctor.lisp +++ b/pcl/ctor.lisp @@ -46,7 +46,7 @@ ;;; is called. (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/ctor.lisp,v 1.16 2003/09/03 10:17:22 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/ctor.lisp,v 1.17 2004/08/06 17:21:54 rtoy Exp $") (in-package "PCL") @@ -54,6 +54,15 @@ ;;; Utilities ******* ;;; ****************** +(defun quote-plist-keys (plist) + (loop for (key . more) on plist by #'cddr + if (null more) do + (error "Not a property list: ~S" plist) + else + collect `(quote ,key) + and collect (car more))) + + (defun plist-keys (plist &key test) (loop for (key . more) on plist by #'cddr if (null more) do @@ -402,9 +411,11 @@ collect `(funcall (truly-the function ,fn) ,args ())))) (values `(let (,@(when (or ii-before ii-after) - `((.ii-args. (list .instance. ,@initargs)))) + `((.ii-args. + (list .instance. ,@(quote-plist-keys initargs))))) ,@(when (or si-before si-after) - `((.si-args. (list .instance. t ,@initargs))))) + `((.si-args. + (list .instance. t ,@(quote-plist-keys initargs)))))) ,@(method-calls ii-before '.ii-args.) ,@(method-calls si-before '.si-args.) ,slot-inits