Changeset 13715

Timestamp:

01/04/12 20:34:38 (12 years ago)

Author:

Mark Evenson

Message:

Convert EQL-SPECIALIZER from a structure into a CLOS class.

From rudi at constantly.

Backout creation of Specializer.java and Equalizer.java (do it all in
Lisp).

From: Rudi Schlatte <rudi@…>
Date: Wed, 4 Jan 2012 17:22:59 +0100
Subject: [PATCH] Convert EQL-SPECIALIZER from a structure into a CLOS class.

... open-code make-instance machinery in intern-eql-specializer to break

circular dependency between it and generic functions working

... also remove unused Java classes for metaobject and

specializer introduced in previous patches (Java-side, they
are just instances of StandardClass?).

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• Autoload.java (modified) (1 diff)
• EqualSpecializerObject.java (added)
• GenericFunction.java (modified) (1 diff)
• Metaobject.java (deleted)
• Specializer.java (deleted)
• StandardClass.java (modified) (3 diffs)
• Symbol.java (modified) (1 diff)
• clos.lisp (modified) (6 diffs)

trunk/abcl/src/org/armedbear/lisp/Autoload.java

@@ -534 +534 @@
         autoload(PACKAGE_JAVA, "%add-to-classpath", "JavaClassLoader");
         autoload(PACKAGE_JAVA, "dump-classpath", "JavaClassLoader");
+        autoload(PACKAGE_MOP, "eql-specializer-object", "EqualSpecializerObject", true);
         autoload(PACKAGE_MOP, "funcallable-instance-function", "StandardGenericFunction", false);
         autoload(PACKAGE_MOP, "generic-function-name", "StandardGenericFunction", true);

trunk/abcl/src/org/armedbear/lisp/GenericFunction.java

@@ -36 +36 @@
 import static org.armedbear.lisp.Lisp.*;
 
-public abstract class GenericFunction extends Metaobject
+public abstract class GenericFunction extends StandardObject
 {
     protected GenericFunction(LispClass cls, int length)

trunk/abcl/src/org/armedbear/lisp/StandardClass.java

@@ -390 +390 @@
   public static final StandardClass SPECIALIZER =
     addStandardClass(Symbol.SPECIALIZER, list(METAOBJECT));
+  public static final StandardClass EQL_SPECIALIZER =
+    addStandardClass(Symbol.EQL_SPECIALIZER, list(SPECIALIZER));
 
     public static final StandardClass SLOT_DEFINITION =
@@ -645 +647 @@
     METAOBJECT.setCPL(METAOBJECT, STANDARD_OBJECT, BuiltInClass.CLASS_T);
     SPECIALIZER.setCPL(SPECIALIZER, METAOBJECT, STANDARD_OBJECT, BuiltInClass.CLASS_T);
+    EQL_SPECIALIZER.setCPL(EQL_SPECIALIZER, SPECIALIZER, METAOBJECT,
+                           STANDARD_OBJECT, BuiltInClass.CLASS_T);
+    EQL_SPECIALIZER.setDirectSlotDefinitions(
+      list(new SlotDefinition(Symbol.OBJECT, list(PACKAGE_MOP.intern("EQL-SPECIALIZER-OBJECT")))));
     METHOD.setCPL(METHOD, METAOBJECT, STANDARD_OBJECT, BuiltInClass.CLASS_T);
     PACKAGE_ERROR.setCPL(PACKAGE_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
@@ -734 +740 @@
     METAOBJECT.finalizeClass();
     SPECIALIZER.finalizeClass();
+    EQL_SPECIALIZER.finalizeClass();
     PACKAGE_ERROR.finalizeClass();
     PARSE_ERROR.finalizeClass();

trunk/abcl/src/org/armedbear/lisp/Symbol.java

@@ -2968 +2968 @@
   public static final Symbol CLASS_PRECEDENCE_LIST =
     PACKAGE_MOP.addInternalSymbol("CLASS-PRECEDENCE-LIST");
+  public static final Symbol EQL_SPECIALIZER =
+    PACKAGE_MOP.addExternalSymbol("EQL-SPECIALIZER");
+  public static final Symbol EQL_SPECIALIZER_OBJECT =
+    PACKAGE_MOP.addExternalSymbol("EQL-SPECIALIZER-OBJECT");
   public static final Symbol METAOBJECT =
     PACKAGE_MOP.addExternalSymbol("METAOBJECT");

trunk/abcl/src/org/armedbear/lisp/clos.lisp

@@ -1179 +1179 @@
     name))
 
-(defstruct eql-specializer
-  object)
-
 (defparameter *eql-specializer-table* (make-hash-table :test 'eql))
 
@@ -1187 +1184 @@
   (or (gethash object *eql-specializer-table*)
       (setf (gethash object *eql-specializer-table*)
-            (make-eql-specializer :object object))))
+            ;; we will be called during generic function invocation
+            ;; setup, so have to rely on plain functions here.
+            (let ((instance (std-allocate-instance (find-class 'eql-specializer))))
+              (setf (std-slot-value instance 'sys::object) object)
+              instance))))
 
 ;; MOP (p. 216) specifies the following reader generic functions:
@@ -1444 +1445 @@
   (cond ((classp specializer)
          specializer)
-        ((eql-specializer-p specializer)
+        ((typep specializer 'eql-specializer)
          specializer)
         ((symbolp specializer)
@@ -1810 +1811 @@
                                (function (or (%method-fast-function method)
                                              (%method-function method))))
-                          (if (eql-specializer-p specializer)
+                          (if (typep specializer 'eql-specializer)
                               (let ((specializer-object (eql-specializer-object specializer)))
                                 #'(lambda (arg)
@@ -1966 +1967 @@
                 (spec2 (nth index specializers-2)))
             (unless (eq spec1 spec2)
-              (cond ((eql-specializer-p spec1)
+              (cond ((typep spec1 'eql-specializer)
                      (return t))
-                    ((eql-specializer-p spec2)
+                    ((typep spec2 'eql-specializer)
                      (return nil))
                     (t
@@ -1980 +1981 @@
               (spec2 (car specializers-2)))
           (unless (eq spec1 spec2)
-            (cond ((eql-specializer-p spec1)
+            (cond ((typep spec1 'eql-specializer)
                    (return t))
-                  ((eql-specializer-p spec2)
+                  ((typep spec2 'eql-specializer)
                    (return nil))
                   (t