From 42bf75d0c29cb79d8bf21c42dd5babf6954217af Mon Sep 17 00:00:00 2001
From: Rudi Schlatte <rudi@constantly.at>
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).
---
 src/org/armedbear/lisp/Autoload.java               |    1 +
 src/org/armedbear/lisp/GenericFunction.java        |    2 +-
 src/org/armedbear/lisp/Metaobject.java             |   52 ------------------
 src/org/armedbear/lisp/Specializer.java            |   52 ------------------
 src/org/armedbear/lisp/StandardClass.java          |    7 +++
 src/org/armedbear/lisp/Symbol.java                 |    4 ++
 src/org/armedbear/lisp/clos.lisp                   |   21 ++++----
 src/org/armedbear/lisp/eql_specializer_object.java |   57 ++++++++++++++++++++
 8 files changed, 81 insertions(+), 115 deletions(-)
 delete mode 100644 src/org/armedbear/lisp/Metaobject.java
 delete mode 100644 src/org/armedbear/lisp/Specializer.java
 create mode 100644 src/org/armedbear/lisp/eql_specializer_object.java

diff --git a/src/org/armedbear/lisp/Autoload.java b/src/org/armedbear/lisp/Autoload.java
index 27af7d8..9a9fc6c 100644
--- a/src/org/armedbear/lisp/Autoload.java
+++ b/src/org/armedbear/lisp/Autoload.java
@@ -533,6 +533,7 @@ public class Autoload extends Function
         autoload(PACKAGE_JAVA, "make-classloader", "JavaClassLoader");
         autoload(PACKAGE_JAVA, "%add-to-classpath", "JavaClassLoader");
         autoload(PACKAGE_JAVA, "dump-classpath", "JavaClassLoader");
+        autoload(PACKAGE_MOP, "eql-specializer-object", "eql_specializer_object", true);
         autoload(PACKAGE_MOP, "funcallable-instance-function", "StandardGenericFunction", false);
         autoload(PACKAGE_MOP, "generic-function-name", "StandardGenericFunction", true);
         autoload(PACKAGE_MOP, "method-qualifiers", "StandardMethod", true);
diff --git a/src/org/armedbear/lisp/GenericFunction.java b/src/org/armedbear/lisp/GenericFunction.java
index 6ef2052..b46a80c 100644
--- a/src/org/armedbear/lisp/GenericFunction.java
+++ b/src/org/armedbear/lisp/GenericFunction.java
@@ -35,7 +35,7 @@ package org.armedbear.lisp;
 
 import static org.armedbear.lisp.Lisp.*;
 
-public abstract class GenericFunction extends Metaobject
+public abstract class GenericFunction extends StandardObject
 {
     protected GenericFunction(LispClass cls, int length)
     {
diff --git a/src/org/armedbear/lisp/Metaobject.java b/src/org/armedbear/lisp/Metaobject.java
deleted file mode 100644
index a4f6485..0000000
--- a/src/org/armedbear/lisp/Metaobject.java
+++ /dev/null
@@ -1,52 +0,0 @@
-/*
- * Metaobject.java
- *
- * Copyright (C) 2003-2005 Peter Graves, 2012 Rudolf Schlatte
- * $Id$
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
- *
- * As a special exception, the copyright holders of this library give you
- * permission to link this library with independent modules to produce an
- * executable, regardless of the license terms of these independent
- * modules, and to copy and distribute the resulting executable under
- * terms of your choice, provided that you also meet, for each linked
- * independent module, the terms and conditions of the license of that
- * module.  An independent module is a module which is not derived from
- * or based on this library.  If you modify this library, you may extend
- * this exception to your version of the library, but you are not
- * obligated to do so.  If you do not wish to do so, delete this
- * exception statement from your version.
- */
-
-package org.armedbear.lisp;
-
-import static org.armedbear.lisp.Lisp.*;
-
-public abstract class Metaobject extends StandardObject
-{
-  protected Metaobject(LispClass cls, int length)
-  {
-    super(cls, length);
-  }
-
-  @Override
-  public LispObject typep(LispObject type)
-  {
-    if (type == Symbol.METAOBJECT)
-      return T;
-    return super.typep(type);
-  }
-}
diff --git a/src/org/armedbear/lisp/Specializer.java b/src/org/armedbear/lisp/Specializer.java
deleted file mode 100644
index 5f33a20..0000000
--- a/src/org/armedbear/lisp/Specializer.java
+++ /dev/null
@@ -1,52 +0,0 @@
-/*
- * Specializer.java
- *
- * Copyright (C) 2003-2005 Peter Graves, 2012 Rudolf Schlatte
- * $Id$
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
- *
- * As a special exception, the copyright holders of this library give you
- * permission to link this library with independent modules to produce an
- * executable, regardless of the license terms of these independent
- * modules, and to copy and distribute the resulting executable under
- * terms of your choice, provided that you also meet, for each linked
- * independent module, the terms and conditions of the license of that
- * module.  An independent module is a module which is not derived from
- * or based on this library.  If you modify this library, you may extend
- * this exception to your version of the library, but you are not
- * obligated to do so.  If you do not wish to do so, delete this
- * exception statement from your version.
- */
-
-package org.armedbear.lisp;
-
-import static org.armedbear.lisp.Lisp.*;
-
-public abstract class Specializer extends Metaobject
-{
-  protected Specializer(LispClass cls, int length)
-  {
-    super(cls, length);
-  }
-
-  @Override
-  public LispObject typep(LispObject type)
-  {
-    if (type == Symbol.SPECIALIZER)
-      return T;
-    return super.typep(type);
-  }
-}
diff --git a/src/org/armedbear/lisp/StandardClass.java b/src/org/armedbear/lisp/StandardClass.java
index b808440..a56db23 100644
--- a/src/org/armedbear/lisp/StandardClass.java
+++ b/src/org/armedbear/lisp/StandardClass.java
@@ -389,6 +389,8 @@ public class StandardClass extends SlotClass
     addStandardClass(Symbol.METAOBJECT, list(STANDARD_OBJECT));
   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 =
         addStandardClass(Symbol.SLOT_DEFINITION, list(METAOBJECT));
@@ -644,6 +646,10 @@ public class StandardClass extends SlotClass
       list(new SlotDefinition(Symbol.CAUSE, list(Symbol.JAVA_EXCEPTION_CAUSE))));
     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,
                          STANDARD_OBJECT, BuiltInClass.CLASS_T);
