Changeset 13871


Ignore:
Timestamp:
02/11/12 22:28:11 (11 years ago)
Author:
rschlatte
Message:

Add FuncallableStandardClass?.java

... make classes generic-function and standard-generic-function

instances of funcallable-standard-class, per AMOP.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
2 edited
1 copied

Legend:

Unmodified
Added
Removed

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

    r13870 r13871  
    11/*
    2  * StandardGenericFunctionClass.java
     2 * StandardClass.java
    33 *
    4  * Copyright (C) 2005 Peter Graves
     4 * Copyright (C) 2003-2005 Peter Graves
    55 * $Id$
    66 *
    … …  
    3636import static org.armedbear.lisp.Lisp.*;
    3737
    38 public final class StandardGenericFunctionClass extends StandardClass
     38public class FuncallableStandardClass extends StandardClass
    3939{
    40   public static final int SLOT_INDEX_NAME                      = 0;
    41   public static final int SLOT_INDEX_LAMBDA_LIST               = 1;
    42   public static final int SLOT_INDEX_REQUIRED_ARGS             = 2;
    43   public static final int SLOT_INDEX_OPTIONAL_ARGS             = 3;
    44   public static final int SLOT_INDEX_INITIAL_METHODS           = 4;
    45   public static final int SLOT_INDEX_METHODS                   = 5;
    46   public static final int SLOT_INDEX_METHOD_CLASS              = 6;
    47   public static final int SLOT_INDEX_METHOD_COMBINATION        = 7;
    48   public static final int SLOT_INDEX_ARGUMENT_PRECEDENCE_ORDER = 8;
    49   public static final int SLOT_INDEX_CLASSES_TO_EMF_TABLE      = 9;
    50   public static final int SLOT_INDEX_DOCUMENTATION             = 10;
    5140
    52   public StandardGenericFunctionClass()
     41  public FuncallableStandardClass()
    5342  {
    54     super(Symbol.STANDARD_GENERIC_FUNCTION,
    55           list(StandardClass.GENERIC_FUNCTION));
    56     Package pkg = PACKAGE_SYS;
    57     LispObject[] instanceSlotNames =
    58       {
    59         pkg.intern("NAME"),
    60         pkg.intern("LAMBDA-LIST"),
    61         pkg.intern("REQUIRED-ARGS"),
    62         pkg.intern("OPTIONAL-ARGS"),
    63         pkg.intern("INITIAL-METHODS"),
    64         pkg.intern("METHODS"),
    65         pkg.intern("METHOD-CLASS"),
    66         pkg.intern("METHOD-COMBINATION"),
    67         pkg.intern("ARGUMENT-PRECEDENCE-ORDER"),
    68         pkg.intern("CLASSES-TO-EMF-TABLE"),
    69         Symbol.DOCUMENTATION
    70       };
    71     setClassLayout(new Layout(this, instanceSlotNames, NIL));
    72     setFinalized(true);
     43      super(StandardClass.layoutFuncallableStandardClass);
     44  }
     45
     46  public FuncallableStandardClass(Symbol symbol, LispObject directSuperclasses)
     47  {
     48      super(StandardClass.layoutFuncallableStandardClass,
     49            symbol, directSuperclasses);
    7350  }
    7451
    7552  @Override
     53  public LispObject typeOf()
     54  {
     55    return Symbol.FUNCALLABLE_STANDARD_CLASS;
     56  }
     57
     58  @Override
     59  public LispObject classOf()
     60  {
     61    return StandardClass.FUNCALLABLE_STANDARD_CLASS;
     62  }
     63
     64  @Override
     65  public LispObject typep(LispObject type)
     66  {
     67    if (type == Symbol.FUNCALLABLE_STANDARD_CLASS)
     68      return T;
     69    if (type == StandardClass.FUNCALLABLE_STANDARD_CLASS)
     70      return T;
     71    return super.typep(type);
     72  }
     73
    7674  public LispObject allocateInstance()
    7775  {
    78     return new StandardGenericFunction();
     76    Layout layout = getClassLayout();
     77    if (layout == null)
     78      {
     79        Symbol.ERROR.execute(Symbol.SIMPLE_ERROR,
     80                             Keyword.FORMAT_CONTROL,
     81                             new SimpleString("No layout for class ~S."),
     82                             Keyword.FORMAT_ARGUMENTS,
     83                             list(this));
     84      }
     85    return new FuncallableStandardObject(this, layout.getLength());
     86  }
     87
     88  @Override
     89  public String printObject()
     90  {
     91    StringBuilder sb =
     92      new StringBuilder(Symbol.FUNCALLABLE_STANDARD_CLASS.printObject());
     93    if (getName() != null)
     94      {
     95        sb.append(' ');
     96        sb.append(getName().printObject());
     97      }
     98    return unreadableString(sb.toString());
    7999  }
    80100}

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

    r13839 r13871  
    9494      };
    9595
     96  static Layout layoutFuncallableStandardClass =
     97      new Layout(null,
     98                 list(symName,
     99                      symLayout,
     100                      symDirectSuperclasses,
     101                      symDirectSubclasses,
     102                      symPrecedenceList,
     103                      symDirectMethods,
     104                      symDirectSlots,
     105                      symSlots,
     106                      symDirectDefaultInitargs,
     107                      symDefaultInitargs,
     108                      symFinalizedP,
     109                      Symbol.DOCUMENTATION),
     110                 NIL)
     111      {
     112        @Override
     113        public LispClass getLispClass()
     114        {
     115          return FUNCALLABLE_STANDARD_CLASS;
     116        }
     117      };
     118
     119 
     120
    96121  public StandardClass()
    97122  {
    … …  
    124149      setDefaultInitargs(NIL);
    125150      setFinalized(false);
     151  }
     152
     153  public StandardClass(Layout layout)
     154  {
     155    super(layout);
     156    setDirectSuperclasses(NIL);
     157    setDirectSubclasses(NIL);
     158    setClassLayout(layout);
     159    setCPL(NIL);
     160    setDirectMethods(NIL);
     161    setDocumentation(NIL);
     162    setDirectSlotDefinitions(NIL);
     163    setSlotDefinitions(NIL);
     164    setDirectDefaultInitargs(NIL);
     165    setDefaultInitargs(NIL);
     166    setFinalized(false);
     167  }
     168
     169  public StandardClass(Layout layout, Symbol symbol, LispObject directSuperclasses)
     170  {
     171    super(layout, symbol, directSuperclasses);
     172    setDirectSubclasses(NIL);
     173    setClassLayout(layout);
     174    setCPL(NIL);
     175    setDirectMethods(NIL);
     176    setDocumentation(NIL);
     177    setDirectSlotDefinitions(NIL);
     178    setSlotDefinitions(NIL);
     179    setDirectDefaultInitargs(NIL);
     180    setDefaultInitargs(NIL);
     181    setFinalized(false);
     182   
    126183  }
    127184
    … …  
    427484
    428485  public static final StandardClass GENERIC_FUNCTION =
    429     addStandardClass(Symbol.GENERIC_FUNCTION,
    430                      list(METAOBJECT, FUNCALLABLE_STANDARD_OBJECT));
     486    new FuncallableStandardClass(Symbol.GENERIC_FUNCTION,
     487                                 list(METAOBJECT, FUNCALLABLE_STANDARD_OBJECT));
     488  static {
     489    addClass(Symbol.GENERIC_FUNCTION, GENERIC_FUNCTION);
     490  }
    431491
    432492  public static final StandardClass METHOD_COMBINATION =

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

    r13777 r13871  
    3636import static org.armedbear.lisp.Lisp.*;
    3737
    38 public final class StandardGenericFunctionClass extends StandardClass
     38public final class StandardGenericFunctionClass extends FuncallableStandardClass
    3939{
    4040  public static final int SLOT_INDEX_NAME                      = 0;
Note: See TracChangeset for help on using the changeset viewer.