Changeset 12530


Ignore:
Timestamp:
03/14/10 13:18:06 (11 years ago)
Author:
ehuelsmann
Message:

Re #38: Make method creation and dispatch possible for classes with
non-standard-class metaclasses.

Location:
branches/metaclass/abcl/src/org/armedbear/lisp
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/metaclass/abcl/src/org/armedbear/lisp/Primitives.java

    r12529 r12530  
    54665466                return ((LispClass)arg).getCPL();
    54675467            else
    5468                 return ((StandardObject)arg).getInstanceSlotValue(StandardClass.symClassPrecedenceList);
     5468                return ((StandardObject)arg).getInstanceSlotValue(StandardClass.symPrecedenceList);
    54695469        }
    54705470    };
     
    54835483                ((LispClass)second).setCPL(first);
    54845484            else
    5485                 ((StandardObject)second).setInstanceSlotValue(StandardClass.symClassPrecedenceList, first);
     5485                ((StandardObject)second).setInstanceSlotValue(StandardClass.symPrecedenceList, first);
    54865486            return first;
    54875487        }
  • branches/metaclass/abcl/src/org/armedbear/lisp/SlotDefinition.java

    r12527 r12530  
    7070    slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION] = Keyword.INSTANCE;
    7171  }
    72  
     72
     73  public SlotDefinition(LispObject name, LispObject readers,
     74                        Function initFunction)
     75  {
     76    this();
     77    Debug.assertTrue(name instanceof Symbol);
     78    slots[SlotDefinitionClass.SLOT_INDEX_NAME] = name;
     79    slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION] = initFunction;
     80    slots[SlotDefinitionClass.SLOT_INDEX_INITFORM] = NIL;
     81    slots[SlotDefinitionClass.SLOT_INDEX_INITARGS] =
     82      new Cons(PACKAGE_KEYWORD.intern(((Symbol)name).getName()));
     83    slots[SlotDefinitionClass.SLOT_INDEX_READERS] = readers;
     84    slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION] = Keyword.INSTANCE;
     85  }
     86
    7387  public static SlotDefinition checkSlotDefinition(LispObject obj) {
    7488          if (obj instanceof SlotDefinition) return (SlotDefinition)obj;
  • branches/metaclass/abcl/src/org/armedbear/lisp/StandardClass.java

    r12528 r12530  
    4545  public static Symbol symDirectSubclasses
    4646    = PACKAGE_MOP.intern("DIRECT-SUBCLASSES");
    47   public static Symbol symClassPrecedenceList
    48     = PACKAGE_MOP.intern("CLASS-PRECEDENCE-LIST");
     47  public static Symbol symPrecedenceList
     48    = PACKAGE_MOP.intern("PRECEDENCE-LIST");
    4949  public static Symbol symDirectMethods
    5050    = PACKAGE_MOP.intern("DIRECT-METHODS");
     
    6868                      symDirectSuperclasses,
    6969                      symDirectSubclasses,
    70                       symClassPrecedenceList,
     70                      symPrecedenceList,
    7171                      symDirectMethods,
    7272                      symDocumentation,
     
    181181  public LispObject getCPL()
    182182  {
    183     return getInstanceSlotValue(symClassPrecedenceList);
     183    return getInstanceSlotValue(symPrecedenceList);
    184184  }
    185185
     
    189189    LispObject obj1 = cpl[0];
    190190    if (obj1.listp() && cpl.length == 1)
    191       setInstanceSlotValue(symClassPrecedenceList, obj1);
     191      setInstanceSlotValue(symPrecedenceList, obj1);
    192192    else
    193193      {
     
    196196        for (int i = cpl.length; i-- > 0;)
    197197            l = new Cons(cpl[i], l);
    198         setInstanceSlotValue(symClassPrecedenceList, l);
     198        setInstanceSlotValue(symPrecedenceList, l);
    199199      }
    200200  }
     
    317317  }
    318318
     319  private static final LispObject standardClassSlotDefinitions()
     320  {
     321      // (CONSTANTLY NIL)
     322    Function initFunction = new Function() {
     323      @Override
     324      public LispObject execute()
     325      {
     326         return NIL;
     327      }
     328    };
     329
     330    return
     331        list(helperMakeSlotDefinition("NAME", initFunction),
     332             helperMakeSlotDefinition("LAYOUT", initFunction),
     333             helperMakeSlotDefinition("DIRECT-SUPERCLASSES", initFunction),
     334             helperMakeSlotDefinition("DIRECT-SUBCLASSES", initFunction),
     335             helperMakeSlotDefinition("PRECEDENCE-LIST", initFunction),
     336             helperMakeSlotDefinition("DIRECT-METHODS", initFunction),
     337             helperMakeSlotDefinition("DIRECT-SLOTS", initFunction),
     338             helperMakeSlotDefinition("SLOTS", initFunction),
     339             helperMakeSlotDefinition("DIRECT-DEFAULT-INITARGS", initFunction),
     340             helperMakeSlotDefinition("DEFAULT-INITARGS", initFunction),
     341             helperMakeSlotDefinition("FINALIZED-P", initFunction));
     342  }
     343
     344
     345
     346  private static final SlotDefinition helperMakeSlotDefinition(String name,
     347                                                               Function init)
     348  {
     349    return
     350        new SlotDefinition(PACKAGE_MOP.intern(name),   // name
     351             list(PACKAGE_MOP.intern("CLASS-" + name)), // readers
     352             init);
     353  }
     354
    319355  private static final StandardClass addStandardClass(Symbol name,
    320356                                                      LispObject directSuperclasses)
     
    341377
    342378    STANDARD_CLASS.setClassLayout(layoutStandardClass);
    343     STANDARD_CLASS.setDirectSlotDefinitions(STANDARD_CLASS.getClassLayout().generateSlotDefinitions());
    344     LispObject slots = STANDARD_CLASS.getDirectSlotDefinitions();
    345     while (slots != NIL) {
    346       SlotDefinition slot = (SlotDefinition)slots.car();
    347       if (slot.getName() == symLayout)
    348           SlotDefinition.SET_SLOT_DEFINITION_INITFUNCTION.execute(slot,
    349                                                                   new Function() {
    350 @Override
    351     public LispObject execute() {
    352     return NIL;
    353 }
    354                                                                   });
    355       slots = slots.cdr();
    356     }
    357    
     379    STANDARD_CLASS.setDirectSlotDefinitions(standardClassSlotDefinitions());
    358380  }
    359381
  • branches/metaclass/abcl/src/org/armedbear/lisp/clos.lisp

    r12528 r12530  
    18811881(redefine-class-forwarder class-direct-methods direct-methods !class-direct-methods)
    18821882(redefine-class-forwarder (setf class-direct-methods) direct-methods !!class-direct-methods)
    1883 (redefine-class-forwarder class-precedence-list class-precedence-list)
    1884 (redefine-class-forwarder (setf class-precedence-list) class-precedence-list)
     1883(redefine-class-forwarder class-precedence-list precedence-list)
     1884(redefine-class-forwarder (setf class-precedence-list) precedence-list)
    18851885(redefine-class-forwarder class-finalized-p finalized-p)
    18861886(redefine-class-forwarder (setf class-finalized-p) finalized-p)
Note: See TracChangeset for help on using the changeset viewer.