From 82603891aed46d853be8e194a8613570808eafae Mon Sep 17 00:00:00 2001
From: Rudi Schlatte <rudi@constantly.at>
Date: Thu, 5 Jan 2012 14:46:44 +0100
Subject: [PATCH] Convert method-combination and its subtypes from structures
 to classes.

---
 src/org/armedbear/lisp/Autoload.java               |   12 ++
 .../armedbear/lisp/MethodCombinationReader.java    |  127 ++++++++++++++++++++
 src/org/armedbear/lisp/StandardClass.java          |   48 ++++++++
 src/org/armedbear/lisp/Symbol.java                 |   48 ++++++++
 src/org/armedbear/lisp/clos.lisp                   |   58 ++++++---
 5 files changed, 273 insertions(+), 20 deletions(-)
 create mode 100644 src/org/armedbear/lisp/MethodCombinationReader.java

diff --git a/src/org/armedbear/lisp/Autoload.java b/src/org/armedbear/lisp/Autoload.java
index a260b0c..1568ccd 100644
--- a/src/org/armedbear/lisp/Autoload.java
+++ b/src/org/armedbear/lisp/Autoload.java
@@ -534,6 +534,18 @@ public class Autoload extends Function
         autoload(PACKAGE_JAVA, "%add-to-classpath", "JavaClassLoader");
         autoload(PACKAGE_JAVA, "dump-classpath", "JavaClassLoader");
         autoload(PACKAGE_MOP, "eql-specializer-object", "EqualSpecializerObject", true);
+        autoload(PACKAGE_MOP, "method-combination-name", "MethodCombinationReader");
+        autoload(PACKAGE_MOP, "method-combination-documentation", "MethodCombinationReader");
+        autoload(PACKAGE_MOP, "short-method-combination-operator", "MethodCombinationReader");
+        autoload(PACKAGE_MOP, "short-method-combination-identity-with-one-argument", "MethodCombinationReader");
+        autoload(PACKAGE_MOP, "long-method-combination-lambda-list", "MethodCombinationReader");
+        autoload(PACKAGE_MOP, "long-method-combination-method-group-specs", "MethodCombinationReader");
+        autoload(PACKAGE_MOP, "long-method-combination-args-lambda-list", "MethodCombinationReader");
+        autoload(PACKAGE_MOP, "long-method-combination-generic-function-symbol", "MethodCombinationReader");
+        autoload(PACKAGE_MOP, "long-method-combination-function", "MethodCombinationReader");
+        autoload(PACKAGE_MOP, "long-method-combination-arguments", "MethodCombinationReader");
+        autoload(PACKAGE_MOP, "long-method-combination-declarations", "MethodCombinationReader");
+        autoload(PACKAGE_MOP, "long-method-combination-forms", "MethodCombinationReader");
         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/MethodCombinationReader.java b/src/org/armedbear/lisp/MethodCombinationReader.java
