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

Resurrected and updated support for MCL, now at MCL 5.2.1.

Ignore-this: 56c0c208f88425296c2fc8dc44f94e74

darcs-hash:dacb2a333755d97d8f748934f9bd98e6c484a39f
parent 1fa6c255
......@@ -274,10 +274,11 @@
(:subclasses-of-standard-slot-definition-do-not-inherit-exported-slots)
(:subclasses-of-standard-writer-method-do-not-inherit-exported-slots))
:mcl
:mcl5.2.1
((:add-method-calls-compute-discriminating-function)
(:compute-applicable-methods-using-classes)
(:default-superclass-for-funcallable-standard-class-is-funcallable-standard-object)
(:compute-slots-requested-slot-order-honoured)
(:default-superclass-for-funcallable-standard-class-is-funcallable-standard-object fixed)
(:defmethod-calls-generic-function-method-class)
(:defmethod-calls-make-method-lambda)
(:discriminating-functions-can-be-closures)
......@@ -294,24 +295,14 @@
(:method-functions-take-processed-parameters)
(:method-lambdas-are-processed)
(:reinitialize-instance-calls-compute-discriminating-function)
(:reinitialize-instance-calls-finalize-inheritance)
(:reinitialize-lambda-list-reinitializes-argument-precedence-order)
(:remove-method-calls-compute-discriminating-function)
(:set-funcallable-instance-function)
(:setf-generic-function-name)
(:setf-generic-function-name-calls-reinitialize-instance)
(:standard-class-and-funcallable-standard-class-are-compatible)
; ---
(:compute-slots-requested-slot-order-honoured)
(:direct-slot-definition fixed)
(:direct-superclasses-by-default-empty) ; not fixed, but direct superclasses are automatically adjusted, not for funcallable-standard-class though
(:effective-slot-definition fixed)
(:eql-specializer fixed)
(:extensible-allocation)
(:multiple-slot-options-passed-as-list-to-direct-slot-definition-class) ; fix with fix-slot-initargs
(:reinitialize-instance-calls-finalize-inheritance)
(:setf-class-name-calls-reinitialize-instance)
(:slot-definition fixed)
(:standard-slot-definition fixed)
(:slot-reader-calls-slot-value-using-class fixed)
(:slot-writer-calls-slot-value-using-class fixed)
(:subclasses-of-direct-slot-definition-do-not-inherit-exported-slots)
(:subclasses-of-effective-slot-definition-do-not-inherit-exported-slots)
(:subclasses-of-slot-definition-do-not-inherit-exported-slots)
......
......@@ -82,17 +82,14 @@ LispWorks, 5.1.2 Personal & Professional Edition
- STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS are not compatible. Not fixed.
- Subclasses of BUILT-IN-CLASS (fixed), CLASS (fixed), DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, FORWARD-REFERENCED-CLASS (fixed), FUNCALLABLE-STANDARD-CLASS (fixed), SLOT-DEFINITION, STANDARD-ACCESSOR-METHOD, STANDARD-CLASS (fixed), 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, except where indicated otherwise.
MCL 5.1
MCL 5.2.1
In MCL, generic functions work completely differently than specified. The specific incompatibilities are not listed and are not fixed.
- The slot order requested by a primary method for COMPUTE-SLOTS is not honoured by this MOP. Not fixed.
- DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, EQL-SPECIALIZER, SLOT-DEFINITION and STANDARD-SLOT-DEFINITION are not exported. Fixed.
- When classes are initialized, :direct-superclasses are by default not empty. Not fixed, but direct superclasses are automatically adjusted when you use the standard idiom for adding a new default superclass.
- The :ALLOCATION type cannot be extended. Not fixed.
- Multiple slot options are not passed as lists to DIRECT-SLOT-DEFINITION-CLASS. Not fixed, but use FIX-SLOT-INITARGS as a workaround.
- (SETF CLASS-NAME) doesn't use REINITIALIZE-INSTANCE for changing the names. Fixed.
- FUNCALLABLE-STANDARD-OBJECT is not exported. Fixed.
- REINITIALIZE-INSTANCE of a class metaobject doesn't invoke FINALIZE-INHERITANCE again. Not fixed.
- The automatically created accessor methods in DEFCLASS forms don't call SLOT-VALUE-USING-CLASS and (SETF SLOT-VALUE-USING-CLASS). Fixed.
- Subclasses of DIRECT-SLOT-DEFINITION, EFFECTIVE-SLOT-DEFINITION, 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 1.0.31
......
......@@ -68,45 +68,20 @@
(when (eq (class-of superclass) (find-class 'cl:standard-class))
(validate-superclass class (class-prototype (find-class 'standard-class))))))
;; In MCL, the list of direct superclasses passed by the
;; defclass macro is not empty, as required by AMOP, but
;; instead passes the class metaobject for standard-object
;; or funcallable-standard-object respectively. This makes
;; replacing the default superclass for a new metaclass a bit
;; more complicated. In order to avoid the tricky bits in user
;; code, the new standard-class adjusts possible incorrect
;; direct superclasses by adding or removing the metaobject
;; for standard-object as needed before passing them to
;; the original standard-class. In user code, just use the
;; idiom suggested by AMOP to APPEND your new default superclass
;; to the list of direct superclasses.
(defun modify-superclasses (direct-superclasses)
(if (null direct-superclasses)
(list (find-class 'standard-object))
(let ((standard-object (find-class 'standard-object)))
(if (eq (car (last direct-superclasses)) standard-object)
direct-superclasses
(remove standard-object direct-superclasses)))))
(cl:defmethod initialize-instance :around
((class standard-class) &rest initargs
&key (name (gensym)) (direct-superclasses ()))
(declare (dynamic-extent initargs))
(apply #'call-next-method class
:name name
:direct-superclasses (modify-superclasses direct-superclasses)
initargs))
(cl:defmethod ccl::create-reader-method-function
((class standard-class)
(reader-method-class standard-reader-method)
(dslotd standard-direct-slot-definition))
(let ((slot-name (slot-definition-name dslotd)))
(compile nil `(lambda (object) (slot-value object ',slot-name)))))
(cl:defmethod reinitialize-instance :around
((class standard-class) &rest initargs
&key (direct-superclasses () direct-superclasses-p))
(declare (dynamic-extent initargs))
(if direct-superclasses-p
(apply #'call-next-method class
:direct-superclasses (modify-superclasses direct-superclasses)
initargs)
(call-next-method)))
(cl:defmethod ccl::create-writer-method-function
((class standard-class)
(writer-method-class standard-writer-method)
(dslotd standard-direct-slot-definition))
(let ((slot-name (slot-definition-name dslotd)))
(compile nil `(lambda (new-value object)
(setf (slot-value object ',slot-name) new-value)))))
(defgeneric typep (object type)
(:method (object type)
......@@ -757,27 +732,7 @@
:initargs :initform :initfunction
:readers :writers))
(defun fix-slot-initargs (initargs)
#+ccl initargs
#-ccl (let* ((counts (loop with counts
for (key nil) on initargs by #'cddr
do (incf (getf counts key 0))
finally (return counts)))
(keys-to-fix (loop for (key value) on counts by #'cddr
if (> value 1) collect key)))
(if keys-to-fix
(let ((multiple-standard-keys
(intersection keys-to-fix *standard-slot-keys*)))
(if multiple-standard-keys
(error "Too many occurences of ~S in slot initargs ~S."
multiple-standard-keys initargs)
(loop with fixed-keys
for (key value) on initargs by #'cddr
if (member key keys-to-fix)
do (nconcf (getf fixed-keys key) (list value))
else nconc (list key value) into fixed-initargs
finally (return (nconc fixed-initargs fixed-keys)))))
initargs)))
(defun fix-slot-initargs (initargs) initargs)
(eval-when (:compile-toplevel :load-toplevel :execute)
(pushnew :closer-mop *features*))
......@@ -4,5 +4,6 @@ Clozure Common Lisp 1.4
CMU Common Lisp 20a
LispWorks 5.1.1 Personal Edition
LispWorks 5.1.2 Professional Edition
MCL 5.2.1
SBCL 1.0.32
Scieneer 1.3.9
\ No newline at end of file
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