Changeset 13715
- Timestamp:
- 01/04/12 20:34:38 (12 years ago)
- Location:
- trunk/abcl/src/org/armedbear/lisp
- Files:
-
- 1 added
- 2 deleted
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/Autoload.java
r13695 r13715 534 534 autoload(PACKAGE_JAVA, "%add-to-classpath", "JavaClassLoader"); 535 535 autoload(PACKAGE_JAVA, "dump-classpath", "JavaClassLoader"); 536 autoload(PACKAGE_MOP, "eql-specializer-object", "EqualSpecializerObject", true); 536 537 autoload(PACKAGE_MOP, "funcallable-instance-function", "StandardGenericFunction", false); 537 538 autoload(PACKAGE_MOP, "generic-function-name", "StandardGenericFunction", true); -
trunk/abcl/src/org/armedbear/lisp/GenericFunction.java
r13713 r13715 36 36 import static org.armedbear.lisp.Lisp.*; 37 37 38 public abstract class GenericFunction extends Metaobject38 public abstract class GenericFunction extends StandardObject 39 39 { 40 40 protected GenericFunction(LispClass cls, int length) -
trunk/abcl/src/org/armedbear/lisp/StandardClass.java
r13714 r13715 390 390 public static final StandardClass SPECIALIZER = 391 391 addStandardClass(Symbol.SPECIALIZER, list(METAOBJECT)); 392 public static final StandardClass EQL_SPECIALIZER = 393 addStandardClass(Symbol.EQL_SPECIALIZER, list(SPECIALIZER)); 392 394 393 395 public static final StandardClass SLOT_DEFINITION = … … 645 647 METAOBJECT.setCPL(METAOBJECT, STANDARD_OBJECT, BuiltInClass.CLASS_T); 646 648 SPECIALIZER.setCPL(SPECIALIZER, METAOBJECT, STANDARD_OBJECT, BuiltInClass.CLASS_T); 649 EQL_SPECIALIZER.setCPL(EQL_SPECIALIZER, SPECIALIZER, METAOBJECT, 650 STANDARD_OBJECT, BuiltInClass.CLASS_T); 651 EQL_SPECIALIZER.setDirectSlotDefinitions( 652 list(new SlotDefinition(Symbol.OBJECT, list(PACKAGE_MOP.intern("EQL-SPECIALIZER-OBJECT"))))); 647 653 METHOD.setCPL(METHOD, METAOBJECT, STANDARD_OBJECT, BuiltInClass.CLASS_T); 648 654 PACKAGE_ERROR.setCPL(PACKAGE_ERROR, ERROR, SERIOUS_CONDITION, CONDITION, … … 734 740 METAOBJECT.finalizeClass(); 735 741 SPECIALIZER.finalizeClass(); 742 EQL_SPECIALIZER.finalizeClass(); 736 743 PACKAGE_ERROR.finalizeClass(); 737 744 PARSE_ERROR.finalizeClass(); -
trunk/abcl/src/org/armedbear/lisp/Symbol.java
r13714 r13715 2968 2968 public static final Symbol CLASS_PRECEDENCE_LIST = 2969 2969 PACKAGE_MOP.addInternalSymbol("CLASS-PRECEDENCE-LIST"); 2970 public static final Symbol EQL_SPECIALIZER = 2971 PACKAGE_MOP.addExternalSymbol("EQL-SPECIALIZER"); 2972 public static final Symbol EQL_SPECIALIZER_OBJECT = 2973 PACKAGE_MOP.addExternalSymbol("EQL-SPECIALIZER-OBJECT"); 2970 2974 public static final Symbol METAOBJECT = 2971 2975 PACKAGE_MOP.addExternalSymbol("METAOBJECT"); -
trunk/abcl/src/org/armedbear/lisp/clos.lisp
r13701 r13715 1179 1179 name)) 1180 1180 1181 (defstruct eql-specializer1182 object)1183 1184 1181 (defparameter *eql-specializer-table* (make-hash-table :test 'eql)) 1185 1182 … … 1187 1184 (or (gethash object *eql-specializer-table*) 1188 1185 (setf (gethash object *eql-specializer-table*) 1189 (make-eql-specializer :object object)))) 1186 ;; we will be called during generic function invocation 1187 ;; setup, so have to rely on plain functions here. 1188 (let ((instance (std-allocate-instance (find-class 'eql-specializer)))) 1189 (setf (std-slot-value instance 'sys::object) object) 1190 instance)))) 1190 1191 1191 1192 ;; MOP (p. 216) specifies the following reader generic functions: … … 1444 1445 (cond ((classp specializer) 1445 1446 specializer) 1446 (( eql-specializer-pspecializer)1447 ((typep specializer 'eql-specializer) 1447 1448 specializer) 1448 1449 ((symbolp specializer) … … 1810 1811 (function (or (%method-fast-function method) 1811 1812 (%method-function method)))) 1812 (if ( eql-specializer-pspecializer)1813 (if (typep specializer 'eql-specializer) 1813 1814 (let ((specializer-object (eql-specializer-object specializer))) 1814 1815 #'(lambda (arg) … … 1966 1967 (spec2 (nth index specializers-2))) 1967 1968 (unless (eq spec1 spec2) 1968 (cond (( eql-specializer-p spec1)1969 (cond ((typep spec1 'eql-specializer) 1969 1970 (return t)) 1970 (( eql-specializer-p spec2)1971 ((typep spec2 'eql-specializer) 1971 1972 (return nil)) 1972 1973 (t … … 1980 1981 (spec2 (car specializers-2))) 1981 1982 (unless (eq spec1 spec2) 1982 (cond (( eql-specializer-p spec1)1983 (cond ((typep spec1 'eql-specializer) 1983 1984 (return t)) 1984 (( eql-specializer-p spec2)1985 ((typep spec2 'eql-specializer) 1985 1986 (return nil)) 1986 1987 (t
Note: See TracChangeset
for help on using the changeset viewer.