Commit f18e8222 authored by Pascal Costanza's avatar Pascal Costanza
Browse files

Class initialization patch.

The previous patch was partially incorrect. LispWorks and MCL don't need the change of the direct superclasses in primary methods on initialize-instance / reinitialize-instance. I have rearranged that part of the code back to what it was before.

darcs-hash:e3829cce37824704fb39f3cafdc3c6a92f2d3cf3
parent fbfe9405
......@@ -115,34 +115,21 @@
;; - Removal of direct subclasses.
(cl:defmethod initialize-instance :around
((class standard-class) &rest initargs)
(declare (dynamic-extent initargs))
(apply #'call-next-method class
:optimize-slot-access nil
initargs))
(cl:defmethod initialize-instance
((class standard-class)
&rest initargs
&key (direct-superclasses ())
&allow-other-keys)
((class standard-class)
&rest initargs
&key (direct-superclasses ())
&allow-other-keys)
(declare (dynamic-extent initargs))
(apply #'call-next-method class
:direct-superclasses (modify-superclasses direct-superclasses)
initargs))
(cl:defmethod reinitialize-instance :around
((class standard-class) &rest initargs)
(declare (dynamic-extent initargs))
(apply #'call-next-method class
:optimize-slot-access nil
initargs))
(cl:defmethod reinitialize-instance
((class standard-class)
&rest initargs
&key (direct-superclasses () direct-superclasses-p)
&allow-other-keys)
(cl:defmethod reinitialize-instance :around
((class standard-class)
&rest initargs
&key (direct-superclasses () direct-superclasses-p)
&allow-other-keys)
(declare (dynamic-extent initargs))
(when direct-superclasses-p
(setq direct-superclasses (modify-superclasses direct-superclasses))
......@@ -152,38 +139,28 @@
(if direct-superclasses-p
(apply #'call-next-method class
:direct-superclasses direct-superclasses
:optimize-slot-access nil
initargs)
(call-next-method)))
(apply #'call-next-method class
:optimize-slot-access nil
initargs)))
(cl:defmethod initialize-instance :around
((class funcallable-standard-class) &rest initargs)
(declare (dynamic-extent initargs))
(apply #'call-next-method class
:optimize-slot-access nil
initargs))
(cl:defmethod initialize-instance
((class funcallable-standard-class)
&rest initargs
&key (direct-superclasses ())
&allow-other-keys)
((class funcallable-standard-class)
&rest initargs
&key (direct-superclasses ())
&allow-other-keys)
(declare (dynamic-extent initargs))
(apply #'call-next-method class
:direct-superclasses (modify-superclasses direct-superclasses nil)
initargs))
(cl:defmethod reinitialize-instance :around
((class funcallable-standard-class) &rest initargs)
(declare (dynamic-extent initargs))
(apply #'call-next-method class
:optimize-slot-access nil
initargs))
(cl:defmethod reinitialize-instance
((class funcallable-standard-class)
&rest initargs
&key (direct-superclasses () direct-superclasses-p)
&allow-other-keys)
(cl:defmethod reinitialize-instance :around
((class funcallable-standard-class)
&rest initargs
&key (direct-superclasses () direct-superclasses-p)
&allow-other-keys)
(declare (dynamic-extent initargs))
(when direct-superclasses-p
(setq direct-superclasses (modify-superclasses direct-superclasses nil))
......@@ -193,8 +170,11 @@
(if direct-superclasses-p
(apply #'call-next-method class
:direct-superclasses direct-superclasses
:optimize-slot-access nil
initargs)
(call-next-method)))
(apply #'call-next-method class
:optimize-slot-access nil
initargs)))
;; The following is necessary for forward-referenced-classes.
;; Since we replace the original funcallable-standard-object with
......
......@@ -62,23 +62,23 @@
direct-superclasses
(remove standard-object direct-superclasses)))))
(cl:defmethod initialize-instance
((class standard-class)
&rest initargs
&key (name (gensym))
(direct-superclasses ())
&allow-other-keys)
(cl:defmethod initialize-instance :around
((class standard-class)
&rest initargs
&key (name (gensym))
(direct-superclasses ())
&allow-other-keys)
(declare (dynamic-extent initargs))
(apply #'call-next-method class
:name name
:direct-superclasses (modify-superclasses direct-superclasses)
initargs))
(cl:defmethod reinitialize-instance
((class standard-class)
&rest initargs
&key (direct-superclasses () direct-superclasses-p)
&allow-other-keys)
(cl:defmethod reinitialize-instance :around
((class standard-class)
&rest initargs
&key (direct-superclasses () direct-superclasses-p)
&allow-other-keys)
(declare (dynamic-extent initargs))
(if direct-superclasses-p
(apply #'call-next-method class
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment