1 | /* |
---|
2 | * SlotDefinition.java |
---|
3 | * |
---|
4 | * Copyright (C) 2005 Peter Graves |
---|
5 | * $Id: SlotDefinition.java 13541 2011-08-27 23:23:24Z mevenson $ |
---|
6 | * |
---|
7 | * This program is free software; you can redistribute it and/or |
---|
8 | * modify it under the terms of the GNU General Public License |
---|
9 | * as published by the Free Software Foundation; either version 2 |
---|
10 | * of the License, or (at your option) any later version. |
---|
11 | * |
---|
12 | * This program is distributed in the hope that it will be useful, |
---|
13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
---|
15 | * GNU General Public License for more details. |
---|
16 | * |
---|
17 | * You should have received a copy of the GNU General Public License |
---|
18 | * along with this program; if not, write to the Free Software |
---|
19 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
---|
20 | * |
---|
21 | * As a special exception, the copyright holders of this library give you |
---|
22 | * permission to link this library with independent modules to produce an |
---|
23 | * executable, regardless of the license terms of these independent |
---|
24 | * modules, and to copy and distribute the resulting executable under |
---|
25 | * terms of your choice, provided that you also meet, for each linked |
---|
26 | * independent module, the terms and conditions of the license of that |
---|
27 | * module. An independent module is a module which is not derived from |
---|
28 | * or based on this library. If you modify this library, you may extend |
---|
29 | * this exception to your version of the library, but you are not |
---|
30 | * obligated to do so. If you do not wish to do so, delete this |
---|
31 | * exception statement from your version. |
---|
32 | */ |
---|
33 | |
---|
34 | package org.armedbear.lisp; |
---|
35 | |
---|
36 | import static org.armedbear.lisp.Lisp.*; |
---|
37 | |
---|
38 | public final class SlotDefinition extends StandardObject |
---|
39 | { |
---|
40 | public SlotDefinition() |
---|
41 | { |
---|
42 | super(StandardClass.STANDARD_SLOT_DEFINITION, |
---|
43 | StandardClass.STANDARD_SLOT_DEFINITION.getClassLayout().getLength()); |
---|
44 | slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = NIL; |
---|
45 | } |
---|
46 | |
---|
47 | public SlotDefinition(StandardClass clazz) { |
---|
48 | super(clazz, clazz.getClassLayout().getLength()); |
---|
49 | slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = NIL; |
---|
50 | } |
---|
51 | |
---|
52 | public SlotDefinition(StandardClass clazz, LispObject name) { |
---|
53 | super(clazz, clazz.getClassLayout().getLength()); |
---|
54 | slots[SlotDefinitionClass.SLOT_INDEX_NAME] = name; |
---|
55 | slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION] = NIL; |
---|
56 | slots[SlotDefinitionClass.SLOT_INDEX_INITARGS] = |
---|
57 | new Cons(PACKAGE_KEYWORD.intern(((Symbol)name).getName())); |
---|
58 | slots[SlotDefinitionClass.SLOT_INDEX_READERS] = NIL; |
---|
59 | slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION] = Keyword.INSTANCE; |
---|
60 | slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = NIL; |
---|
61 | } |
---|
62 | |
---|
63 | public SlotDefinition(LispObject name, LispObject readers) |
---|
64 | { |
---|
65 | this(); |
---|
66 | Debug.assertTrue(name instanceof Symbol); |
---|
67 | slots[SlotDefinitionClass.SLOT_INDEX_NAME] = name; |
---|
68 | slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION] = NIL; |
---|
69 | slots[SlotDefinitionClass.SLOT_INDEX_INITARGS] = |
---|
70 | new Cons(PACKAGE_KEYWORD.intern(((Symbol)name).getName())); |
---|
71 | slots[SlotDefinitionClass.SLOT_INDEX_READERS] = readers; |
---|
72 | slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION] = Keyword.INSTANCE; |
---|
73 | } |
---|
74 | |
---|
75 | public SlotDefinition(LispObject name, LispObject readers, |
---|
76 | LispObject initForm) |
---|
77 | { |
---|
78 | this(); |
---|
79 | Debug.assertTrue(name instanceof Symbol); |
---|
80 | slots[SlotDefinitionClass.SLOT_INDEX_NAME] = name; |
---|
81 | slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION] = NIL; |
---|
82 | slots[SlotDefinitionClass.SLOT_INDEX_INITFORM] = initForm; |
---|
83 | slots[SlotDefinitionClass.SLOT_INDEX_INITARGS] = |
---|
84 | new Cons(PACKAGE_KEYWORD.intern(((Symbol)name).getName())); |
---|
85 | slots[SlotDefinitionClass.SLOT_INDEX_READERS] = readers; |
---|
86 | slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION] = Keyword.INSTANCE; |
---|
87 | } |
---|
88 | |
---|
89 | public SlotDefinition(LispObject name, LispObject readers, |
---|
90 | Function initFunction) |
---|
91 | { |
---|
92 | this(); |
---|
93 | Debug.assertTrue(name instanceof Symbol); |
---|
94 | slots[SlotDefinitionClass.SLOT_INDEX_NAME] = name; |
---|
95 | slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION] = initFunction; |
---|
96 | slots[SlotDefinitionClass.SLOT_INDEX_INITFORM] = NIL; |
---|
97 | slots[SlotDefinitionClass.SLOT_INDEX_INITARGS] = |
---|
98 | new Cons(PACKAGE_KEYWORD.intern(((Symbol)name).getName())); |
---|
99 | slots[SlotDefinitionClass.SLOT_INDEX_READERS] = readers; |
---|
100 | slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION] = Keyword.INSTANCE; |
---|
101 | } |
---|
102 | |
---|
103 | public static StandardObject checkSlotDefinition(LispObject obj) { |
---|
104 | if (obj instanceof StandardObject) return (StandardObject)obj; |
---|
105 | return (StandardObject)type_error(obj, Symbol.SLOT_DEFINITION); |
---|
106 | } |
---|
107 | |
---|
108 | public final LispObject getName() |
---|
109 | { |
---|
110 | return slots[SlotDefinitionClass.SLOT_INDEX_NAME]; |
---|
111 | } |
---|
112 | |
---|
113 | public final void setLocation(int i) |
---|
114 | { |
---|
115 | slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = Fixnum.getInstance(i); |
---|
116 | } |
---|
117 | |
---|
118 | @Override |
---|
119 | public String printObject() |
---|
120 | { |
---|
121 | StringBuilder sb = |
---|
122 | new StringBuilder(Symbol.SLOT_DEFINITION.printObject()); |
---|
123 | LispObject name = slots[SlotDefinitionClass.SLOT_INDEX_NAME]; |
---|
124 | if (name != null && name != NIL) |
---|
125 | { |
---|
126 | sb.append(' '); |
---|
127 | sb.append(name.printObject()); |
---|
128 | } |
---|
129 | return unreadableString(sb.toString()); |
---|
130 | } |
---|
131 | |
---|
132 | private static final Primitive MAKE_SLOT_DEFINITION |
---|
133 | = new pf_make_slot_definition(); |
---|
134 | @DocString(name="make-slot-definition", |
---|
135 | args="&optional class") |
---|
136 | private static final class pf_make_slot_definition extends Primitive |
---|
137 | { |
---|
138 | pf_make_slot_definition() |
---|
139 | { |
---|
140 | super("make-slot-definition", PACKAGE_SYS, true, "&optional class"); |
---|
141 | } |
---|
142 | @Override |
---|
143 | public LispObject execute() |
---|
144 | { |
---|
145 | return new SlotDefinition(); |
---|
146 | } |
---|
147 | @Override |
---|
148 | public LispObject execute(LispObject slotDefinitionClass) |
---|
149 | { |
---|
150 | return new SlotDefinition((StandardClass) slotDefinitionClass); |
---|
151 | } |
---|
152 | }; |
---|
153 | |
---|
154 | private static final Primitive _SLOT_DEFINITION_NAME |
---|
155 | = new pf__slot_definition_name(); |
---|
156 | @DocString(name="%slot-definition-name") |
---|
157 | private static final class pf__slot_definition_name extends Primitive |
---|
158 | { |
---|
159 | pf__slot_definition_name() |
---|
160 | { |
---|
161 | super(Symbol._SLOT_DEFINITION_NAME, "slot-definition"); |
---|
162 | } |
---|
163 | @Override |
---|
164 | public LispObject execute(LispObject arg) |
---|
165 | { |
---|
166 | return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_NAME]; |
---|
167 | } |
---|
168 | }; |
---|
169 | |
---|
170 | private static final Primitive SET_SLOT_DEFINITION_NAME |
---|
171 | = new pf_set_slot_definition_name(); |
---|
172 | @DocString(name="set-slot-definition-name", |
---|
173 | args="slot-definition name") |
---|
174 | private static final class pf_set_slot_definition_name extends Primitive |
---|
175 | { |
---|
176 | pf_set_slot_definition_name() |
---|
177 | { |
---|
178 | super("set-slot-definition-name", PACKAGE_SYS, true, |
---|
179 | "slot-definition name"); |
---|
180 | } |
---|
181 | @Override |
---|
182 | public LispObject execute(LispObject first, LispObject second) |
---|
183 | { |
---|
184 | checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_NAME] = second; |
---|
185 | return second; |
---|
186 | } |
---|
187 | }; |
---|
188 | |
---|
189 | private static final Primitive _SLOT_DEFINITION_INITFUNCTION |
---|
190 | = new pf__slot_definition_initfunction(); |
---|
191 | @DocString(name="%slot-definition-initfunction") |
---|
192 | private static final class pf__slot_definition_initfunction extends Primitive |
---|
193 | { |
---|
194 | pf__slot_definition_initfunction() |
---|
195 | { |
---|
196 | super(Symbol._SLOT_DEFINITION_INITFUNCTION, "slot-definition"); |
---|
197 | } |
---|
198 | @Override |
---|
199 | public LispObject execute(LispObject arg) |
---|
200 | { |
---|
201 | return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION]; |
---|
202 | } |
---|
203 | }; |
---|
204 | |
---|
205 | static final Primitive SET_SLOT_DEFINITION_INITFUNCTION |
---|
206 | = new pf_set_slot_definition_initfunction(); |
---|
207 | @DocString(name="set-slot-definition-initfunction", |
---|
208 | args="slot-definition initfunction") |
---|
209 | static final class pf_set_slot_definition_initfunction extends Primitive |
---|
210 | { |
---|
211 | pf_set_slot_definition_initfunction() |
---|
212 | { |
---|
213 | super("set-slot-definition-initfunction", PACKAGE_SYS, true, |
---|
214 | "slot-definition initfunction"); |
---|
215 | } |
---|
216 | @Override |
---|
217 | public LispObject execute(LispObject first, LispObject second) |
---|
218 | { |
---|
219 | checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_INITFUNCTION] = second; |
---|
220 | return second; |
---|
221 | } |
---|
222 | }; |
---|
223 | |
---|
224 | private static final Primitive _SLOT_DEFINITION_INITFORM |
---|
225 | = new pf__slot_definition_initform(); |
---|
226 | @DocString(name="%slot-definition-initform", |
---|
227 | args="slot-definition") |
---|
228 | private static final class pf__slot_definition_initform extends Primitive |
---|
229 | { |
---|
230 | pf__slot_definition_initform() |
---|
231 | { |
---|
232 | super("%slot-definition-initform", PACKAGE_SYS, true, |
---|
233 | "slot-definition"); |
---|
234 | } |
---|
235 | @Override |
---|
236 | public LispObject execute(LispObject arg) |
---|
237 | { |
---|
238 | return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_INITFORM]; |
---|
239 | } |
---|
240 | }; |
---|
241 | |
---|
242 | static final Primitive SET_SLOT_DEFINITION_INITFORM |
---|
243 | = new pf_set_slot_definition_initform(); |
---|
244 | @DocString(name="set-slot-definition-initform", |
---|
245 | args="slot-definition initform") |
---|
246 | static final class pf_set_slot_definition_initform extends Primitive |
---|
247 | { |
---|
248 | pf_set_slot_definition_initform() |
---|
249 | { |
---|
250 | super("set-slot-definition-initform", PACKAGE_SYS, true, |
---|
251 | "slot-definition initform"); |
---|
252 | } |
---|
253 | @Override |
---|
254 | public LispObject execute(LispObject first, LispObject second) |
---|
255 | { |
---|
256 | checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_INITFORM] = second; |
---|
257 | return second; |
---|
258 | } |
---|
259 | }; |
---|
260 | |
---|
261 | private static final Primitive _SLOT_DEFINITION_INITARGS |
---|
262 | = new pf__slot_definition_initargs(); |
---|
263 | @DocString(name="%slot-definition-initargs") |
---|
264 | private static final class pf__slot_definition_initargs extends Primitive |
---|
265 | { |
---|
266 | pf__slot_definition_initargs() |
---|
267 | { |
---|
268 | super(Symbol._SLOT_DEFINITION_INITARGS, "slot-definition"); |
---|
269 | } |
---|
270 | @Override |
---|
271 | public LispObject execute(LispObject arg) |
---|
272 | { |
---|
273 | return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_INITARGS]; |
---|
274 | } |
---|
275 | }; |
---|
276 | |
---|
277 | private static final Primitive SET_SLOT_DEFINITION_INITARGS |
---|
278 | = new pf_set_slot_definition_initargs(); |
---|
279 | @DocString(name="set-slot-definition-initargs", |
---|
280 | args="slot-definition initargs") |
---|
281 | private static final class pf_set_slot_definition_initargs extends Primitive |
---|
282 | { |
---|
283 | pf_set_slot_definition_initargs() |
---|
284 | { |
---|
285 | super("set-slot-definition-initargs", PACKAGE_SYS, true, |
---|
286 | "slot-definition initargs"); |
---|
287 | } |
---|
288 | @Override |
---|
289 | public LispObject execute(LispObject first, LispObject second) |
---|
290 | { |
---|
291 | checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_INITARGS] = second; |
---|
292 | return second; |
---|
293 | } |
---|
294 | }; |
---|
295 | |
---|
296 | private static final Primitive _SLOT_DEFINITION_READERS |
---|
297 | = new pf__slot_definition_readers(); |
---|
298 | @DocString(name="%slot-definition-readers", |
---|
299 | args="slot-definition") |
---|
300 | private static final class pf__slot_definition_readers extends Primitive { |
---|
301 | pf__slot_definition_readers() |
---|
302 | { |
---|
303 | super("%slot-definition-readers", PACKAGE_SYS, true, |
---|
304 | "slot-definition"); |
---|
305 | } |
---|
306 | @Override |
---|
307 | public LispObject execute(LispObject arg) |
---|
308 | { |
---|
309 | return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_READERS]; |
---|
310 | } |
---|
311 | }; |
---|
312 | |
---|
313 | private static final Primitive SET_SLOT_DEFINITION_READERS |
---|
314 | = new pf_set_slot_definition_readers(); |
---|
315 | @DocString(name="set-slot-definition-readers", |
---|
316 | args="slot-definition readers") |
---|
317 | private static final class pf_set_slot_definition_readers extends Primitive |
---|
318 | { |
---|
319 | pf_set_slot_definition_readers() |
---|
320 | { |
---|
321 | super("set-slot-definition-readers", PACKAGE_SYS, true, |
---|
322 | "slot-definition readers"); |
---|
323 | } |
---|
324 | @Override |
---|
325 | public LispObject execute(LispObject first, LispObject second) |
---|
326 | { |
---|
327 | checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_READERS] = second; |
---|
328 | return second; |
---|
329 | } |
---|
330 | }; |
---|
331 | |
---|
332 | private static final Primitive _SLOT_DEFINITION_WRITERS |
---|
333 | = new pf__slot_definition_writers(); |
---|
334 | @DocString(name="%slot-definition-writers", |
---|
335 | args="slot-definition") |
---|
336 | private static final class pf__slot_definition_writers extends Primitive |
---|
337 | { |
---|
338 | pf__slot_definition_writers() |
---|
339 | { |
---|
340 | super("%slot-definition-writers", PACKAGE_SYS, true, |
---|
341 | "slot-definition"); |
---|
342 | } |
---|
343 | @Override |
---|
344 | public LispObject execute(LispObject arg) |
---|
345 | { |
---|
346 | return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_WRITERS]; |
---|
347 | } |
---|
348 | }; |
---|
349 | |
---|
350 | private static final Primitive SET_SLOT_DEFINITION_WRITERS |
---|
351 | = new pf_set_slot_definition_writers(); |
---|
352 | @DocString(name="set-slot-definition-writers", |
---|
353 | args="slot-definition writers") |
---|
354 | private static final class pf_set_slot_definition_writers extends Primitive |
---|
355 | { |
---|
356 | pf_set_slot_definition_writers() |
---|
357 | { |
---|
358 | super("set-slot-definition-writers", PACKAGE_SYS, true, |
---|
359 | "slot-definition writers"); |
---|
360 | } |
---|
361 | @Override |
---|
362 | public LispObject execute(LispObject first, LispObject second) |
---|
363 | { |
---|
364 | checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_WRITERS] = second; |
---|
365 | return second; |
---|
366 | } |
---|
367 | }; |
---|
368 | |
---|
369 | private static final Primitive _SLOT_DEFINITION_ALLOCATION |
---|
370 | = new pf__slot_definition_allocation(); |
---|
371 | @DocString(name="%slot-definition-allocation", |
---|
372 | args="slot-definition") |
---|
373 | private static final class pf__slot_definition_allocation extends Primitive |
---|
374 | { |
---|
375 | pf__slot_definition_allocation() |
---|
376 | { |
---|
377 | super("%slot-definition-allocation", PACKAGE_SYS, true, |
---|
378 | "slot-definition"); |
---|
379 | } |
---|
380 | @Override |
---|
381 | public LispObject execute(LispObject arg) |
---|
382 | { |
---|
383 | return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION]; |
---|
384 | } |
---|
385 | }; |
---|
386 | |
---|
387 | private static final Primitive SET_SLOT_DEFINITION_ALLOCATION |
---|
388 | = new pf_set_slot_definition_allocation(); |
---|
389 | @DocString(name="set-slot-definition-allocation", |
---|
390 | args="slot-definition allocation") |
---|
391 | private static final class pf_set_slot_definition_allocation extends Primitive |
---|
392 | { |
---|
393 | pf_set_slot_definition_allocation() |
---|
394 | { |
---|
395 | super("set-slot-definition-allocation", PACKAGE_SYS, true, |
---|
396 | "slot-definition allocation"); |
---|
397 | } |
---|
398 | @Override |
---|
399 | public LispObject execute(LispObject first, LispObject second) |
---|
400 | { |
---|
401 | checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION] = second; |
---|
402 | return second; |
---|
403 | } |
---|
404 | }; |
---|
405 | |
---|
406 | private static final Primitive _SLOT_DEFINITION_ALLOCATION_CLASS |
---|
407 | = new pf__slot_definition_allocation_class(); |
---|
408 | @DocString(name="%slot-definition-allocation-class", |
---|
409 | args="slot-definition") |
---|
410 | private static final class pf__slot_definition_allocation_class extends Primitive |
---|
411 | { |
---|
412 | pf__slot_definition_allocation_class() |
---|
413 | { |
---|
414 | super("%slot-definition-allocation-class", PACKAGE_SYS, true, |
---|
415 | "slot-definition"); |
---|
416 | } |
---|
417 | @Override |
---|
418 | public LispObject execute(LispObject arg) |
---|
419 | { |
---|
420 | return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION_CLASS]; |
---|
421 | } |
---|
422 | }; |
---|
423 | |
---|
424 | private static final Primitive SET_SLOT_DEFINITION_ALLOCATION_CLASS |
---|
425 | = new pf_set_slot_definition_allocation_class(); |
---|
426 | @DocString(name="set-slot-definition-allocation-class", |
---|
427 | args="slot-definition allocation-class") |
---|
428 | private static final class pf_set_slot_definition_allocation_class extends Primitive |
---|
429 | { |
---|
430 | pf_set_slot_definition_allocation_class() |
---|
431 | { |
---|
432 | super("set-slot-definition-allocation-class", PACKAGE_SYS, true, |
---|
433 | "slot-definition allocation-class"); |
---|
434 | } |
---|
435 | @Override |
---|
436 | public LispObject execute(LispObject first, LispObject second) |
---|
437 | { |
---|
438 | checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_ALLOCATION_CLASS] = second; |
---|
439 | return second; |
---|
440 | } |
---|
441 | }; |
---|
442 | |
---|
443 | private static final Primitive _SLOT_DEFINITION_LOCATION |
---|
444 | = new pf__slot_definition_location(); |
---|
445 | @DocString(name="%slot-definition-location") |
---|
446 | private static final class pf__slot_definition_location extends Primitive |
---|
447 | { |
---|
448 | pf__slot_definition_location() |
---|
449 | { |
---|
450 | super("%slot-definition-location", PACKAGE_SYS, true, "slot-definition"); |
---|
451 | } |
---|
452 | @Override |
---|
453 | public LispObject execute(LispObject arg) |
---|
454 | { |
---|
455 | return checkSlotDefinition(arg).slots[SlotDefinitionClass.SLOT_INDEX_LOCATION]; |
---|
456 | } |
---|
457 | }; |
---|
458 | |
---|
459 | private static final Primitive SET_SLOT_DEFINITION_LOCATION |
---|
460 | = new pf_set_slot_definition_location(); |
---|
461 | @DocString(name="set-slot-definition-location", |
---|
462 | args="slot-definition location") |
---|
463 | private static final class pf_set_slot_definition_location extends Primitive |
---|
464 | { |
---|
465 | pf_set_slot_definition_location() |
---|
466 | { |
---|
467 | super("set-slot-definition-location", PACKAGE_SYS, true, |
---|
468 | "slot-definition location"); |
---|
469 | } |
---|
470 | @Override |
---|
471 | public LispObject execute(LispObject first, LispObject second) |
---|
472 | { |
---|
473 | checkSlotDefinition(first).slots[SlotDefinitionClass.SLOT_INDEX_LOCATION] = second; |
---|
474 | return second; |
---|
475 | } |
---|
476 | }; |
---|
477 | } |
---|