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

Fixed further incompatibilities in Clozure Common Lisp.

Ignore-this: c1267e8ac8c3631ea59e41a6d89c225f

darcs-hash:374009e105cf68cae13f7e39b5c9f401f140e476
parent 3fca9094
......@@ -64,8 +64,8 @@
(:method-functions-take-processed-parameters fixed)
(:method-lambdas-are-processed fixed)
(:reinitialize-instance-calls-compute-discriminating-function fixed)
(:reinitialize-instance-calls-finalize-inheritance)
(:reinitialize-lambda-list-reinitializes-argument-precedence-order)
(:reinitialize-instance-calls-finalize-inheritance fixed)
(:reinitialize-lambda-list-reinitializes-argument-precedence-order fixed)
(:remove-method-calls-compute-discriminating-function fixed)
(:slot-definition-documentation fixed)
(:subclasses-of-direct-slot-definition-do-not-inherit-exported-slots)
......
......@@ -38,10 +38,10 @@ Clozure Common Lisp 1.4
- Geveric function invocation doesn't call COMPUTE-APPLICABLE-METHODS, COMPUTE-APPLICABLE-METHODS-USING-CLASSES, or COMPUTE-EFFECTIVE-METHOD. Fixed.
- Generic functions cannot be empty when called. Fixed.
- MAKE-METHOD-LAMBDA is not supported. Fixed.
- Reinitialization of a lambda list doesn't update the argument precedence order.
- Reinitialization of a lambda list doesn't update the argument precedence order. Fixed.
- The slot order requested by a primary method for COMPUTE-SLOTS is not honoured by this MOP. Not fixed.
- DOCUMENTATION doesn't return the documentation strings for slot definition metaobjects. Fixed.
- 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. 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.
CMUCL 20a
......@@ -131,7 +131,7 @@ Summary:
- COMPUTE-DEFAULT-INITARGS doesn't exist (and isn't called) in LispWorks.
- In LispWorks, eql specializers are lists.
- FUNCALLABLE-STANDARD-INSTANCE-ACCESS and STANDARD-INSTANCE-ACCESS works in all supported Common Lisp implementations.
- In Clozure CL, CMUCL, MCL and OpenMCL, the reinitialization of a class metaobject does not lead to a call of FINALIZE-INHERITANCE, so methods defined on FINALIZE-INHERITANCE won't be called again in that case.
- In CMUCL, MCL and OpenMCL, the reinitialization of a class metaobject does not lead to a call of FINALIZE-INHERITANCE, so methods defined on FINALIZE-INHERITANCE won't be called again in that case.
- AMOP specifies that :declarations is used whereas ANSI Common Lisp specifies that 'declare is used. Since all MOP implementations adhere to AMOP in this regard, I have also chosen that path.
- In Allegro Common Lisp and LispWorks, method functions take the original parameters that a generic function has received.
- If you need to rely on the generic function protocols, don't use MCL or OpenMCL.
......
......@@ -11,6 +11,7 @@
#+ccl
(:shadow
#:standard-class
#:defgeneric #:standard-generic-function
#:defmethod #:standard-method #:method-function)
......@@ -51,7 +52,7 @@
#:compute-class-precedence-list
#:compute-default-initargs
#-ccl #:compute-discriminating-function
#:compute-effective-method
#-ccl #:compute-effective-method
#:compute-effective-slot-definition
#:compute-slots
#:direct-slot-definition-class
......
......@@ -131,6 +131,24 @@
(:method ((type1 class) (type2 class))
(member type2 (class-precedence-list type1)))))
#+ccl
(progn
(cl:defclass standard-class (cl:standard-class)
())
(cl:defmethod validate-superclass
((class standard-class)
(superclass cl:standard-class))
(or (when (eq (class-of class) (find-class 'standard-class))
(or (eq (class-of superclass) (find-class 'cl:standard-class))
(eq (class-of superclass) (find-class 'standard-class))))
(call-next-method)
(when (eq (class-of superclass) (find-class 'cl:standard-class))
(validate-superclass class (class-prototype (find-class 'standard-class))))))
(cl:defmethod reinitialize-instance :after ((class standard-class) &key)
(finalize-inheritance class)))
#+ccl
(progn
(cl:defgeneric method-function (method)
......@@ -183,6 +201,18 @@
(:metaclass funcallable-standard-class)
(:default-initargs :name (gensym) :method-class (find-class 'standard-method)))
(cl:defmethod reinitialize-instance :around
((gf standard-generic-function) &rest initargs &key
(lambda-list '() lambda-list-p)
(argument-precedence-order '() argument-precedence-order-p))
(declare (dynamic-extent initargs)
(ignore argument-precedence-order))
(if (and lambda-list-p (not argument-precedence-order-p))
(apply #'call-next-method gf
:argument-precedence-order (required-args lambda-list)
initargs)
(call-next-method)))
#|
(defun ensure-generic-function
(name &rest args
......@@ -256,6 +286,8 @@
collect pos into argument-order
finally (setf (argument-order gf) (coerce argument-order 'simple-vector)))))
(cl:defgeneric compute-effective-method (gf combination methods))
(cl:defmethod compute-effective-method ((gf standard-generic-function)
(combination ccl:standard-method-combination)
methods)
......
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