new file mode 100644
index 0000000..cb7f8cf
--- /dev/null
+++ b/src/org/armedbear/lisp/MethodCombinationReader.java
@@ -0,0 +1,127 @@
+/*
+ * Implementations of reader functions for method combination attributes.
+ *
+ * The accompanying classes METHOD-COMBINATION,
+ * SHORT-METHOD-COMBINATION, LONG-METHOD-COMBINATION are defined in
+ * StandardClass.java.
+ *
+ * Copyright (C) 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 final class MethodCombinationReader extends Primitive
+{
+    private StandardClass requiredType;
+    private Symbol slotName;
+
+    private MethodCombinationReader(Symbol name, String arglist,
+                                    StandardClass required_type,
+                                    Symbol slot_name)
+    {
+        super(name, arglist);
+        requiredType = required_type;
+        slotName = slot_name;
+    };
+
+    @Override
+    public LispObject execute(LispObject arg)
+    {
+        if (arg instanceof StandardObject
+            && arg.typep(requiredType) == T) 
+        {
+            return ((StandardObject)arg).getInstanceSlotValue(slotName);
+        }
+        return error(new TypeError(arg, requiredType));
+    }
+
+    // ### method-combination-name
+    // method-combination-name method-combination => symbol
+    private static final MethodCombinationReader METHOD_COMBINATION_NAME 
+        = new MethodCombinationReader(Symbol.METHOD_COMBINATION_NAME, "method-combination", StandardClass.METHOD_COMBINATION, Symbol.METHOD_COMBINATION);
+
+    // ### method-combination-documentation
+    // method-combination-documentation method-combination => string
+    private static final MethodCombinationReader METHOD_COMBINATION_DOCUMENTATION 
+        = new MethodCombinationReader(Symbol.METHOD_COMBINATION_DOCUMENTATION, "method-combination", StandardClass.METHOD_COMBINATION, Symbol.DOCUMENTATION);
+
+    // ### short-method-combination-operator
+    // short-method-combination-documentation method-combination => symbol
+    private static final MethodCombinationReader SHORT_METHOD_COMBINATION_OPERATOR
+        = new MethodCombinationReader(Symbol.SHORT_METHOD_COMBINATION_OPERATOR, "short-method-combination", StandardClass.SHORT_METHOD_COMBINATION, Symbol.OPERATOR);
+
+    // ### short-method-combination-identity-with-one-argument
+    // short-method-combination-identity-with-one-argument method-combination => boolean
+    private static final MethodCombinationReader SHORT_METHOD_COMBINATION_IDENTITY_WITH_ONE_ARGUMENT 
+        = new MethodCombinationReader(Symbol.SHORT_METHOD_COMBINATION_IDENTITY_WITH_ONE_ARGUMENT, "short-method-combination", StandardClass.SHORT_METHOD_COMBINATION, Symbol.IDENTITY_WITH_ONE_ARGUMENT);
+
+    // ### long-method-combination-lambda-list
+    // long-method-combination-lambda-list method-combination => lambda-list
+    private static final MethodCombinationReader LONG_METHOD_COMBINATION_LAMBDA_LIST 
+        = new MethodCombinationReader(Symbol.LONG_METHOD_COMBINATION_LAMBDA_LIST, "long-method-combination", StandardClass.LONG_METHOD_COMBINATION, Symbol.LAMBDA_LIST);
+
+    // ### long-method-combination-method-group-specs
+    // long-method-combination-method-group-specs method-combination => method-group-specifier*
+    private static final MethodCombinationReader LONG_METHOD_COMBINATION_METHOD_GROUP_SPECS 
+        = new MethodCombinationReader(Symbol.LONG_METHOD_COMBINATION_METHOD_GROUP_SPECS, "long-method-combination", StandardClass.LONG_METHOD_COMBINATION, Symbol.METHOD_GROUP_SPECS);
+
+    // ### long-method-combination-args-lambda-list
+    // long-method-combination-args-lambda-list method-combination => lambda-list
+    private static final MethodCombinationReader LONG_METHOD_COMBINATION_ARGS_LAMBDA_LIST
+        = new MethodCombinationReader(Symbol.LONG_METHOD_COMBINATION_ARGS_LAMBDA_LIST, "long-method-combination", StandardClass.LONG_METHOD_COMBINATION, Symbol.ARGS_LAMBDA_LIST);
+
+    // ### long-method-combination-generic-function-symbol
+    // long-method-combination-generic-function-symbol method-combination => symbol
+    private static final MethodCombinationReader LONG_METHOD_COMBINATION_GENERIC_FUNCTION_SYMBOL 
+        = new MethodCombinationReader(Symbol.LONG_METHOD_COMBINATION_GENERIC_FUNCTION_SYMBOL, "long-method-combination", StandardClass.LONG_METHOD_COMBINATION, Symbol.GENERIC_FUNCTION_SYMBOL);
+
+    // ### long-method-combination-function
+    // long-method-combination-function method-combination => function
+    private static final MethodCombinationReader LONG_METHOD_COMBINATION_FUNCTION 
+        = new MethodCombinationReader(Symbol.LONG_METHOD_COMBINATION_FUNCTION, "long-method-combination", StandardClass.LONG_METHOD_COMBINATION, Symbol.FUNCTION);
+
+    // ### long-method-combination-arguments
+    // long-method-combination-arguments method-combination => arguments
+    private static final MethodCombinationReader LONG_METHOD_COMBINATION_ARGUMENTS 
+        = new MethodCombinationReader(Symbol.LONG_METHOD_COMBINATION_ARGUMENTS, "long-method-combination", StandardClass.LONG_METHOD_COMBINATION, Symbol.ARGUMENTS);
+
+    // ### long-method-combination-declarations
+    // long-method-combination-declarations method-combination => declarations
+    private static final MethodCombinationReader LONG_METHOD_COMBINATION_DECLARATIONS 
+        = new MethodCombinationReader(Symbol.LONG_METHOD_COMBINATION_DECLARATIONS, "long-method-combination", StandardClass.LONG_METHOD_COMBINATION, Symbol.DECLARATIONS);
+
+    // ### long-method-combination-forms
+    // long-method-combination-forms method-combination => forms
+    private static final MethodCombinationReader LONG_METHOD_COMBINATION_FORMS 
+        = new MethodCombinationReader(Symbol.LONG_METHOD_COMBINATION_FORMS, "long-method-combination", StandardClass.LONG_METHOD_COMBINATION, Symbol.FORMS);
+
+}
diff --git a/src/org/armedbear/lisp/StandardClass.java b/src/org/armedbear/lisp/StandardClass.java
index a56db23..38aa4e4 100644
--- a/src/org/armedbear/lisp/StandardClass.java
+++ b/src/org/armedbear/lisp/StandardClass.java
@@ -425,6 +425,15 @@ public class StandardClass extends SlotClass
     addStandardClass(Symbol.GENERIC_FUNCTION, list(METAOBJECT,
                                                    BuiltInClass.FUNCTION));
 
+  public static final StandardClass METHOD_COMBINATION =
+    addStandardClass(Symbol.METHOD_COMBINATION, list(METAOBJECT));
+
+  public static final StandardClass SHORT_METHOD_COMBINATION =
+    addStandardClass(Symbol.SHORT_METHOD_COMBINATION, list(METHOD_COMBINATION));
+
+  public static final StandardClass LONG_METHOD_COMBINATION =
+    addStandardClass(Symbol.LONG_METHOD_COMBINATION, list(METHOD_COMBINATION));
+
   public static final StandardClass CLASS =
     addStandardClass(Symbol.CLASS, list(SPECIALIZER));
 
@@ -651,6 +660,42 @@ public class StandardClass extends SlotClass
     EQL_SPECIALIZER.setDirectSlotDefinitions(
       list(new SlotDefinition(Symbol.OBJECT, list(PACKAGE_MOP.intern("EQL-SPECIALIZER-OBJECT")))));
     METHOD.setCPL(METHOD, METAOBJECT, STANDARD_OBJECT, BuiltInClass.CLASS_T);
+    METHOD_COMBINATION.setCPL(METHOD_COMBINATION, METAOBJECT, STANDARD_OBJECT,
+                              BuiltInClass.CLASS_T);
+    METHOD_COMBINATION.setDirectSlotDefinitions(
+      list(new SlotDefinition(Symbol.NAME,
+                              list(Symbol.METHOD_COMBINATION_NAME)),
+           new SlotDefinition(Symbol.DOCUMENTATION,
+                              list(Symbol.METHOD_COMBINATION_DOCUMENTATION))));
+    SHORT_METHOD_COMBINATION.setCPL(SHORT_METHOD_COMBINATION,
+                                    METHOD_COMBINATION, METAOBJECT,
+                                    STANDARD_OBJECT, BuiltInClass.CLASS_T);
+    SHORT_METHOD_COMBINATION.setDirectSlotDefinitions(
+      list(new SlotDefinition(Symbol.OPERATOR,
+                              list(Symbol.SHORT_METHOD_COMBINATION_OPERATOR)),
+           new SlotDefinition(Symbol.IDENTITY_WITH_ONE_ARGUMENT,
+                              list(Symbol.SHORT_METHOD_COMBINATION_IDENTITY_WITH_ONE_ARGUMENT))));
+    LONG_METHOD_COMBINATION.setCPL(LONG_METHOD_COMBINATION,
+                                   METHOD_COMBINATION, METAOBJECT,
+                                   STANDARD_OBJECT, BuiltInClass.CLASS_T);
+    LONG_METHOD_COMBINATION.setDirectSlotDefinitions(
+      list(new SlotDefinition(Symbol.LAMBDA_LIST,
+                              list(Symbol.LONG_METHOD_COMBINATION_LAMBDA_LIST)),
+           new SlotDefinition(Symbol.METHOD_GROUP_SPECS,
+                              list(Symbol.LONG_METHOD_COMBINATION_METHOD_GROUP_SPECS)),
+           new SlotDefinition(Symbol.ARGS_LAMBDA_LIST,
+                              list(Symbol.LONG_METHOD_COMBINATION_ARGS_LAMBDA_LIST)),
+           new SlotDefinition(Symbol.GENERIC_FUNCTION_SYMBOL,
+                              list(Symbol.LONG_METHOD_COMBINATION_GENERIC_FUNCTION_SYMBOL)),
+           new SlotDefinition(Symbol.FUNCTION,
+                              list(Symbol.LONG_METHOD_COMBINATION_FUNCTION)),
+           new SlotDefinition(Symbol.ARGUMENTS,
+                              list(Symbol.LONG_METHOD_COMBINATION_ARGUMENTS)),
+           new SlotDefinition(Symbol.DECLARATIONS,
+                              list(Symbol.LONG_METHOD_COMBINATION_DECLARATIONS)),
+           new SlotDefinition(Symbol.FORMS,
+                              list(Symbol.LONG_METHOD_COMBINATION_FORMS))));
+
     PACKAGE_ERROR.setCPL(PACKAGE_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
                          STANDARD_OBJECT, BuiltInClass.CLASS_T);
     PACKAGE_ERROR.setDirectSlotDefinitions(
@@ -740,6 +785,9 @@ public class StandardClass extends SlotClass
     METAOBJECT.finalizeClass();
     SPECIALIZER.finalizeClass();
     EQL_SPECIALIZER.finalizeClass();
+    METHOD_COMBINATION.finalizeClass();
+    SHORT_METHOD_COMBINATION.finalizeClass();
+    LONG_METHOD_COMBINATION.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 b270e90..4a9999c 100644
--- a/src/org/armedbear/lisp/Symbol.java
+++ b/src/org/armedbear/lisp/Symbol.java
@@ -2971,6 +2971,10 @@ public class Symbol extends LispObject implements java.io.Serializable
     PACKAGE_MOP.addExternalSymbol("EQL-SPECIALIZER");
   public static final Symbol EQL_SPECIALIZER_OBJECT =
     PACKAGE_MOP.addExternalSymbol("EQL-SPECIALIZER-OBJECT");
+  public static final Symbol SHORT_METHOD_COMBINATION =
+    PACKAGE_MOP.addInternalSymbol("SHORT-METHOD-COMBINATION");
+  public static final Symbol LONG_METHOD_COMBINATION =
+    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION");
   public static final Symbol METAOBJECT =
     PACKAGE_MOP.addExternalSymbol("METAOBJECT");
   public static final Symbol SPECIALIZER =
@@ -2987,6 +2991,48 @@ public class Symbol extends LispObject implements java.io.Serializable
     PACKAGE_MOP.addExternalSymbol("STANDARD-DIRECT-SLOT-DEFINITION");
   public static final Symbol STANDARD_EFFECTIVE_SLOT_DEFINITION =
     PACKAGE_MOP.addExternalSymbol("STANDARD-EFFECTIVE-SLOT-DEFINITION");
+  // MOP method combination readers.
+  public static final Symbol METHOD_COMBINATION_NAME =
+    PACKAGE_MOP.addInternalSymbol("METHOD-COMBINATION-NAME");
+  public static final Symbol METHOD_COMBINATION_DOCUMENTATION =
+    PACKAGE_MOP.addInternalSymbol("METHOD-COMBINATION-DOCUMENTATION");
+  public static final Symbol SHORT_METHOD_COMBINATION_OPERATOR =
+    PACKAGE_MOP.addInternalSymbol("SHORT-METHOD-COMBINATION-OPERATOR");
+  public static final Symbol SHORT_METHOD_COMBINATION_IDENTITY_WITH_ONE_ARGUMENT =
+    PACKAGE_MOP.addInternalSymbol("SHORT-METHOD-COMBINATION-IDENTITY-WITH-ONE-ARGUMENT");
+  public static final Symbol LONG_METHOD_COMBINATION_LAMBDA_LIST =
+    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-LAMBDA-LIST");
+  public static final Symbol LONG_METHOD_COMBINATION_METHOD_GROUP_SPECS =
+    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-METHOD-GROUP-SPECS");
+  public static final Symbol LONG_METHOD_COMBINATION_ARGS_LAMBDA_LIST =
+    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-ARGS-LAMBDA-LIST");
+  public static final Symbol LONG_METHOD_COMBINATION_GENERIC_FUNCTION_SYMBOL =
+    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-GENERIC-FUNCTION-SYMBOL");
+  public static final Symbol LONG_METHOD_COMBINATION_FUNCTION =
+    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-FUNCTION");
+  public static final Symbol LONG_METHOD_COMBINATION_ARGUMENTS =
+    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-ARGUMENTS");
+  public static final Symbol LONG_METHOD_COMBINATION_DECLARATIONS =
+    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-DECLARATIONS");
+  public static final Symbol LONG_METHOD_COMBINATION_FORMS =
+    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-FORMS");
+  public static final Symbol OPERATOR =
+    PACKAGE_MOP.addInternalSymbol("OPERATOR");
+  public static final Symbol IDENTITY_WITH_ONE_ARGUMENT =
+    PACKAGE_MOP.addInternalSymbol("IDENTITY-WITH-ONE-ARGUMENT");
+  public static final Symbol METHOD_GROUP_SPECS =
+    PACKAGE_MOP.addInternalSymbol("METHOD-GROUP-SPECS");
+  public static final Symbol ARGS_LAMBDA_LIST =
+    PACKAGE_MOP.addInternalSymbol("ARGS-LAMBDA-LIST");
+  public static final Symbol GENERIC_FUNCTION_SYMBOL =
+    PACKAGE_MOP.addInternalSymbol("GENERIC-FUNCTION-SYMBOL");
+  public static final Symbol ARGUMENTS =
+    PACKAGE_MOP.addInternalSymbol("ARGUMENTS");
+  public static final Symbol DECLARATIONS =
+    PACKAGE_MOP.addInternalSymbol("DECLARATIONS");
+  public static final Symbol FORMS =
+    PACKAGE_MOP.addInternalSymbol("FORMS");
+
 
   // Java interface.
   public static final Symbol JAVA_EXCEPTION =
@@ -3138,6 +3184,8 @@ public class Symbol extends LispObject implements java.io.Serializable
     PACKAGE_SYS.addInternalSymbol("LISP-STACK-FRAME");
   public static final Symbol JAVA_STACK_FRAME =
     PACKAGE_SYS.addInternalSymbol("JAVA-STACK-FRAME");
+  public static final Symbol LAMBDA_LIST =
+    PACKAGE_SYS.addInternalSymbol("LAMBDA-LIST");
 
   // CDR6
   public static final Symbol _INSPECTOR_HOOK_ =
diff --git a/src/org/armedbear/lisp/clos.lisp b/src/org/armedbear/lisp/clos.lisp
index 7709482..0b3826f 100644
--- a/src/org/armedbear/lisp/clos.lisp
+++ b/src/org/armedbear/lisp/clos.lisp
@@ -826,26 +826,6 @@
                  ,(canonicalize-direct-slots direct-slots)
                  ,@(canonicalize-defclass-options options)))
 
-(defstruct method-combination
-  name
-  documentation)
-
-(defstruct (short-method-combination 
-             (:include method-combination))
-  operator
-  identity-with-one-argument)
-
-(defstruct (long-method-combination
-             (:include method-combination))
-  lambda-list
-  method-group-specs
-  args-lambda-list
-  generic-function-symbol
-  function
-  arguments
-  declarations
-  forms)
-
 (defun expand-long-defcombin (name args)
   (destructuring-bind (lambda-list method-groups &rest body) args
     `(apply #'define-long-form-method-combination
@@ -854,6 +834,44 @@
             (list ,@(mapcar #'canonicalize-method-group-spec method-groups))
             ',body)))
 
+(defun make-short-method-combination (&key name documentation operator identity-with-one-argument)
+  (let ((instance (std-allocate-instance (find-class 'short-method-combination))))
+    (when name (setf (std-slot-value instance 'sys::name) name))
+    (when documentation
+      (setf (std-slot-value instance 'documentation) documentation))
+    (when operator (setf (std-slot-value instance 'operator) operator))
+    (when identity-with-one-argument
+      (setf (std-slot-value instance 'identity-with-one-argument)
+            identity-with-one-argument))
+    instance))
+
+(defun make-long-method-combination (&key name documentation lambda-list
+                                       method-group-specs args-lambda-list
+                                       generic-function-symbol function
+                                       arguments declarations forms)
+  (let ((instance (std-allocate-instance (find-class 'long-method-combination))))
+    (when name (setf (std-slot-value instance 'sys::name) name))
+    (when documentation
+      (setf (std-slot-value instance 'documentation) documentation))
+    (when lambda-list
+        (setf (std-slot-value instance 'sys::lambda-list) lambda-list))
+    (when method-group-specs
+        (setf (std-slot-value instance 'method-group-specs) method-group-specs))
+    (when args-lambda-list
+        (setf (std-slot-value instance 'args-lambda-list) args-lambda-list))
+    (when generic-function-symbol
+        (setf (std-slot-value instance 'generic-function-symbol)
+              generic-function-symbol))
+    (when function
+        (setf (std-slot-value instance 'function) function))
+    (when arguments
+        (setf (std-slot-value instance 'arguments) arguments))
+    (when declarations
+        (setf (std-slot-value instance 'declarations) declarations))
+    (when forms
+        (setf (std-slot-value instance 'forms) forms))
+    instance))
+
 (defun expand-short-defcombin (whole)
   (let* ((name (cadr whole))
          (documentation
-- 
1.7.8

