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

---
 src/org/armedbear/lisp/StandardClass.java |   48 +++++++++++++
 src/org/armedbear/lisp/Symbol.java        |   48 +++++++++++++
 src/org/armedbear/lisp/clos.lisp          |  110 +++++++++++++++++++++++-----
 3 files changed, 186 insertions(+), 20 deletions(-)

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 1ab495b..b19b326 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,96 @@
             (list ,@(mapcar #'canonicalize-method-group-spec method-groups))
             ',body)))
 
+;;; The class method-combination and its subclasses are defined in
+;;; StandardClass.java, but we cannot use make-instance and slot-value
+;;; yet.
+(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 method-combination-name (method-combination)
+  (check-type method-combination method-combination)
+  (std-slot-value method-combination 'sys::name))
+
+(defun method-combination-documentation (method-combination)
+  (check-type method-combination method-combination)
+  (std-slot-value method-combination 'documentation))
+
+(defun short-method-combination-operator (method-combination)
+  (check-type method-combination short-method-combination)
+  (std-slot-value method-combination 'operator))
+
+(defun short-method-combination-identity-with-one-argument (method-combination)
+  (check-type method-combination short-method-combination)
+  (std-slot-value method-combination 'identity-with-one-argument))
+
+(defun long-method-combination-lambda-list (method-combination)
+  (check-type method-combination long-method-combination)
+  (std-slot-value method-combination 'sys::lambda-list))
+
+(defun long-method-combination-method-group-specs (method-combination)
+  (check-type method-combination long-method-combination)
+  (std-slot-value method-combination 'method-group-specs))
+
+(defun long-method-combination-args-lambda-list (method-combination)
+  (check-type method-combination long-method-combination)
+  (std-slot-value method-combination 'args-lambda-list))
+
+(defun long-method-combination-generic-function-symbol (method-combination)
+  (check-type method-combination long-method-combination)
+  (std-slot-value method-combination 'generic-function-symbol))
+
+(defun long-method-combination-function (method-combination)
+  (check-type method-combination long-method-combination)
+  (std-slot-value method-combination 'function))
+
+(defun long-method-combination-arguments (method-combination)
+  (check-type method-combination long-method-combination)
+  (std-slot-value method-combination 'arguments))
+
+(defun long-method-combination-declarations (method-combination)
+  (check-type method-combination long-method-combination)
+  (std-slot-value method-combination 'declarations))
+
+(defun long-method-combination-forms (method-combination)
+  (check-type method-combination long-method-combination)
+  (std-slot-value method-combination 'forms))
+
+
 (defun expand-short-defcombin (whole)
   (let* ((name (cadr whole))
          (documentation
-- 
1.7.5.4

