001: /*
002: * StructureObject.java
003: *
004: * Copyright (C) 2003-2004 Peter Graves
005: * $Id: StructureObject.java,v 1.30 2004/09/20 16:32:24 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 final class StructureObject extends LispObject {
025: private final LispClass structureClass;
026: private final LispObject[] slots;
027:
028: public StructureObject(Symbol symbol, LispObject list)
029: throws ConditionThrowable {
030: structureClass = LispClass.findClass(symbol); // Might return null.
031: Debug.assertTrue(structureClass instanceof StructureClass);
032: slots = list.copyToArray();
033: }
034:
035: public StructureObject(StructureObject obj) {
036: this .structureClass = obj.structureClass;
037: slots = new LispObject[obj.slots.length];
038: for (int i = slots.length; i-- > 0;)
039: slots[i] = obj.slots[i];
040: }
041:
042: public LispObject typeOf() {
043: return structureClass.getSymbol();
044: }
045:
046: public LispClass classOf() {
047: return structureClass;
048: }
049:
050: public LispObject getParts() throws ConditionThrowable {
051: LispObject result = NIL;
052: result = result.push(new Cons("class", structureClass));
053: LispObject effectiveSlots = structureClass.getEffectiveSlots();
054: LispObject[] effectiveSlotsArray = effectiveSlots.copyToArray();
055: for (int i = 0; i < slots.length; i++) {
056: SimpleVector slotDefinition = (SimpleVector) effectiveSlotsArray[i];
057: LispObject slotName = slotDefinition.getRowMajor(1);
058: result = result.push(new Cons(slotName, slots[i]));
059: }
060: return result.nreverse();
061: }
062:
063: public LispObject typep(LispObject type) throws ConditionThrowable {
064: if (type instanceof StructureClass)
065: return memq(type, structureClass.getCPL()) ? T : NIL;
066: if (type == structureClass.getSymbol())
067: return T;
068: if (type == Symbol.STRUCTURE_OBJECT)
069: return T;
070: if (type == BuiltInClass.STRUCTURE_OBJECT)
071: return T;
072: if (type instanceof Symbol) {
073: LispClass c = LispClass.findClass((Symbol) type);
074: if (c != null) {
075: return memq(c, structureClass.getCPL()) ? T : NIL;
076: }
077: }
078: return super .typep(type);
079: }
080:
081: public boolean equalp(LispObject obj) throws ConditionThrowable {
082: if (this == obj)
083: return true;
084: if (obj instanceof StructureObject) {
085: StructureObject o = (StructureObject) obj;
086: if (structureClass != o.structureClass)
087: return false;
088: for (int i = 0; i < slots.length; i++) {
089: if (!slots[i].equalp(o.slots[i]))
090: return false;
091: }
092: return true;
093: }
094: return false;
095: }
096:
097: public LispObject getSlotValue(int index) throws ConditionThrowable {
098: try {
099: return slots[index];
100: } catch (ArrayIndexOutOfBoundsException e) {
101: return signal(new LispError("Invalid slot index " + index
102: + " for " + writeToString()));
103: }
104: }
105:
106: public LispObject setSlotValue(int index, LispObject value)
107: throws ConditionThrowable {
108: try {
109: slots[index] = value;
110: return value;
111: } catch (ArrayIndexOutOfBoundsException e) {
112: return signal(new LispError("Invalid slot index " + index
113: + " for " + writeToString()));
114: }
115: }
116:
117: public String writeToString() throws ConditionThrowable {
118: // FIXME
119: if (typep(Symbol.RESTART) != NIL) {
120: Symbol PRINT_RESTART = PACKAGE_SYS.intern("PRINT-RESTART");
121: LispObject fun = PRINT_RESTART.getSymbolFunction();
122: StringOutputStream stream = new StringOutputStream();
123: funcall2(fun, this , stream, LispThread.currentThread());
124: return stream.getString().getStringValue();
125: }
126: StringBuffer sb = new StringBuffer("#S(");
127: try {
128: LispObject effectiveSlots = structureClass
129: .getEffectiveSlots();
130: LispObject[] effectiveSlotsArray = effectiveSlots
131: .copyToArray();
132: Debug
133: .assertTrue(effectiveSlotsArray.length == slots.length);
134: sb.append(structureClass.getSymbol().writeToString());
135: final LispObject printLength = _PRINT_LENGTH_.symbolValue();
136: final int limit;
137: if (printLength instanceof Fixnum)
138: limit = Math.min(slots.length, ((Fixnum) printLength)
139: .getValue());
140: else
141: limit = slots.length;
142: for (int i = 0; i < limit; i++) {
143: sb.append(' ');
144: SimpleVector slotDefinition = (SimpleVector) effectiveSlotsArray[i];
145: LispObject slotName = slotDefinition.getRowMajor(1);
146: if (slotName instanceof Symbol) {
147: sb.append(':');
148: sb.append(((Symbol) slotName).getName());
149: } else
150: sb.append(slotName);
151: sb.append(' ');
152: sb.append(slots[i].writeToString());
153: }
154: if (limit < slots.length)
155: sb.append(" ...");
156: } catch (Throwable t) {
157: Debug.trace(t);
158: }
159: sb.append(')');
160: return sb.toString();
161: }
162:
163: // ### %structure-ref
164: // %structure-ref instance index => value
165: private static final Primitive2 _STRUCTURE_REF = new Primitive2(
166: "%structure-ref", PACKAGE_SYS, false) {
167: public LispObject execute(LispObject first, LispObject second)
168: throws ConditionThrowable {
169: try {
170: return ((StructureObject) first).slots[((Fixnum) second)
171: .getValue()];
172: } catch (ClassCastException e) {
173: if (first instanceof StructureObject)
174: return signal(new TypeError(second, Symbol.FIXNUM));
175: else
176: return signal(new TypeError(first,
177: Symbol.STRUCTURE_OBJECT));
178: } catch (ArrayIndexOutOfBoundsException e) {
179: // Shouldn't happen.
180: return signal(new LispError("Internal error."));
181: }
182: }
183: };
184:
185: // ### %structure-set
186: // %structure-set instance index new-value => new-value
187: private static final Primitive3 _STRUCTURE_SET = new Primitive3(
188: "%structure-set", PACKAGE_SYS, false) {
189: public LispObject execute(LispObject first, LispObject second,
190: LispObject third) throws ConditionThrowable {
191: try {
192: ((StructureObject) first).slots[((Fixnum) second)
193: .getValue()] = third;
194: return third;
195: } catch (ClassCastException e) {
196: return signal(new TypeError());
197: } catch (ArrayIndexOutOfBoundsException e) {
198: // Shouldn't happen.
199: return signal(new LispError("Internal error."));
200: }
201: }
202: };
203:
204: // ### %make-structure
205: // %make-structure name slot-values => object
206: private static final Primitive2 _MAKE_STRUCTURE = new Primitive2(
207: "%make-structure", PACKAGE_SYS, false) {
208: public LispObject execute(LispObject first, LispObject second)
209: throws ConditionThrowable {
210: return new StructureObject(checkSymbol(first),
211: checkList(second));
212: }
213: };
214:
215: // ### copy-structure
216: // copy-structure structure => copy
217: private static final Primitive1 COPY_STRUCTURE = new Primitive1(
218: "copy-structure", "structure") {
219: public LispObject execute(LispObject arg)
220: throws ConditionThrowable {
221: try {
222: return new StructureObject((StructureObject) arg);
223: } catch (ClassCastException e) {
224: return signal(new TypeError(arg, "STRUCTURE-OBJECT"));
225: }
226: }
227: };
228: }
|