|
1
21
22 package org.armedbear.lisp;
23
24 public class SlotClass extends LispClass
25 {
26 private LispObject directSlots = NIL;
27 private LispObject effectiveSlots = NIL;
28 private LispObject directDefaultInitargs = NIL;
29 private LispObject effectiveDefaultInitargs = NIL;
30
31 public SlotClass()
32 {
33 }
34
35 public SlotClass(Symbol symbol, LispObject directSuperclasses)
36 {
37 super(symbol, directSuperclasses);
38 }
39
40 public LispObject getParts() throws ConditionThrowable
41 {
42 LispObject result = super.getParts().nreverse();
43 result = result.push(new Cons("DIRECT-SLOTS", directSlots));
44 result = result.push(new Cons("EFFECTIVE-SLOTS", effectiveSlots));
45 result = result.push(new Cons("DIRECT-DEFAULT-INITARGS", directDefaultInitargs));
46 result = result.push(new Cons("EFFECTIVE-DEFAULT-INITARGS", effectiveDefaultInitargs));
47 return result.nreverse();
48 }
49
50 public LispObject typep(LispObject type) throws ConditionThrowable
51 {
52 return super.typep(type);
53 }
54
55 public void setDirectSlots(LispObject directSlots)
56 {
57 this.directSlots = directSlots;
58 }
59
60 public final LispObject getEffectiveSlots()
61 {
62 return effectiveSlots;
63 }
64
65 public void setEffectiveSlots(LispObject slots)
66 {
67 this.effectiveSlots = slots;
68 }
69
70 private static final Primitive1 CLASS_DIRECT_SLOTS =
72 new Primitive1("class-direct-slots", PACKAGE_SYS, false)
73 {
74 public LispObject execute(LispObject arg)
75 throws ConditionThrowable
76 {
77 if (arg instanceof SlotClass)
78 return ((SlotClass)arg).directSlots;
79 if (arg instanceof BuiltInClass)
80 return NIL;
81 return signal(new TypeError(arg, "standard class"));
82 }
83 };
84
85 private static final Primitive2 _SET_CLASS_DIRECT_SLOTS =
87 new Primitive2("%set-class-direct-slots", PACKAGE_SYS, false)
88 {
89 public LispObject execute(LispObject first, LispObject second)
90 throws ConditionThrowable
91 {
92 if (first instanceof SlotClass) {
93 ((SlotClass)first).directSlots = second;
94 return second;
95 }
96 return signal(new TypeError(first, "standard class"));
97 }
98 };
99
100 private static final Primitive1 CLASS_SLOTS =
102 new Primitive1("class-slots", PACKAGE_SYS, false)
103 {
104 public LispObject execute(LispObject arg)
105 throws ConditionThrowable
106 {
107 if (arg instanceof SlotClass)
108 return ((SlotClass)arg).effectiveSlots;
109 if (arg instanceof BuiltInClass)
110 return NIL;
111 return signal(new TypeError(arg, "standard class"));
112 }
113 };
114
115 private static final Primitive2 _SET_CLASS_SLOTS =
117 new Primitive2("%set-class-slots", PACKAGE_SYS, false)
118 {
119 public LispObject execute(LispObject first, LispObject second)
120 throws ConditionThrowable
121 {
122 if (first instanceof SlotClass) {
123 ((SlotClass)first).effectiveSlots = second;
124 return second;
125 }
126 return signal(new TypeError(first, "standard class"));
127 }
128 };
129
130 private static final Primitive1 CLASS_DIRECT_DEFAULT_INITARGS =
132 new Primitive1("class-direct-default-initargs", PACKAGE_SYS, false)
133 {
134 public LispObject execute(LispObject arg)
135 throws ConditionThrowable
136 {
137 if (arg instanceof SlotClass)
138 return ((SlotClass)arg).directDefaultInitargs;
139 if (arg instanceof BuiltInClass)
140 return NIL;
141 return signal(new TypeError(arg, "standard class"));
142 }
143 };
144
145 private static final Primitive2 _SET_CLASS_DIRECT_DEFAULT_INITARGS =
147 new Primitive2("%set-class-direct-default-initargs", PACKAGE_SYS, false)
148 {
149 public LispObject execute(LispObject first, LispObject second)
150 throws ConditionThrowable
151 {
152 if (first instanceof SlotClass) {
153 ((SlotClass)first).directDefaultInitargs = second;
154 return second;
155 }
156 return signal(new TypeError(first, "standard class"));
157 }
158 };
159
160 private static final Primitive1 CLASS_DEFAULT_INITARGS =
162 new Primitive1("class-default-initargs", PACKAGE_SYS, false)
163 {
164 public LispObject execute(LispObject arg)
165 throws ConditionThrowable
166 {
167 if (arg instanceof SlotClass)
168 return ((SlotClass)arg).effectiveDefaultInitargs;
169 if (arg instanceof BuiltInClass)
170 return NIL;
171 return signal(new TypeError(arg, "standard class"));
172 }
173 };
174
175 private static final Primitive2 _SET_CLASS_DEFAULT_INITARGS =
177 new Primitive2("%set-class-default-initargs", PACKAGE_SYS, false)
178 {
179 public LispObject execute(LispObject first, LispObject second)
180 throws ConditionThrowable
181 {
182 if (first instanceof SlotClass) {
183 ((SlotClass)first).effectiveDefaultInitargs = second;
184 return second;
185 }
186 return signal(new TypeError(first, "standard class"));
187 }
188 };
189 }
190 |
Popular Tags |
Java API By Example, From Geeks To Geeks.