Changeset 4285


Ignore:
Timestamp:
10/10/03 17:01:33 (19 years ago)
Author:
piso
Message:

CLASS-DIRECT-SLOTS, CLASS-DIRECT-METHODS

File:
1 edited

Legend:

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

    r4283 r4285  
    33 *
    44 * Copyright (C) 2003 Peter Graves
    5  * $Id: StandardClass.java,v 1.7 2003-10-10 14:18:24 piso Exp $
     5 * $Id: StandardClass.java,v 1.8 2003-10-10 17:01:33 piso Exp $
    66 *
    77 * This program is free software; you can redistribute it and/or
     
    2626    private LispObject directSlots;
    2727    private LispObject effectiveSlots;
    28     private LispObject directSubclasses;
    2928    private LispObject directMethods;
    3029
     
    6564    }
    6665
     66    // ### class-direct-slots
     67    private static final Primitive1 CLASS_DIRECT_SLOTS =
     68        new Primitive1("class-direct-slots", PACKAGE_SYS, false)
     69    {
     70        public LispObject execute(LispObject arg)
     71            throws ConditionThrowable
     72        {
     73            if (arg instanceof StandardClass)
     74                return ((StandardClass)arg).directSlots;
     75            if (arg instanceof BuiltInClass)
     76                return NIL;
     77            throw new ConditionThrowable(new TypeError(arg, "standard class"));
     78        }
     79    };
     80
     81    // ### %set-class-direct-slots
     82    private static final Primitive2 _SET_CLASS_DIRECT_SLOTS =
     83        new Primitive2("%set-class-direct-slots", PACKAGE_SYS, false)
     84    {
     85        public LispObject execute(LispObject first, LispObject second)
     86            throws ConditionThrowable
     87        {
     88            if (first instanceof StandardClass) {
     89                ((StandardClass)first).directSlots = second;
     90                return second;
     91            }
     92            throw new ConditionThrowable(new TypeError(first, "standard class"));
     93        }
     94    };
     95
    6796    // ### class-slots
    6897    private static final Primitive1 CLASS_SLOTS =
     
    94123        }
    95124    };
     125
     126    // ### class-direct-methods
     127    private static final Primitive1 CLASS_DIRECT_METHODS =
     128        new Primitive1("class-direct-methods", PACKAGE_SYS, false)
     129    {
     130        public LispObject execute(LispObject arg)
     131            throws ConditionThrowable
     132        {
     133            if (arg instanceof StandardClass)
     134                return ((StandardClass)arg).directMethods;
     135            throw new ConditionThrowable(new TypeError(arg, "standard class"));
     136        }
     137    };
     138
     139    // ### %set-class-direct-methods
     140    private static final Primitive2 _SET_CLASS_DIRECT_METHODS =
     141        new Primitive2("%set-class-direct-methods", PACKAGE_SYS, false)
     142    {
     143        public LispObject execute(LispObject first, LispObject second)
     144            throws ConditionThrowable
     145        {
     146            if (first instanceof StandardClass) {
     147                ((StandardClass)first).directMethods = second;
     148                return second;
     149            }
     150            throw new ConditionThrowable(new TypeError(first, "standard class"));
     151        }
     152    };
    96153}
Note: See TracChangeset for help on using the changeset viewer.