source: trunk/abcl/src/org/armedbear/lisp/mop.lisp @ 13983

Last change on this file since 13983 was 13983, checked in by rschlatte, 9 years ago

Implement find-method-combination

  • Store method combination as an object of type 'method-combination.
  • We use singleton objects if there are no options supplied to the method combination (the majority of cases), otherwise we cons up a fresh method-combination object with the same name that holds the options.
File size: 4.2 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          compute-slots
64          finalize-inheritance
65          validate-superclass
66
67          slot-value-using-class
68          slot-boundp-using-class
69          slot-makunbound-using-class
70
71          ensure-class
72          ensure-class-using-class
73          ensure-generic-function-using-class
74
75          class-default-initargs
76          class-direct-default-initargs
77          class-direct-slots
78          class-direct-subclasses
79          class-direct-superclasses
80          class-finalized-p
81          class-precedence-list
82          class-prototype
83          class-slots
84
85          add-direct-subclass
86          remove-direct-subclass
87
88          generic-function-argument-precedence-order
89          generic-function-declarations
90          generic-function-lambda-list
91          generic-function-method-class
92          generic-function-method-combination
93          generic-function-name
94
95          method-function
96          method-generic-function
97          method-lambda-list
98          method-specializers
99          method-qualifiers
100          accessor-method-slot-definition
101
102          reader-method-class
103          writer-method-class
104
105          direct-slot-definition-class
106          effective-slot-definition-class
107          slot-definition-initargs
108          slot-definition-location
109          slot-definition-name
110          slot-definition-readers
111          slot-definition-type
112          slot-definition-writers
113
114          standard-instance-access
115          funcallable-standard-instance-access
116
117          intern-eql-specializer
118          eql-specializer-object
119          specializer-direct-methods
120          specializer-direct-generic-functions
121          add-direct-method
122          remove-direct-method
123
124          find-method-combination
125
126          extract-lambda-list
127          extract-specializer-names
128
129          add-dependent
130          remove-dependent
131          map-dependents
132          update-dependent))
133
134(provide 'mop)
135
136
137
138
139
Note: See TracBrowser for help on using the repository browser.