| 1 | ;;;; Does not currently include all the MOP, but it should. |
|---|
| 2 | |
|---|
| 3 | (in-package #:mop) |
|---|
| 4 | |
|---|
| 5 | ;;; StandardGenericFunction.java defines FUNCALLABLE-INSTANCE-FUNCTION and |
|---|
| 6 | ;;; SET-FUNCALLABLE-INSTANCE-FUNCTION. |
|---|
| 7 | ;;; |
|---|
| 8 | ;;; TODO |
|---|
| 9 | ;;; |
|---|
| 10 | ;;; 1. Verify that we can make FUNCALLABLE-STANDARD-CLASS instances |
|---|
| 11 | ;;; which work. |
|---|
| 12 | ;;; |
|---|
| 13 | ;;; 2. Tighten the type checks so that only instances of |
|---|
| 14 | ;;; FUNCALLABLE-STANDARD-CLASS are callable. |
|---|
| 15 | |
|---|
| 16 | ;;; AMOP pg. 240ff. |
|---|
| 17 | (defgeneric validate-superclass (class superclass) |
|---|
| 18 | (:documentation |
|---|
| 19 | "This generic function is called to determine whether the class |
|---|
| 20 | superclass is suitable for use as a superclass of class.")) |
|---|
| 21 | |
|---|
| 22 | (defmethod validate-superclass ((class class) (superclass class)) |
|---|
| 23 | (or (eql superclass +the-T-class+) |
|---|
| 24 | (eql (class-of class) (class-of superclass)) |
|---|
| 25 | (or (and (eql (class-of class) +the-standard-class+) |
|---|
| 26 | (eql (class-of superclass) +the-funcallable-standard-class+)) |
|---|
| 27 | (and (eql (class-of class) +the-funcallable-standard-class+) |
|---|
| 28 | (eql (class-of superclass) +the-standard-class+))))) |
|---|
| 29 | |
|---|
| 30 | ;;; This is against the letter of the MOP, but very much in its spirit. |
|---|
| 31 | (defmethod validate-superclass ((class class) |
|---|
| 32 | (superclass forward-referenced-class)) |
|---|
| 33 | t) |
|---|
| 34 | |
|---|
| 35 | (defmethod shared-initialize :before ((instance class) |
|---|
| 36 | slot-names |
|---|
| 37 | &key direct-superclasses |
|---|
| 38 | &allow-other-keys) |
|---|
| 39 | (declare (ignore slot-names)) |
|---|
| 40 | (dolist (superclass direct-superclasses) |
|---|
| 41 | (assert (validate-superclass instance superclass) (instance superclass) |
|---|
| 42 | "Class ~S is not compatible with superclass ~S" |
|---|
| 43 | instance superclass))) |
|---|
| 44 | |
|---|
| 45 | (export '(;; classes |
|---|
| 46 | funcallable-standard-object |
|---|
| 47 | funcallable-standard-class |
|---|
| 48 | forward-referenced-class |
|---|
| 49 | slot-definition |
|---|
| 50 | standard-method |
|---|
| 51 | standard-accessor-method |
|---|
| 52 | standard-reader-method |
|---|
| 53 | standard-writer-method |
|---|
| 54 | |
|---|
| 55 | compute-effective-slot-definition |
|---|
| 56 | compute-class-precedence-list |
|---|
| 57 | compute-default-initargs |
|---|
| 58 | compute-effective-slot-definition |
|---|
| 59 | compute-discriminating-function |
|---|
| 60 | compute-applicable-methods |
|---|
| 61 | compute-applicable-methods-using-classes |
|---|
| 62 | compute-effective-method |
|---|
| 63 | make-method-lambda |
|---|
| 64 | compute-slots |
|---|
| 65 | finalize-inheritance |
|---|
| 66 | validate-superclass |
|---|
| 67 | |
|---|
| 68 | slot-value-using-class |
|---|
| 69 | slot-boundp-using-class |
|---|
| 70 | slot-makunbound-using-class |
|---|
| 71 | |
|---|
| 72 | ensure-class |
|---|
| 73 | ensure-class-using-class |
|---|
| 74 | ensure-generic-function-using-class |
|---|
| 75 | |
|---|
| 76 | class-default-initargs |
|---|
| 77 | class-direct-default-initargs |
|---|
| 78 | class-direct-slots |
|---|
| 79 | class-direct-subclasses |
|---|
| 80 | class-direct-superclasses |
|---|
| 81 | class-finalized-p |
|---|
| 82 | class-precedence-list |
|---|
| 83 | class-prototype |
|---|
| 84 | class-slots |
|---|
| 85 | |
|---|
| 86 | add-direct-subclass |
|---|
| 87 | remove-direct-subclass |
|---|
| 88 | |
|---|
| 89 | generic-function-argument-precedence-order |
|---|
| 90 | generic-function-declarations |
|---|
| 91 | generic-function-lambda-list |
|---|
| 92 | generic-function-method-class |
|---|
| 93 | generic-function-method-combination |
|---|
| 94 | generic-function-name |
|---|
| 95 | |
|---|
| 96 | method-function |
|---|
| 97 | method-generic-function |
|---|
| 98 | method-lambda-list |
|---|
| 99 | method-specializers |
|---|
| 100 | method-qualifiers |
|---|
| 101 | accessor-method-slot-definition |
|---|
| 102 | |
|---|
| 103 | reader-method-class |
|---|
| 104 | writer-method-class |
|---|
| 105 | |
|---|
| 106 | direct-slot-definition-class |
|---|
| 107 | effective-slot-definition-class |
|---|
| 108 | slot-definition-allocation |
|---|
| 109 | slot-definition-initargs |
|---|
| 110 | slot-definition-initform |
|---|
| 111 | slot-definition-initfunction |
|---|
| 112 | slot-definition-location |
|---|
| 113 | slot-definition-name |
|---|
| 114 | slot-definition-readers |
|---|
| 115 | slot-definition-type |
|---|
| 116 | slot-definition-writers |
|---|
| 117 | |
|---|
| 118 | standard-instance-access |
|---|
| 119 | funcallable-standard-instance-access |
|---|
| 120 | |
|---|
| 121 | intern-eql-specializer |
|---|
| 122 | eql-specializer-object |
|---|
| 123 | specializer-direct-methods |
|---|
| 124 | specializer-direct-generic-functions |
|---|
| 125 | add-direct-method |
|---|
| 126 | remove-direct-method |
|---|
| 127 | |
|---|
| 128 | find-method-combination |
|---|
| 129 | |
|---|
| 130 | extract-lambda-list |
|---|
| 131 | extract-specializer-names |
|---|
| 132 | |
|---|
| 133 | add-dependent |
|---|
| 134 | remove-dependent |
|---|
| 135 | map-dependents |
|---|
| 136 | update-dependent)) |
|---|
| 137 | |
|---|
| 138 | (provide 'mop) |
|---|
| 139 | |
|---|
| 140 | |
|---|
| 141 | |
|---|
| 142 | |
|---|
| 143 | |
|---|
