Changeset 13726


Ignore:
Timestamp:
01/06/12 22:45:48 (11 years ago)
Author:
ehuelsmann
Message:

Patch by Rudi Schlatte: Make method combinations real classes.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
3 edited

Legend:

Unmodified
Added
Removed

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

    r13715 r13726  
    425425    addStandardClass(Symbol.GENERIC_FUNCTION, list(METAOBJECT,
    426426                                                   BuiltInClass.FUNCTION));
     427
     428  public static final StandardClass METHOD_COMBINATION =
     429    addStandardClass(Symbol.METHOD_COMBINATION, list(METAOBJECT));
     430
     431  public static final StandardClass SHORT_METHOD_COMBINATION =
     432    addStandardClass(Symbol.SHORT_METHOD_COMBINATION, list(METHOD_COMBINATION));
     433
     434  public static final StandardClass LONG_METHOD_COMBINATION =
     435    addStandardClass(Symbol.LONG_METHOD_COMBINATION, list(METHOD_COMBINATION));
    427436
    428437  public static final StandardClass CLASS =
    … …  
    652661      list(new SlotDefinition(Symbol.OBJECT, list(PACKAGE_MOP.intern("EQL-SPECIALIZER-OBJECT")))));
    653662    METHOD.setCPL(METHOD, METAOBJECT, STANDARD_OBJECT, BuiltInClass.CLASS_T);
     663    METHOD_COMBINATION.setCPL(METHOD_COMBINATION, METAOBJECT, STANDARD_OBJECT,
     664                              BuiltInClass.CLASS_T);
     665    METHOD_COMBINATION.setDirectSlotDefinitions(
     666      list(new SlotDefinition(Symbol.NAME,
     667                              list(Symbol.METHOD_COMBINATION_NAME)),
     668           new SlotDefinition(Symbol.DOCUMENTATION,
     669                              list(Symbol.METHOD_COMBINATION_DOCUMENTATION))));
     670    SHORT_METHOD_COMBINATION.setCPL(SHORT_METHOD_COMBINATION,
     671                                    METHOD_COMBINATION, METAOBJECT,
     672                                    STANDARD_OBJECT, BuiltInClass.CLASS_T);
     673    SHORT_METHOD_COMBINATION.setDirectSlotDefinitions(
     674      list(new SlotDefinition(Symbol.OPERATOR,
     675                              list(Symbol.SHORT_METHOD_COMBINATION_OPERATOR)),
     676           new SlotDefinition(Symbol.IDENTITY_WITH_ONE_ARGUMENT,
     677                              list(Symbol.SHORT_METHOD_COMBINATION_IDENTITY_WITH_ONE_ARGUMENT))));
     678    LONG_METHOD_COMBINATION.setCPL(LONG_METHOD_COMBINATION,
     679                                   METHOD_COMBINATION, METAOBJECT,
     680                                   STANDARD_OBJECT, BuiltInClass.CLASS_T);
     681    LONG_METHOD_COMBINATION.setDirectSlotDefinitions(
     682      list(new SlotDefinition(Symbol.LAMBDA_LIST,
     683                              list(Symbol.LONG_METHOD_COMBINATION_LAMBDA_LIST)),
     684           new SlotDefinition(Symbol.METHOD_GROUP_SPECS,
     685                              list(Symbol.LONG_METHOD_COMBINATION_METHOD_GROUP_SPECS)),
     686           new SlotDefinition(Symbol.ARGS_LAMBDA_LIST,
     687                              list(Symbol.LONG_METHOD_COMBINATION_ARGS_LAMBDA_LIST)),
     688           new SlotDefinition(Symbol.GENERIC_FUNCTION_SYMBOL,
     689                              list(Symbol.LONG_METHOD_COMBINATION_GENERIC_FUNCTION_SYMBOL)),
     690           new SlotDefinition(Symbol.FUNCTION,
     691                              list(Symbol.LONG_METHOD_COMBINATION_FUNCTION)),
     692           new SlotDefinition(Symbol.ARGUMENTS,
     693                              list(Symbol.LONG_METHOD_COMBINATION_ARGUMENTS)),
     694           new SlotDefinition(Symbol.DECLARATIONS,
     695                              list(Symbol.LONG_METHOD_COMBINATION_DECLARATIONS)),
     696           new SlotDefinition(Symbol.FORMS,
     697                              list(Symbol.LONG_METHOD_COMBINATION_FORMS))));
     698
    654699    PACKAGE_ERROR.setCPL(PACKAGE_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
    655700                         STANDARD_OBJECT, BuiltInClass.CLASS_T);
    … …  
    741786    SPECIALIZER.finalizeClass();
    742787    EQL_SPECIALIZER.finalizeClass();
     788    METHOD_COMBINATION.finalizeClass();
     789    SHORT_METHOD_COMBINATION.finalizeClass();
     790    LONG_METHOD_COMBINATION.finalizeClass();
    743791    PACKAGE_ERROR.finalizeClass();
    744792    PARSE_ERROR.finalizeClass();

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

    r13715 r13726  
    29722972  public static final Symbol EQL_SPECIALIZER_OBJECT =
    29732973    PACKAGE_MOP.addExternalSymbol("EQL-SPECIALIZER-OBJECT");
     2974  public static final Symbol SHORT_METHOD_COMBINATION =
     2975    PACKAGE_MOP.addInternalSymbol("SHORT-METHOD-COMBINATION");
     2976  public static final Symbol LONG_METHOD_COMBINATION =
     2977    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION");
    29742978  public static final Symbol METAOBJECT =
    29752979    PACKAGE_MOP.addExternalSymbol("METAOBJECT");
    … …  
    29882992  public static final Symbol STANDARD_EFFECTIVE_SLOT_DEFINITION =
    29892993    PACKAGE_MOP.addExternalSymbol("STANDARD-EFFECTIVE-SLOT-DEFINITION");
     2994  // MOP method combination readers.
     2995  public static final Symbol METHOD_COMBINATION_NAME =
     2996    PACKAGE_MOP.addInternalSymbol("METHOD-COMBINATION-NAME");
     2997  public static final Symbol METHOD_COMBINATION_DOCUMENTATION =
     2998    PACKAGE_MOP.addInternalSymbol("METHOD-COMBINATION-DOCUMENTATION");
     2999  public static final Symbol SHORT_METHOD_COMBINATION_OPERATOR =
     3000    PACKAGE_MOP.addInternalSymbol("SHORT-METHOD-COMBINATION-OPERATOR");
     3001  public static final Symbol SHORT_METHOD_COMBINATION_IDENTITY_WITH_ONE_ARGUMENT =
     3002    PACKAGE_MOP.addInternalSymbol("SHORT-METHOD-COMBINATION-IDENTITY-WITH-ONE-ARGUMENT");
     3003  public static final Symbol LONG_METHOD_COMBINATION_LAMBDA_LIST =
     3004    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-LAMBDA-LIST");
     3005  public static final Symbol LONG_METHOD_COMBINATION_METHOD_GROUP_SPECS =
     3006    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-METHOD-GROUP-SPECS");
     3007  public static final Symbol LONG_METHOD_COMBINATION_ARGS_LAMBDA_LIST =
     3008    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-ARGS-LAMBDA-LIST");
     3009  public static final Symbol LONG_METHOD_COMBINATION_GENERIC_FUNCTION_SYMBOL =
     3010    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-GENERIC-FUNCTION-SYMBOL");
     3011  public static final Symbol LONG_METHOD_COMBINATION_FUNCTION =
     3012    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-FUNCTION");
     3013  public static final Symbol LONG_METHOD_COMBINATION_ARGUMENTS =
     3014    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-ARGUMENTS");
     3015  public static final Symbol LONG_METHOD_COMBINATION_DECLARATIONS =
     3016    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-DECLARATIONS");
     3017  public static final Symbol LONG_METHOD_COMBINATION_FORMS =
     3018    PACKAGE_MOP.addInternalSymbol("LONG-METHOD-COMBINATION-FORMS");
     3019  public static final Symbol OPERATOR =
     3020    PACKAGE_MOP.addInternalSymbol("OPERATOR");
     3021  public static final Symbol IDENTITY_WITH_ONE_ARGUMENT =
     3022    PACKAGE_MOP.addInternalSymbol("IDENTITY-WITH-ONE-ARGUMENT");
     3023  public static final Symbol METHOD_GROUP_SPECS =
     3024    PACKAGE_MOP.addInternalSymbol("METHOD-GROUP-SPECS");
     3025  public static final Symbol ARGS_LAMBDA_LIST =
     3026    PACKAGE_MOP.addInternalSymbol("ARGS-LAMBDA-LIST");
     3027  public static final Symbol GENERIC_FUNCTION_SYMBOL =
     3028    PACKAGE_MOP.addInternalSymbol("GENERIC-FUNCTION-SYMBOL");
     3029  public static final Symbol ARGUMENTS =
     3030    PACKAGE_MOP.addInternalSymbol("ARGUMENTS");
     3031  public static final Symbol DECLARATIONS =
     3032    PACKAGE_MOP.addInternalSymbol("DECLARATIONS");
     3033  public static final Symbol FORMS =
     3034    PACKAGE_MOP.addInternalSymbol("FORMS");
     3035
    29903036
    29913037  // Java interface.
    … …  
    31393185  public static final Symbol JAVA_STACK_FRAME =
    31403186    PACKAGE_SYS.addInternalSymbol("JAVA-STACK-FRAME");
     3187  public static final Symbol LAMBDA_LIST =
     3188    PACKAGE_SYS.addInternalSymbol("LAMBDA-LIST");
    31413189
    31423190  // CDR6

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

    r13725 r13726  
    827827                 ,@(canonicalize-defclass-options options)))
    828828
    829 (defstruct method-combination
    830   name
    831   documentation)
    832 
    833 (defstruct (short-method-combination
    834              (:include method-combination))
    835   operator
    836   identity-with-one-argument)
    837 
    838 (defstruct (long-method-combination
    839              (:include method-combination))
    840   lambda-list
    841   method-group-specs
    842   args-lambda-list
    843   generic-function-symbol
    844   function
    845   arguments
    846   declarations
    847   forms)
    848 
    849829(defun expand-long-defcombin (name args)
    850830  (destructuring-bind (lambda-list method-groups &rest body) args
    … …  
    854834            (list ,@(mapcar #'canonicalize-method-group-spec method-groups))
    855835            ',body)))
     836
     837;;; The class method-combination and its subclasses are defined in
     838;;; StandardClass.java, but we cannot use make-instance and slot-value
     839;;; yet.
     840(defun make-short-method-combination (&key name documentation operator identity-with-one-argument)
     841  (let ((instance (std-allocate-instance (find-class 'short-method-combination))))
     842    (when name (setf (std-slot-value instance 'sys::name) name))
     843    (when documentation
     844      (setf (std-slot-value instance 'documentation) documentation))
     845    (when operator (setf (std-slot-value instance 'operator) operator))
     846    (when identity-with-one-argument
     847      (setf (std-slot-value instance 'identity-with-one-argument)
     848            identity-with-one-argument))
     849    instance))
     850
     851(defun make-long-method-combination (&key name documentation lambda-list
     852                                       method-group-specs args-lambda-list
     853                                       generic-function-symbol function
     854                                       arguments declarations forms)
     855  (let ((instance (std-allocate-instance (find-class 'long-method-combination))))
     856    (when name (setf (std-slot-value instance 'sys::name) name))
     857    (when documentation
     858      (setf (std-slot-value instance 'documentation) documentation))
     859    (when lambda-list
     860        (setf (std-slot-value instance 'sys::lambda-list) lambda-list))
     861    (when method-group-specs
     862        (setf (std-slot-value instance 'method-group-specs) method-group-specs))
     863    (when args-lambda-list
     864        (setf (std-slot-value instance 'args-lambda-list) args-lambda-list))
     865    (when generic-function-symbol
     866        (setf (std-slot-value instance 'generic-function-symbol)
     867              generic-function-symbol))
     868    (when function
     869        (setf (std-slot-value instance 'function) function))
     870    (when arguments
     871        (setf (std-slot-value instance 'arguments) arguments))
     872    (when declarations
     873        (setf (std-slot-value instance 'declarations) declarations))
     874    (when forms
     875        (setf (std-slot-value instance 'forms) forms))
     876    instance))
     877
     878(defun method-combination-name (method-combination)
     879  (check-type method-combination method-combination)
     880  (std-slot-value method-combination 'sys::name))
     881
     882(defun method-combination-documentation (method-combination)
     883  (check-type method-combination method-combination)
     884  (std-slot-value method-combination 'documentation))
     885
     886(defun short-method-combination-operator (method-combination)
     887  (check-type method-combination short-method-combination)
     888  (std-slot-value method-combination 'operator))
     889
     890(defun short-method-combination-identity-with-one-argument (method-combination)
     891  (check-type method-combination short-method-combination)
     892  (std-slot-value method-combination 'identity-with-one-argument))
     893
     894(defun long-method-combination-lambda-list (method-combination)
     895  (check-type method-combination long-method-combination)
     896  (std-slot-value method-combination 'sys::lambda-list))
     897
     898(defun long-method-combination-method-group-specs (method-combination)
     899  (check-type method-combination long-method-combination)
     900  (std-slot-value method-combination 'method-group-specs))
     901
     902(defun long-method-combination-args-lambda-list (method-combination)
     903  (check-type method-combination long-method-combination)
     904  (std-slot-value method-combination 'args-lambda-list))
     905
     906(defun long-method-combination-generic-function-symbol (method-combination)
     907  (check-type method-combination long-method-combination)
     908  (std-slot-value method-combination 'generic-function-symbol))
     909
     910(defun long-method-combination-function (method-combination)
     911  (check-type method-combination long-method-combination)
     912  (std-slot-value method-combination 'function))
     913
     914(defun long-method-combination-arguments (method-combination)
     915  (check-type method-combination long-method-combination)
     916  (std-slot-value method-combination 'arguments))
     917
     918(defun long-method-combination-declarations (method-combination)
     919  (check-type method-combination long-method-combination)
     920  (std-slot-value method-combination 'declarations))
     921
     922(defun long-method-combination-forms (method-combination)
     923  (check-type method-combination long-method-combination)
     924  (std-slot-value method-combination 'forms))
     925
    856926
    857927(defun expand-short-defcombin (whole)
Note: See TracChangeset for help on using the changeset viewer.