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

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

Make slot-value-using-class &c dispatch on slot definition object

  • Keeping the old methods dispatching on slot name around for existing users, but slot-value &c now use the new code paths.
  • The new behavior is following the AMOP spec (although chapters 1-4 and the Closette implementation of AMOP show method dispatch on slot names instead).
  • Minor incompatible change: standard-instance-access now does not complain about unbound slots, returning +slot-unbound+ instead. We handle unbound slots Lisp-side now both for :allocation :instance and :allocation :class in one code path.
  • Removes 5 failures from the AMOP test suite.
File size: 3.7 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          direct-slot-definition-class
50          effective-slot-definition-class
51          standard-method
52          standard-accessor-method
53          standard-reader-method
54          standard-writer-method
55         
56          compute-effective-slot-definition
57          compute-class-precedence-list
58          compute-effective-slot-definition
59          compute-slots
60          finalize-inheritance
61          validate-superclass
62
63          slot-value-using-class
64          slot-boundp-using-class
65          slot-makunbound-using-class
66
67          ensure-class
68          ensure-class-using-class
69          ensure-generic-function-using-class
70
71          class-default-initargs
72          class-direct-default-initargs
73          class-direct-slots
74          class-direct-subclasses
75          class-direct-superclasses
76          class-finalized-p
77          class-prototype
78
79          add-direct-subclass
80          remove-direct-subclass
81
82          generic-function-lambda-list
83          generic-function-argument-precedence-order
84          generic-function-method-class
85
86          method-function
87          method-generic-function
88          method-lambda-list
89          method-specializers
90          method-qualifiers
91
92          standard-reader-method
93          standard-writer-method
94          reader-method-class
95          writer-method-class
96
97          slot-definition
98          slot-definition-readers
99          slot-definition-writers
100          slot-definition-location
101          standard-instance-access
102          funcallable-standard-instance-access
103
104          intern-eql-specializer
105          eql-specializer-object
106          specializer-direct-methods
107          specializer-direct-generic-functions
108          add-direct-method
109          remove-direct-method
110
111          extract-lambda-list
112          extract-specializer-names
113
114          add-dependent
115          remove-dependent
116          map-dependents
117          update-dependent))
118
119(provide 'mop)
120
121
122
123
124
Note: See TracBrowser for help on using the repository browser.