Commit 7a1791a4 authored by Pascal Costanza's avatar Pascal Costanza
Browse files

Checked against sbcl 0.9.16 - several changes.

SBCL 0.9.16 now passes all MOP Feature Tests.

This makes several changes necessary in the Closer to MOP support for SBCL, again. Therefore, support for SBCL 0.9.15 is dropped. The darcs repository has been tagged with '0.33' in case you need a version that works with SBCL 0.9.15.

darcs-hash:4bfdc272ae29918f08b54d0bdc14fed29b443814
parent 0b9a17da
...@@ -388,11 +388,5 @@ ...@@ -388,11 +388,5 @@
:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots (no) :subclasses-of-standard-slot-definition-do-not-inherit-exported-slots (no)
:subclasses-of-standard-writer-method-do-not-inherit-exported-slots (no) :subclasses-of-standard-writer-method-do-not-inherit-exported-slots (no)
:sbcl 0.9.15 :sbcl 0.9.16
:accessor-method-initialized-with-function (fixed) #| all features implemented |#
:accessor-method-initialized-with-lambda-list (fixed)
:accessor-method-initialized-with-slot-definition (fixed)
:accessor-method-initialized-with-specializers (fixed)
:class-initialization-calls-reader-method-class (fixed)
:class-initialization-calls-writer-method-class (fixed)
:method-initialized-with-function (no)
...@@ -136,11 +136,9 @@ In OpenMCL, generic functions work completely differently than specified. The sp ...@@ -136,11 +136,9 @@ In OpenMCL, generic functions work completely differently than specified. The sp
- REINITIALIZE-INSTANCE of a class metaobject doesn't invoke FINALIZE-INHERITANCE again. Not fixed. - REINITIALIZE-INSTANCE of a class metaobject doesn't invoke FINALIZE-INHERITANCE again. Not fixed.
- Subclasses of DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, GENERIC-FUNCTION, SLOT-DEFINITION, STANDARD-ACCESSOR-METHOD, STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed. - Subclasses of DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, GENERIC-FUNCTION, SLOT-DEFINITION, STANDARD-ACCESSOR-METHOD, STANDARD-DIRECT-SLOT-DEFINITION, STANDARD-EFFECTIVE-SLOT-DEFINITION, STANDARD-GENERIC-FUNCTION, STANDARD-METHOD, STANDARD-READER-METHOD, STANDARD-SLOT-DEFINITION and STANDARD-WRITER-METHOD will inherit slots whose names are exported symbols and/or accessible in the package common-lisp-user. Not fixed.
SBCL 0.9.15 SBCL 0.9.16
- Accessor methods are not initialized with :function, :lambda-list, :slot-definition and :specializers. Fixed. All features implemented.
- Class initialization doesn't call READER-METHOD-CLASS and WRITER-METHOD-CLASS for accessor methods. Fixed.
- Methods are not initialized with :function. Not fixed.
Summary: Summary:
......
...@@ -69,10 +69,11 @@ ...@@ -69,10 +69,11 @@
(:metaclass standard-class)))) (:metaclass standard-class))))
|# |#
;; In CMUCL and SBCL, reader-method-class and writer-method-class are ;; In CMUCL, reader-method-class and writer-method-class are
;; not used during class initialization. The following definitions ;; not used during class initialization. The following definitions
;; correct this. ;; correct this.
#-sbcl
(defun modify-accessors (class) (defun modify-accessors (class)
(loop with reader-specializers = (list class) (loop with reader-specializers = (list class)
with writer-specializers = (list (find-class 't) class) with writer-specializers = (list (find-class 't) class)
...@@ -112,11 +113,6 @@ ...@@ -112,11 +113,6 @@
(prog1 (apply #'call-next-method class :name name initargs) (prog1 (apply #'call-next-method class :name name initargs)
(modify-accessors class))) (modify-accessors class)))
#+sbcl
(cl:defmethod initialize-instance :after
((class standard-class) &key)
(modify-accessors class))
#-sbcl #-sbcl
(cl:defmethod initialize-instance :around (cl:defmethod initialize-instance :around
((class funcallable-standard-class) &rest initargs ((class funcallable-standard-class) &rest initargs
...@@ -125,15 +121,12 @@ ...@@ -125,15 +121,12 @@
(prog1 (apply #'call-next-method class :name name initargs) (prog1 (apply #'call-next-method class :name name initargs)
(modify-accessors class))) (modify-accessors class)))
#+sbcl #-sbcl
(cl:defmethod initialize-instance :after
((class funcallable-standard-class) &key)
(modify-accessors class))
(cl:defmethod reinitialize-instance :after (cl:defmethod reinitialize-instance :after
((class standard-class) &key) ((class standard-class) &key)
(modify-accessors class)) (modify-accessors class))
#-sbcl
(cl:defmethod reinitialize-instance :after (cl:defmethod reinitialize-instance :after
((class funcallable-standard-class) &key) ((class funcallable-standard-class) &key)
(modify-accessors class)) (modify-accessors class))
...@@ -144,9 +137,9 @@ ...@@ -144,9 +137,9 @@
;; The following method additionally ensures that ;; The following method additionally ensures that
;; compute-discriminating-function is triggered. ;; compute-discriminating-function is triggered.
; Note that for CMUCL and SBCL, these methods violate the AMOP specification ; Note that for CMUCL, these methods violate the AMOP specification
; by specializing on the original standard-generic-function metaclass. However, ; by specializing on the original standard-generic-function metaclass. However,
; this is necassary because in CMUCL and SBCL, only one subclass of ; this is necassary because in CMUCL, only one subclass of
; standard-generic-function can be created, and taking away that option from user ; standard-generic-function can be created, and taking away that option from user
; code doesn't make a lot of sense in our context. ; code doesn't make a lot of sense in our context.
...@@ -172,7 +165,7 @@ ...@@ -172,7 +165,7 @@
(map-dependents (map-dependents
gf (lambda (dep) (update-dependent gf dep 'remove-method method)))) gf (lambda (dep) (update-dependent gf dep 'remove-method method))))
#| #+sbcl
(defun ensure-method (gf lambda-expression (defun ensure-method (gf lambda-expression
&key (method-class (generic-function-method-class gf)) &key (method-class (generic-function-method-class gf))
(qualifiers ()) (qualifiers ())
...@@ -192,7 +185,6 @@ ...@@ -192,7 +185,6 @@
method-args))) method-args)))
(add-method gf method) (add-method gf method)
method))) method)))
|#
#| #|
(defgeneric transform-specializer (specializer) (defgeneric transform-specializer (specializer)
...@@ -203,6 +195,7 @@ ...@@ -203,6 +195,7 @@
`(eql ,(eql-specializer-object specializer)))) `(eql ,(eql-specializer-object specializer))))
|# |#
#-sbcl
(defun ensure-method (gf lambda-expression (defun ensure-method (gf lambda-expression
&key (qualifiers ()) &key (qualifiers ())
(lambda-list (cadr lambda-expression)) (lambda-list (cadr lambda-expression))
...@@ -254,21 +247,21 @@ ...@@ -254,21 +247,21 @@
(keys-to-fix (loop for (key value) on counts by #'cddr (keys-to-fix (loop for (key value) on counts by #'cddr
if (> value 1) collect key))) if (> value 1) collect key)))
(if keys-to-fix (if keys-to-fix
(let ((multiple-standard-keys (let ((multiple-standard-keys
(intersection keys-to-fix *standard-slot-keys*))) (intersection keys-to-fix *standard-slot-keys*)))
(if multiple-standard-keys (if multiple-standard-keys
(error "Too many occurences of ~S in slot initargs ~S." (error "Too many occurences of ~S in slot initargs ~S."
multiple-standard-keys initargs) multiple-standard-keys initargs)
(loop with fixed-keys (loop with fixed-keys
for (key value) on initargs by #'cddr for (key value) on initargs by #'cddr
if (member key keys-to-fix) if (member key keys-to-fix)
do (nconcf (getf fixed-keys key) (list value)) do (nconcf (getf fixed-keys key) (list value))
else nconc (list key value) into fixed-initargs else nconc (list key value) into fixed-initargs
finally (return (nconc fixed-initargs fixed-keys))))) finally (return (nconc fixed-initargs fixed-keys)))))
initargs))) initargs)))
;; TYPEP and SUBTYPEP don't work as expected in conjunction with ;; In CMUCL, TYPEP and SUBTYPEP don't work as expected
;; class metaobjects ;; in conjunction with class metaobjects.
#-sbcl #-sbcl
(progn (progn
......
...@@ -5,4 +5,4 @@ LispWorks 4.4.5, 4.4.6 Personal Edition ...@@ -5,4 +5,4 @@ LispWorks 4.4.5, 4.4.6 Personal Edition
LispWorks 4.4.5, 4.4.6 Professional Edition LispWorks 4.4.5, 4.4.6 Professional Edition
Macintosh Common Lisp 5.1 Macintosh Common Lisp 5.1
OpenMCL 1.0 OpenMCL 1.0
SBCL 0.9.15 SBCL 0.9.16
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