Changeset 4649


Ignore:
Timestamp:
11/05/03 01:47:47 (18 years ago)
Author:
piso
Message:

CLASS-DIRECT-DEFAULT-INITARGS
%SET-CLASS-DIRECT-DEFAULT-INITARGS
CLASS-DEFAULT-INITARGS
%SET-CLASS-DEFAULT-INITARGS

File:
1 edited

Legend:

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

    r4312 r4649  
    33 *
    44 * Copyright (C) 2003 Peter Graves
    5  * $Id: StandardClass.java,v 1.11 2003-10-11 18:48:46 piso Exp $
     5 * $Id: StandardClass.java,v 1.12 2003-11-05 01:47:47 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    2626    private LispObject directSlots = NIL;
    2727    private LispObject effectiveSlots = NIL;
     28    private LispObject directDefaultInitargs = NIL;
     29    private LispObject effectiveDefaultInitargs = NIL;
    2830
    2931    public StandardClass()
     
    122124        }
    123125    };
     126
     127    // ### class-direct-default-initargs
     128    private static final Primitive1 CLASS_DIRECT_DEFAULT_INITARGS =
     129        new Primitive1("class-direct-default-initargs", PACKAGE_SYS, false)
     130    {
     131        public LispObject execute(LispObject arg)
     132            throws ConditionThrowable
     133        {
     134            if (arg instanceof StandardClass)
     135                return ((StandardClass)arg).directDefaultInitargs;
     136            if (arg instanceof BuiltInClass)
     137                return NIL;
     138            throw new ConditionThrowable(new TypeError(arg, "standard class"));
     139        }
     140    };
     141
     142    // ### %set-class-direct-default-initargs
     143    private static final Primitive2 _SET_CLASS_DIRECT_DEFAULT_INITARGS =
     144        new Primitive2("%set-class-direct-default-initargs", PACKAGE_SYS, false)
     145    {
     146        public LispObject execute(LispObject first, LispObject second)
     147            throws ConditionThrowable
     148        {
     149            if (first instanceof StandardClass) {
     150                ((StandardClass)first).directDefaultInitargs = second;
     151                return second;
     152            }
     153            throw new ConditionThrowable(new TypeError(first, "standard class"));
     154        }
     155    };
     156
     157    // ### class-default-initargs
     158    private static final Primitive1 CLASS_DEFAULT_INITARGS =
     159        new Primitive1("class-default-initargs", PACKAGE_SYS, false)
     160    {
     161        public LispObject execute(LispObject arg)
     162            throws ConditionThrowable
     163        {
     164            if (arg instanceof StandardClass)
     165                return ((StandardClass)arg).effectiveDefaultInitargs;
     166            if (arg instanceof BuiltInClass)
     167                return NIL;
     168            throw new ConditionThrowable(new TypeError(arg, "standard class"));
     169        }
     170    };
     171
     172    // ### %set-class-default-initargs
     173    private static final Primitive2 _SET_CLASS_DEFAULT_INITARGS =
     174        new Primitive2("%set-class-default-initargs", PACKAGE_SYS, false)
     175    {
     176        public LispObject execute(LispObject first, LispObject second)
     177            throws ConditionThrowable
     178        {
     179            if (first instanceof StandardClass) {
     180                ((StandardClass)first).effectiveDefaultInitargs = second;
     181                return second;
     182            }
     183            throw new ConditionThrowable(new TypeError(first, "standard class"));
     184        }
     185    };
    124186}
Note: See TracChangeset for help on using the changeset viewer.