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