|
1
21
22 package org.armedbear.lisp;
23
24 public final class StructureObject extends LispObject
25 {
26 private final LispClass structureClass;
27 private final LispObject[] slots;
28
29 public StructureObject(Symbol symbol, LispObject list) throws ConditionThrowable
30 {
31 structureClass = LispClass.findClass(symbol); Debug.assertTrue(structureClass instanceof StructureClass);
33 slots = list.copyToArray();
34 }
35
36 public StructureObject(StructureObject obj)
37 {
38 this.structureClass = obj.structureClass;
39 slots = new LispObject[obj.slots.length];
40 for (int i = slots.length; i-- > 0;)
41 slots[i] = obj.slots[i];
42 }
43
44 public LispObject typeOf()
45 {
46 return structureClass.getSymbol();
47 }
48
49 public LispClass classOf()
50 {
51 return structureClass;
52 }
53
54 public LispObject getParts() throws ConditionThrowable
55 {
56 LispObject result = NIL;
57 result = result.push(new Cons("class", structureClass));
58 LispObject effectiveSlots = structureClass.getEffectiveSlots();
59 LispObject[] effectiveSlotsArray = effectiveSlots.copyToArray();
60 for (int i = 0; i < slots.length; i++) {
61 SimpleVector slotDefinition = (SimpleVector) effectiveSlotsArray[i];
62 LispObject slotName = slotDefinition.getRowMajor(1);
63 result = result.push(new Cons(slotName, slots[i]));
64 }
65 return result.nreverse();
66 }
67
68 public LispObject typep(LispObject type) throws ConditionThrowable
69 {
70 if (type instanceof StructureClass)
71 return memq(type, structureClass.getCPL()) ? T : NIL;
72 if (type == structureClass.getSymbol())
73 return T;
74 if (type == Symbol.STRUCTURE_OBJECT)
75 return T;
76 if (type == BuiltInClass.STRUCTURE_OBJECT)
77 return T;
78 if (type instanceof Symbol) {
79 LispClass c = LispClass.findClass((Symbol)type);
80 if (c != null) {
81 return memq(c, structureClass.getCPL()) ? T : NIL;
82 }
83 }
84 return super.typep(type);
85 }
86
87 public boolean equalp(LispObject obj) throws ConditionThrowable
88 {
89 if (this == obj)
90 return true;
91 if (obj instanceof StructureObject) {
92 StructureObject o = (StructureObject) obj;
93 if (structureClass != o.structureClass)
94 return false;
95 for (int i = 0; i < slots.length; i++) {
96 if (!slots[i].equalp(o.slots[i]))
97 return false;
98 }
99 return true;
100 }
101 return false;
102 }
103
104 public LispObject getSlotValue(int index) throws ConditionThrowable
105 {
106 try {
107 return slots[index];
108 }
109 catch (ArrayIndexOutOfBoundsException  e) {
110 return signal(new LispError("Invalid slot index " + index +
111 " for " + writeToString()));
112 }
113 }
114
115 public LispObject setSlotValue(int index, LispObject value)
116 throws ConditionThrowable
117 {
118 try {
119 slots[index] = value;
120 return value;
121 }
122 catch (ArrayIndexOutOfBoundsException e) {
123 return signal(new LispError("Invalid slot index " + index +
124 " for " + writeToString()));
125 }
126 }
127
128 public String writeToString() throws ConditionThrowable
129 {
130 if (typep(Symbol.RESTART) != NIL) {
132 Symbol PRINT_RESTART = PACKAGE_SYS.intern("PRINT-RESTART");
133 LispObject fun = PRINT_RESTART.getSymbolFunction();
134 StringOutputStream stream = new StringOutputStream();
135 funcall2(fun, this, stream, LispThread.currentThread());
136 return stream.getString().getStringValue();
137 }
138 StringBuffer sb = new StringBuffer ("#S(");
139 try {
140 LispObject effectiveSlots = structureClass.getEffectiveSlots();
141 LispObject[] effectiveSlotsArray = effectiveSlots.copyToArray();
142 Debug.assertTrue(effectiveSlotsArray.length == slots.length);
143 sb.append(structureClass.getSymbol().writeToString());
144 final LispObject printLength = _PRINT_LENGTH_.symbolValue();
145 final int limit;
146 if (printLength instanceof Fixnum)
147 limit = Math.min(slots.length,
148 ((Fixnum)printLength).getValue());
149 else
150 limit = slots.length;
151 for (int i = 0; i < limit; i++) {
152 sb.append(' ');
153 SimpleVector slotDefinition = (SimpleVector) effectiveSlotsArray[i];
154 LispObject slotName = slotDefinition.getRowMajor(1);
155 if (slotName instanceof Symbol) {
156 sb.append(':');
157 sb.append(((Symbol)slotName).getName());
158 } else
159 sb.append(slotName);
160 sb.append(' ');
161 sb.append(slots[i].writeToString());
162 }
163 if (limit < slots.length)
164 sb.append(" ...");
165 }
166 catch (Throwable t) {
167 Debug.trace(t);
168 }
169 sb.append(')');
170 return sb.toString();
171 }
172
173 private static final Primitive2 _STRUCTURE_REF =
176 new Primitive2("%structure-ref", PACKAGE_SYS, false)
177 {
178 public LispObject execute(LispObject first, LispObject second)
179 throws ConditionThrowable
180 {
181 try {
182 return ((StructureObject)first).slots[((Fixnum)second).getValue()];
183 }
184 catch (ClassCastException e) {
185 if (first instanceof StructureObject)
186 return signal(new TypeError(second, Symbol.FIXNUM));
187 else
188 return signal(new TypeError(first, Symbol.STRUCTURE_OBJECT));
189 }
190 catch (ArrayIndexOutOfBoundsException e) {
191 return signal(new LispError("Internal error."));
193 }
194 }
195 };
196
197 private static final Primitive3 _STRUCTURE_SET =
200 new Primitive3("%structure-set", PACKAGE_SYS, false)
201 {
202 public LispObject execute(LispObject first, LispObject second,
203 LispObject third)
204 throws ConditionThrowable
205 {
206 try {
207 ((StructureObject)first).slots[((Fixnum)second).getValue()] = third;
208 return third;
209 }
210 catch (ClassCastException e) {
211 return signal(new TypeError());
212 }
213 catch (ArrayIndexOutOfBoundsException e) {
214 return signal(new LispError("Internal error."));
216 }
217 }
218 };
219
220 private static final Primitive2 _MAKE_STRUCTURE =
223 new Primitive2("%make-structure", PACKAGE_SYS, false)
224 {
225 public LispObject execute(LispObject first, LispObject second)
226 throws ConditionThrowable
227 {
228 return new StructureObject(checkSymbol(first), checkList(second));
229 }
230 };
231
232 private static final Primitive1 COPY_STRUCTURE =
235 new Primitive1("copy-structure", "structure")
236 {
237 public LispObject execute(LispObject arg) throws ConditionThrowable
238 {
239 try {
240 return new StructureObject((StructureObject)arg);
241 }
242 catch (ClassCastException e) {
243 return signal(new TypeError(arg, "STRUCTURE-OBJECT"));
244 }
245 }
246 };
247 }
248 |
Popular Tags |
Java API By Example, From Geeks To Geeks.