|
1
21
22 package org.armedbear.lisp;
23
24 public class StandardObject extends LispObject
25 {
26 private Layout layout;
27 private SimpleVector slots;
28
29 protected StandardObject()
30 {
31 layout = new Layout(BuiltInClass.STANDARD_OBJECT, Fixnum.ZERO, NIL);
32 }
33
34 protected StandardObject(LispClass cls, SimpleVector slots)
35 {
36 layout = cls.getLayout();
37 Debug.assertTrue(layout != null);
38 this.slots = slots;
39 }
40
41 public LispObject getParts() throws ConditionThrowable
42 {
43 LispObject result = NIL;
44 result = result.push(new Cons("LAYOUT", layout));
45 result = result.push(new Cons("SLOTS", slots));
46 return result.nreverse();
47 }
48
49 public final LispClass getLispClass()
50 {
51 return layout.getLispClass();
52 }
53
54 public final LispObject getSlots()
55 {
56 return slots;
57 }
58
59 public LispObject typeOf()
60 {
61 Symbol symbol = layout.getLispClass().getSymbol();
66 if (symbol != NIL)
67 return symbol;
68 return layout.getLispClass();
69 }
70
71 public LispClass classOf()
72 {
73 return layout.getLispClass();
74 }
75
76 public LispObject typep(LispObject type) throws ConditionThrowable
77 {
78 if (type == Symbol.STANDARD_OBJECT)
79 return T;
80 if (type == BuiltInClass.STANDARD_OBJECT)
81 return T;
82 LispClass cls = layout != null ? layout.getLispClass() : null;
83 if (cls != null) {
84 if (type == cls)
85 return T;
86 if (type == cls.getSymbol())
87 return T;
88 LispObject cpl = cls.getCPL();
89 while (cpl != NIL) {
90 if (type == cpl.car())
91 return T;
92 if (type == ((LispClass)cpl.car()).getSymbol())
93 return T;
94 cpl = cpl.cdr();
95 }
96 }
97 return super.typep(type);
98 }
99
100 public String  toString()
101 {
102 StringBuffer sb = new StringBuffer ("#<");
103 LispClass cls = layout.getLispClass();
104 if (cls != null)
105 sb.append(cls.getSymbol().getName());
106 else
107 sb.append("STANDARD-OBJECT");
108 sb.append(" @ #x");
109 sb.append(Integer.toHexString(hashCode()));
110 sb.append(">");
111 return sb.toString();
112 }
113
114 private static final Primitive1 STD_INSTANCE_LAYOUT =
116 new Primitive1("std-instance-layout", PACKAGE_SYS, false)
117 {
118 public LispObject execute(LispObject arg) throws ConditionThrowable
119 {
120 if (arg instanceof StandardObject)
121 return ((StandardObject)arg).layout;
122 return signal(new TypeError(arg, "standard object"));
123 }
124 };
125
126 private static final Primitive2 _SET_STD_INSTANCE_LAYOUT =
128 new Primitive2("%set-std-instance-layout", PACKAGE_SYS, false)
129 {
130 public LispObject execute(LispObject first, LispObject second)
131 throws ConditionThrowable
132 {
133 try {
134 ((StandardObject)first).layout = (Layout) second;
135 return second;
136 }
137 catch (ClassCastException e) {
138 if (!(first instanceof StandardObject))
139 return signal(new TypeError(first, Symbol.STANDARD_OBJECT));
140 if (!(second instanceof Layout))
141 return signal(new TypeError(second, "layout"));
142 return NIL;
144 }
145 }
146 };
147
148 private static final Primitive1 STD_INSTANCE_CLASS =
150 new Primitive1("std-instance-class", PACKAGE_SYS, false)
151 {
152 public LispObject execute(LispObject arg) throws ConditionThrowable
153 {
154 if (arg instanceof StandardObject)
155 return ((StandardObject)arg).layout.getLispClass();
156 return signal(new TypeError(arg, Symbol.STANDARD_OBJECT));
157 }
158 };
159
160 private static final Primitive1 STD_INSTANCE_SLOTS =
162 new Primitive1("std-instance-slots", PACKAGE_SYS, false)
163 {
164 public LispObject execute(LispObject arg) throws ConditionThrowable
165 {
166 if (arg instanceof StandardObject)
167 return ((StandardObject)arg).slots;
168 return signal(new TypeError(arg, Symbol.STANDARD_OBJECT));
169 }
170 };
171
172 private static final Primitive2 _SET_STD_INSTANCE_SLOTS =
174 new Primitive2("%set-std-instance-slots", PACKAGE_SYS, false)
175 {
176 public LispObject execute(LispObject first, LispObject second)
177 throws ConditionThrowable
178 {
179 if (first instanceof StandardObject) {
180 if (second instanceof SimpleVector) {
181 ((StandardObject)first).slots = (SimpleVector) second;
182 return second;
183 }
184 return signal(new TypeError(second, Symbol.SIMPLE_VECTOR));
185 }
186 return signal(new TypeError(first, Symbol.STANDARD_OBJECT));
187 }
188 };
189
190 private static final Primitive2 INSTANCE_REF =
193 new Primitive2("instance-ref", PACKAGE_SYS, false)
194 {
195 public LispObject execute(LispObject first, LispObject second)
196 throws ConditionThrowable
197 {
198 try {
199 return ((StandardObject)first).slots.AREF(second);
200 }
201 catch (ClassCastException e) {
202 return signal(new TypeError(first, Symbol.STANDARD_OBJECT));
203 }
204 }
205 };
206
207 private static final Primitive3 _SET_INSTANCE_REF =
210 new Primitive3("%set-instance-ref", PACKAGE_SYS, false)
211 {
212 public LispObject execute(LispObject first, LispObject second,
213 LispObject third)
214 throws ConditionThrowable
215 {
216 try {
217 ((StandardObject)first).slots.setRowMajor(Fixnum.getValue(second),
218 third);
219 return third;
220 }
221 catch (ClassCastException e) {
222 return signal(new TypeError(first, Symbol.STANDARD_OBJECT));
223 }
224 }
225 };
226
227 private static final Primitive2 ALLOCATE_SLOT_STORAGE =
230 new Primitive2("allocate-slot-storage", PACKAGE_SYS, false)
231 {
232 public LispObject execute(LispObject first, LispObject second)
233 throws ConditionThrowable
234 {
235 try {
236 SimpleVector v = new SimpleVector(((Fixnum)first).value);
237 v.fill(second);
238 return v;
239 }
240 catch (ClassCastException e) {
241 return signal(new TypeError(first, Symbol.FIXNUM));
242 }
243 }
244 };
245
246 private static final Primitive2 ALLOCATE_STD_INSTANCE =
249 new Primitive2("allocate-std-instance", PACKAGE_SYS, false)
250 {
251 public LispObject execute(LispObject first, LispObject second)
252 throws ConditionThrowable
253 {
254 if (first == BuiltInClass.STANDARD_CLASS)
255 return new StandardClass();
256 if (first instanceof LispClass) {
257 if (second instanceof SimpleVector) {
258 Symbol symbol = ((LispClass)first).getSymbol();
259 SimpleVector slots = (SimpleVector) second;
260 if (symbol == Symbol.STANDARD_GENERIC_FUNCTION)
261 return new GenericFunction((LispClass)first, slots);
262 LispObject cpl = ((LispClass)first).getCPL();
263 while (cpl != NIL) {
264 LispObject obj = cpl.car();
265 if (obj == BuiltInClass.CONDITION)
266 return new Condition((LispClass)first, slots);
267 cpl = cpl.cdr();
268 }
269 return new StandardObject((LispClass)first, slots);
270 }
271 return signal(new TypeError(second, Symbol.SIMPLE_VECTOR));
272 }
273 return signal(new TypeError(first, Symbol.CLASS));
274 }
275 };
276 }
277 |
Popular Tags |
Java API By Example, From Geeks To Geeks.