Changeset 10317


Ignore:
Timestamp:
11/01/05 17:48:32 (16 years ago)
Author:
piso
Message:

SYS:COMPUTE-CLASS-DEFAULT-INITARGS

Location:
trunk/j/src/org/armedbear/lisp
Files:
2 edited

Legend:

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

    r10261 r10317  
    33 *
    44 * Copyright (C) 2003-2005 Peter Graves
    5  * $Id: Autoload.java,v 1.245 2005-10-28 16:37:29 piso Exp $
     5 * $Id: Autoload.java,v 1.246 2005-11-01 17:48:32 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    578578        autoload(PACKAGE_SYS, "coerce-to-double-float", "FloatFunctions");
    579579        autoload(PACKAGE_SYS, "coerce-to-single-float", "FloatFunctions");
     580        autoload(PACKAGE_SYS, "compute-class-direct-slots", "SlotClass", true);
    580581        autoload(PACKAGE_SYS, "condition-report", "Condition");
    581582        autoload(PACKAGE_SYS, "create-new-file", "create_new_file");
  • trunk/j/src/org/armedbear/lisp/SlotClass.java

    r10313 r10317  
    33 *
    44 * Copyright (C) 2003-2005 Peter Graves
    5  * $Id: SlotClass.java,v 1.16 2005-11-01 16:39:33 piso Exp $
     5 * $Id: SlotClass.java,v 1.17 2005-11-01 17:48:04 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    7373    }
    7474
     75    public LispObject getDirectDefaultInitargs()
     76    {
     77        return directDefaultInitargs;
     78    }
     79
    7580    public void setDirectDefaultInitargs(LispObject directDefaultInitargs)
    7681    {
     
    8186    {
    8287        this.defaultInitargs = defaultInitargs;
     88    }
     89
     90    private LispObject computeDefaultInitargs() throws ConditionThrowable
     91    {
     92        LispObject result = NIL;
     93        LispObject cpl = getCPL();
     94        while (cpl != NIL) {
     95            LispClass c = (LispClass) cpl.car();
     96            if (c instanceof StandardClass) {
     97                LispObject obj = ((StandardClass)c).getDirectDefaultInitargs();
     98                if (obj != NIL)
     99                    result = Symbol.APPEND.execute(result, obj);
     100            }
     101            cpl = cpl.cdr();
     102        }
     103        return result;
    83104    }
    84105
     
    118139            }
    119140            setClassLayout(new Layout(this, instanceSlotNames, NIL));
     141            setDefaultInitargs(computeDefaultInitargs());
    120142            setFinalized(true);
    121143        }
     
    250272        }
    251273    };
     274
     275    // ### compute-class-default-initargs
     276    private static final Primitive COMPUTE_CLASS_DEFAULT_INITARGS =
     277        new Primitive("compute-class-default-initargs", PACKAGE_SYS, true)
     278    {
     279        public LispObject execute(LispObject arg)
     280            throws ConditionThrowable
     281        {
     282            SlotClass c;
     283            try {
     284                c = (SlotClass) arg;
     285            }
     286            catch (ClassCastException e) {
     287                return signalTypeError(arg, Symbol.STANDARD_CLASS);
     288            }
     289            return c.computeDefaultInitargs();
     290        }
     291    };
    252292}
Note: See TracChangeset for help on using the changeset viewer.