source: branches/1.1.x/src/org/armedbear/lisp/mop.lisp

Last change on this file was 14103, checked in by ehuelsmann, 13 years ago

Follow-up to r14102.
File size: 4.3 KB
Line 
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
Note: See TracBrowser for help on using the repository browser.