Changeset 13715


Ignore:
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:
1 added
2 deleted
5 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/Autoload.java

    r13695 r13715  
    534534        autoload(PACKAGE_JAVA, "%add-to-classpath", "JavaClassLoader");
    535535        autoload(PACKAGE_JAVA, "dump-classpath", "JavaClassLoader");
     536        autoload(PACKAGE_MOP, "eql-specializer-object", "EqualSpecializerObject", true);
    536537        autoload(PACKAGE_MOP, "funcallable-instance-function", "StandardGenericFunction", false);
    537538        autoload(PACKAGE_MOP, "generic-function-name", "StandardGenericFunction", true);
  • trunk/abcl/src/org/armedbear/lisp/GenericFunction.java

    r13713 r13715  
    3636import static org.armedbear.lisp.Lisp.*;
    3737
    38 public abstract class GenericFunction extends Metaobject
     38public abstract class GenericFunction extends StandardObject
    3939{
    4040    protected GenericFunction(LispClass cls, int length)
  • trunk/abcl/src/org/armedbear/lisp/StandardClass.java

    r13714 r13715  
    390390  public static final StandardClass SPECIALIZER =
    391391    addStandardClass(Symbol.SPECIALIZER, list(METAOBJECT));
     392  public static final StandardClass EQL_SPECIALIZER =
     393    addStandardClass(Symbol.EQL_SPECIALIZER, list(SPECIALIZER));
    392394
    393395    public static final StandardClass SLOT_DEFINITION =
     
    645647    METAOBJECT.setCPL(METAOBJECT, STANDARD_OBJECT, BuiltInClass.CLASS_T);
    646648    SPECIALIZER.setCPL(SPECIALIZER, METAOBJECT, STANDARD_OBJECT, BuiltInClass.CLASS_T);
     649    EQL_SPECIALIZER.setCPL(EQL_SPECIALIZER, SPECIALIZER, METAOBJECT,
     650                           STANDARD_OBJECT, BuiltInClass.CLASS_T);
     651    EQL_SPECIALIZER.setDirectSlotDefinitions(
     652      list(new SlotDefinition(Symbol.OBJECT, list(PACKAGE_MOP.intern("EQL-SPECIALIZER-OBJECT")))));
    647653    METHOD.setCPL(METHOD, METAOBJECT, STANDARD_OBJECT, BuiltInClass.CLASS_T);
    648654    PACKAGE_ERROR.setCPL(PACKAGE_ERROR, ERROR, SERIOUS_CONDITION, CONDITION,
     
    734740    METAOBJECT.finalizeClass();
    735741    SPECIALIZER.finalizeClass();
     742    EQL_SPECIALIZER.finalizeClass();
    736743    PACKAGE_ERROR.finalizeClass();
    737744    PARSE_ERROR.finalizeClass();
  • trunk/abcl/src/org/armedbear/lisp/Symbol.java

    r13714 r13715  
    29682968  public static final Symbol CLASS_PRECEDENCE_LIST =
    29692969    PACKAGE_MOP.addInternalSymbol("CLASS-PRECEDENCE-LIST");
     2970  public static final Symbol EQL_SPECIALIZER =
     2971    PACKAGE_MOP.addExternalSymbol("EQL-SPECIALIZER");
     2972  public static final Symbol EQL_SPECIALIZER_OBJECT =
     2973    PACKAGE_MOP.addExternalSymbol("EQL-SPECIALIZER-OBJECT");
    29702974  public static final Symbol METAOBJECT =
    29712975    PACKAGE_MOP.addExternalSymbol("METAOBJECT");
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r13701 r13715  
    11791179    name))
    11801180
    1181 (defstruct eql-specializer
    1182   object)
    1183 
    11841181(defparameter *eql-specializer-table* (make-hash-table :test 'eql))
    11851182
     
    11871184  (or (gethash object *eql-specializer-table*)
    11881185      (setf (gethash object *eql-specializer-table*)
    1189             (make-eql-specializer :object object))))
     1186            ;; we will be called during generic function invocation
     1187            ;; setup, so have to rely on plain functions here.
     1188            (let ((instance (std-allocate-instance (find-class 'eql-specializer))))
     1189              (setf (std-slot-value instance 'sys::object) object)
     1190              instance))))
    11901191
    11911192;; MOP (p. 216) specifies the following reader generic functions:
     
    14441445  (cond ((classp specializer)
    14451446         specializer)
    1446         ((eql-specializer-p specializer)
     1447        ((typep specializer 'eql-specializer)
    14471448         specializer)
    14481449        ((symbolp specializer)
     
    18101811                               (function (or (%method-fast-function method)
    18111812                                             (%method-function method))))
    1812                           (if (eql-specializer-p specializer)
     1813                          (if (typep specializer 'eql-specializer)
    18131814                              (let ((specializer-object (eql-specializer-object specializer)))
    18141815                                #'(lambda (arg)
     
    19661967                (spec2 (nth index specializers-2)))
    19671968            (unless (eq spec1 spec2)
    1968               (cond ((eql-specializer-p spec1)
     1969              (cond ((typep spec1 'eql-specializer)
    19691970                     (return t))
    1970                     ((eql-specializer-p spec2)
     1971                    ((typep spec2 'eql-specializer)
    19711972                     (return nil))
    19721973                    (t
     
    19801981              (spec2 (car specializers-2)))
    19811982          (unless (eq spec1 spec2)
    1982             (cond ((eql-specializer-p spec1)
     1983            (cond ((typep spec1 'eql-specializer)
    19831984                   (return t))
    1984                   ((eql-specializer-p spec2)
     1985                  ((typep spec2 'eql-specializer)
    19851986                   (return nil))
    19861987                  (t
Note: See TracChangeset for help on using the changeset viewer.