001: /*
002: * SlotClass.java
003: *
004: * Copyright (C) 2003-2004 Peter Graves
005: * $Id: SlotClass.java,v 1.6 2004/05/23 15:23:37 piso Exp $
006: *
007: * This program is free software; you can redistribute it and/or
008: * modify it under the terms of the GNU General Public License
009: * as published by the Free Software Foundation; either version 2
010: * of the License, or (at your option) any later version.
011: *
012: * This program is distributed in the hope that it will be useful,
013: * but WITHOUT ANY WARRANTY; without even the implied warranty of
014: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
015: * GNU General Public License for more details.
016: *
017: * You should have received a copy of the GNU General Public License
018: * along with this program; if not, write to the Free Software
019: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
020: */
021:
022: package org.armedbear.lisp;
023:
024: public class SlotClass extends LispClass {
025: private LispObject directSlots = NIL;
026: private LispObject effectiveSlots = NIL;
027: private LispObject directDefaultInitargs = NIL;
028: private LispObject effectiveDefaultInitargs = NIL;
029:
030: public SlotClass() {
031: }
032:
033: public SlotClass(Symbol symbol, LispObject directSuperclasses) {
034: super (symbol, directSuperclasses);
035: }
036:
037: public LispObject getParts() throws ConditionThrowable {
038: LispObject result = super .getParts().nreverse();
039: result = result.push(new Cons("DIRECT-SLOTS", directSlots));
040: result = result
041: .push(new Cons("EFFECTIVE-SLOTS", effectiveSlots));
042: result = result.push(new Cons("DIRECT-DEFAULT-INITARGS",
043: directDefaultInitargs));
044: result = result.push(new Cons("EFFECTIVE-DEFAULT-INITARGS",
045: effectiveDefaultInitargs));
046: return result.nreverse();
047: }
048:
049: public LispObject typep(LispObject type) throws ConditionThrowable {
050: return super .typep(type);
051: }
052:
053: public void setDirectSlots(LispObject directSlots) {
054: this .directSlots = directSlots;
055: }
056:
057: public final LispObject getEffectiveSlots() {
058: return effectiveSlots;
059: }
060:
061: public void setEffectiveSlots(LispObject slots) {
062: this .effectiveSlots = slots;
063: }
064:
065: // ### class-direct-slots
066: private static final Primitive1 CLASS_DIRECT_SLOTS = new Primitive1(
067: "class-direct-slots", PACKAGE_SYS, false) {
068: public LispObject execute(LispObject arg)
069: throws ConditionThrowable {
070: if (arg instanceof SlotClass)
071: return ((SlotClass) arg).directSlots;
072: if (arg instanceof BuiltInClass)
073: return NIL;
074: return signal(new TypeError(arg, "standard class"));
075: }
076: };
077:
078: // ### %set-class-direct-slots
079: private static final Primitive2 _SET_CLASS_DIRECT_SLOTS = new Primitive2(
080: "%set-class-direct-slots", PACKAGE_SYS, false) {
081: public LispObject execute(LispObject first, LispObject second)
082: throws ConditionThrowable {
083: if (first instanceof SlotClass) {
084: ((SlotClass) first).directSlots = second;
085: return second;
086: }
087: return signal(new TypeError(first, "standard class"));
088: }
089: };
090:
091: // ### class-slots
092: private static final Primitive1 CLASS_SLOTS = new Primitive1(
093: "class-slots", PACKAGE_SYS, false) {
094: public LispObject execute(LispObject arg)
095: throws ConditionThrowable {
096: if (arg instanceof SlotClass)
097: return ((SlotClass) arg).effectiveSlots;
098: if (arg instanceof BuiltInClass)
099: return NIL;
100: return signal(new TypeError(arg, "standard class"));
101: }
102: };
103:
104: // ### %set-class-slots
105: private static final Primitive2 _SET_CLASS_SLOTS = new Primitive2(
106: "%set-class-slots", PACKAGE_SYS, false) {
107: public LispObject execute(LispObject first, LispObject second)
108: throws ConditionThrowable {
109: if (first instanceof SlotClass) {
110: ((SlotClass) first).effectiveSlots = second;
111: return second;
112: }
113: return signal(new TypeError(first, "standard class"));
114: }
115: };
116:
117: // ### class-direct-default-initargs
118: private static final Primitive1 CLASS_DIRECT_DEFAULT_INITARGS = new Primitive1(
119: "class-direct-default-initargs", PACKAGE_SYS, false) {
120: public LispObject execute(LispObject arg)
121: throws ConditionThrowable {
122: if (arg instanceof SlotClass)
123: return ((SlotClass) arg).directDefaultInitargs;
124: if (arg instanceof BuiltInClass)
125: return NIL;
126: return signal(new TypeError(arg, "standard class"));
127: }
128: };
129:
130: // ### %set-class-direct-default-initargs
131: private static final Primitive2 _SET_CLASS_DIRECT_DEFAULT_INITARGS = new Primitive2(
132: "%set-class-direct-default-initargs", PACKAGE_SYS, false) {
133: public LispObject execute(LispObject first, LispObject second)
134: throws ConditionThrowable {
135: if (first instanceof SlotClass) {
136: ((SlotClass) first).directDefaultInitargs = second;
137: return second;
138: }
139: return signal(new TypeError(first, "standard class"));
140: }
141: };
142:
143: // ### class-default-initargs
144: private static final Primitive1 CLASS_DEFAULT_INITARGS = new Primitive1(
145: "class-default-initargs", PACKAGE_SYS, false) {
146: public LispObject execute(LispObject arg)
147: throws ConditionThrowable {
148: if (arg instanceof SlotClass)
149: return ((SlotClass) arg).effectiveDefaultInitargs;
150: if (arg instanceof BuiltInClass)
151: return NIL;
152: return signal(new TypeError(arg, "standard class"));
153: }
154: };
155:
156: // ### %set-class-default-initargs
157: private static final Primitive2 _SET_CLASS_DEFAULT_INITARGS = new Primitive2(
158: "%set-class-default-initargs", PACKAGE_SYS, false) {
159: public LispObject execute(LispObject first, LispObject second)
160: throws ConditionThrowable {
161: if (first instanceof SlotClass) {
162: ((SlotClass) first).effectiveDefaultInitargs = second;
163: return second;
164: }
165: return signal(new TypeError(first, "standard class"));
166: }
167: };
168: }
|