@@ -733,6 +739,7 @@ public class StandardClass extends SlotClass
     JAVA_EXCEPTION.finalizeClass();
     METAOBJECT.finalizeClass();
     SPECIALIZER.finalizeClass();
+    EQL_SPECIALIZER.finalizeClass();
     PACKAGE_ERROR.finalizeClass();
     PARSE_ERROR.finalizeClass();
     PRINT_NOT_READABLE.finalizeClass();
diff --git a/src/org/armedbear/lisp/Symbol.java b/src/org/armedbear/lisp/Symbol.java
index 4c4a03b..b270e90 100644
--- a/src/org/armedbear/lisp/Symbol.java
+++ b/src/org/armedbear/lisp/Symbol.java
@@ -2967,6 +2967,10 @@ public class Symbol extends LispObject implements java.io.Serializable
     PACKAGE_MOP.addInternalSymbol("CLASS-LAYOUT");
   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");
   public static final Symbol SPECIALIZER =
diff --git a/src/org/armedbear/lisp/clos.lisp b/src/org/armedbear/lisp/clos.lisp
index e3b40af..7709482 100644
--- a/src/org/armedbear/lisp/clos.lisp
+++ b/src/org/armedbear/lisp/clos.lisp
@@ -1178,15 +1178,16 @@
              :function ,(coerce-to-function lambda-expression)))
     name))
 
-(defstruct eql-specializer
-  object)
-
 (defparameter *eql-specializer-table* (make-hash-table :test 'eql))
 
 (defun intern-eql-specializer (object)
   (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:
 ;;   generic-function-argument-precedence-order
@@ -1443,7 +1444,7 @@
 (defun canonicalize-specializer (specializer)
   (cond ((classp specializer)
          specializer)
-        ((eql-specializer-p specializer)
+        ((typep specializer 'eql-specializer)
          specializer)
         ((symbolp specializer)
          (find-class specializer))
@@ -1809,7 +1810,7 @@ Initialized with the true value near the end of the file.")
                                (specializer (car (%method-specializers method)))
                                (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)
                                     (declare (optimize speed))
@@ -1965,9 +1966,9 @@ Initialized with the true value near the end of the file.")
           (let ((spec1 (nth index specializers-1))
                 (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
                      (return (sub-specializer-p spec1 spec2
@@ -1979,9 +1980,9 @@ Initialized with the true value near the end of the file.")
         (let ((spec1 (car specializers-1))
               (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
                    (return (sub-specializer-p spec1 spec2 (car classes))))))))))
diff --git a/src/org/armedbear/lisp/eql_specializer_object.java b/src/org/armedbear/lisp/eql_specializer_object.java
new file mode 100644
index 0000000..d6075e2
--- /dev/null
+++ b/src/org/armedbear/lisp/eql_specializer_object.java
@@ -0,0 +1,57 @@
+/*
+ * eql_specializer_object.java
+ *
+ * Copyright (C) 2004 Peter Graves, 2012 Rudolf Schlatte
+ * $Id$
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+ *
+ * As a special exception, the copyright holders of this library give you
+ * permission to link this library with independent modules to produce an
+ * executable, regardless of the license terms of these independent
+ * modules, and to copy and distribute the resulting executable under
+ * terms of your choice, provided that you also meet, for each linked
+ * independent module, the terms and conditions of the license of that
+ * module.  An independent module is a module which is not derived from
+ * or based on this library.  If you modify this library, you may extend
+ * this exception to your version of the library, but you are not
+ * obligated to do so.  If you do not wish to do so, delete this
+ * exception statement from your version.
+ */
+
+package org.armedbear.lisp;
+
+import static org.armedbear.lisp.Lisp.*;
+
+// ### eql-specializer-object
+public final class eql_specializer_object extends Primitive
+{
+    public eql_specializer_object()
+    {
+        super(Symbol.EQL_SPECIALIZER_OBJECT, "eql-specializer");
+    }
+
+    @Override
+    public LispObject execute(LispObject arg)
+    {
+        if (arg instanceof StandardObject
+            && arg.typep(StandardClass.EQL_SPECIALIZER) == T)
+            return ((StandardObject)arg).getInstanceSlotValue(Symbol.OBJECT);
+        return error(new TypeError(arg, Symbol.EQL_SPECIALIZER));
+    }
+
+    private static final eql_specializer_object EQL_SPECIALIZER_OBJECT =
+        new eql_specializer_object();
+}
-- 
1.7.8

