X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdefclass.lisp;h=33bfd0b1a3024063326c7942436f413e21d406b9;hb=83de338570dd0d867a9a247213ac16f0ab85c123;hp=85d0fc37985f584ae3e6dca5bbe8b627c1f33054;hpb=09702467ab16baab34dc209606d9d07af38eaedd;p=sbcl.git diff --git a/src/pcl/defclass.lisp b/src/pcl/defclass.lisp index 85d0fc3..33bfd0b 100644 --- a/src/pcl/defclass.lisp +++ b/src/pcl/defclass.lisp @@ -53,7 +53,7 @@ ;; DEFSTRUCT-P should be true if the class is defined ;; with a metaclass STRUCTURE-CLASS, so that a DEFSTRUCT ;; is compiled for the class. - (defstruct-p (and (eq *boot-state* 'complete) + (defstruct-p (and (eq **boot-state** 'complete) (let ((mclass (find-class metaclass nil))) (and mclass (*subtypep @@ -72,7 +72,8 @@ ',*readers-for-this-defclass* ',*writers-for-this-defclass* ',*slot-names-for-this-defclass* - (sb-c:source-location))))) + (sb-c:source-location) + ',(safe-code-p env))))) (if defstruct-p (progn ;; FIXME: (YUK!) Why do we do this? Because in order @@ -120,9 +121,10 @@ (defun canonize-defclass-options (class-name options) (maplist (lambda (sublist) (let ((option-name (first (pop sublist)))) - (when (member option-name sublist :key #'first) - (error "Multiple ~S options in DEFCLASS ~S." - option-name class-name)))) + (when (member option-name sublist :key #'first :test #'eq) + (error 'simple-program-error + :format-control "Multiple ~S options in DEFCLASS ~S." + :format-arguments (list option-name class-name))))) options) (let (metaclass default-initargs @@ -135,14 +137,15 @@ (:metaclass (let ((maybe-metaclass (second option))) (unless (and maybe-metaclass (legal-class-name-p maybe-metaclass)) - (error "~@" - maybe-metaclass)) + :format-arguments (list maybe-metaclass))) (setf metaclass maybe-metaclass))) (:default-initargs (let (initargs arg-names) (doplist (key val) (cdr option) - (when (member key arg-names) + (when (member key arg-names :test #'eq) (error 'simple-program-error :format-control "~@