001: /*
002: * StandardObject.java
003: *
004: * Copyright (C) 2003-2004 Peter Graves
005: * $Id: StandardObject.java,v 1.20 2004/05/23 15:24:08 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 class StandardObject extends LispObject {
025: private Layout layout;
026: private SimpleVector slots;
027:
028: protected StandardObject() {
029: layout = new Layout(BuiltInClass.STANDARD_OBJECT, Fixnum.ZERO,
030: NIL);
031: }
032:
033: protected StandardObject(LispClass cls, SimpleVector slots) {
034: layout = cls.getLayout();
035: Debug.assertTrue(layout != null);
036: this .slots = slots;
037: }
038:
039: public LispObject getParts() throws ConditionThrowable {
040: LispObject result = NIL;
041: result = result.push(new Cons("LAYOUT", layout));
042: result = result.push(new Cons("SLOTS", slots));
043: return result.nreverse();
044: }
045:
046: public final LispClass getLispClass() {
047: return layout.getLispClass();
048: }
049:
050: public final LispObject getSlots() {
051: return slots;
052: }
053:
054: public LispObject typeOf() {
055: // "For objects of metaclass structure-class or standard-class, and for
056: // conditions, type-of returns the proper name of the class returned by
057: // class-of if it has a proper name, and otherwise returns the class
058: // itself."
059: Symbol symbol = layout.getLispClass().getSymbol();
060: if (symbol != NIL)
061: return symbol;
062: return layout.getLispClass();
063: }
064:
065: public LispClass classOf() {
066: return layout.getLispClass();
067: }
068:
069: public LispObject typep(LispObject type) throws ConditionThrowable {
070: if (type == Symbol.STANDARD_OBJECT)
071: return T;
072: if (type == BuiltInClass.STANDARD_OBJECT)
073: return T;
074: LispClass cls = layout != null ? layout.getLispClass() : null;
075: if (cls != null) {
076: if (type == cls)
077: return T;
078: if (type == cls.getSymbol())
079: return T;
080: LispObject cpl = cls.getCPL();
081: while (cpl != NIL) {
082: if (type == cpl.car())
083: return T;
084: if (type == ((LispClass) cpl.car()).getSymbol())
085: return T;
086: cpl = cpl.cdr();
087: }
088: }
089: return super .typep(type);
090: }
091:
092: public String toString() {
093: StringBuffer sb = new StringBuffer("#<");
094: LispClass cls = layout.getLispClass();
095: if (cls != null)
096: sb.append(cls.getSymbol().getName());
097: else
098: sb.append("STANDARD-OBJECT");
099: sb.append(" @ #x");
100: sb.append(Integer.toHexString(hashCode()));
101: sb.append(">");
102: return sb.toString();
103: }
104:
105: // ### std-instance-layout
106: private static final Primitive1 STD_INSTANCE_LAYOUT = new Primitive1(
107: "std-instance-layout", PACKAGE_SYS, false) {
108: public LispObject execute(LispObject arg)
109: throws ConditionThrowable {
110: if (arg instanceof StandardObject)
111: return ((StandardObject) arg).layout;
112: return signal(new TypeError(arg, "standard object"));
113: }
114: };
115:
116: // ### %set-std-instance-layout
117: private static final Primitive2 _SET_STD_INSTANCE_LAYOUT = new Primitive2(
118: "%set-std-instance-layout", PACKAGE_SYS, false) {
119: public LispObject execute(LispObject first, LispObject second)
120: throws ConditionThrowable {
121: try {
122: ((StandardObject) first).layout = (Layout) second;
123: return second;
124: } catch (ClassCastException e) {
125: if (!(first instanceof StandardObject))
126: return signal(new TypeError(first,
127: Symbol.STANDARD_OBJECT));
128: if (!(second instanceof Layout))
129: return signal(new TypeError(second, "layout"));
130: // Not reached.
131: return NIL;
132: }
133: }
134: };
135:
136: // ### std-instance-class
137: private static final Primitive1 STD_INSTANCE_CLASS = new Primitive1(
138: "std-instance-class", PACKAGE_SYS, false) {
139: public LispObject execute(LispObject arg)
140: throws ConditionThrowable {
141: if (arg instanceof StandardObject)
142: return ((StandardObject) arg).layout.getLispClass();
143: return signal(new TypeError(arg, Symbol.STANDARD_OBJECT));
144: }
145: };
146:
147: // ### std-instance-slots
148: private static final Primitive1 STD_INSTANCE_SLOTS = new Primitive1(
149: "std-instance-slots", PACKAGE_SYS, false) {
150: public LispObject execute(LispObject arg)
151: throws ConditionThrowable {
152: if (arg instanceof StandardObject)
153: return ((StandardObject) arg).slots;
154: return signal(new TypeError(arg, Symbol.STANDARD_OBJECT));
155: }
156: };
157:
158: // ### %set-std-instance-slots
159: private static final Primitive2 _SET_STD_INSTANCE_SLOTS = new Primitive2(
160: "%set-std-instance-slots", PACKAGE_SYS, false) {
161: public LispObject execute(LispObject first, LispObject second)
162: throws ConditionThrowable {
163: if (first instanceof StandardObject) {
164: if (second instanceof SimpleVector) {
165: ((StandardObject) first).slots = (SimpleVector) second;
166: return second;
167: }
168: return signal(new TypeError(second,
169: Symbol.SIMPLE_VECTOR));
170: }
171: return signal(new TypeError(first, Symbol.STANDARD_OBJECT));
172: }
173: };
174:
175: // ### instance-ref
176: // instance-ref object index => value
177: private static final Primitive2 INSTANCE_REF = new Primitive2(
178: "instance-ref", PACKAGE_SYS, false) {
179: public LispObject execute(LispObject first, LispObject second)
180: throws ConditionThrowable {
181: try {
182: return ((StandardObject) first).slots.AREF(second);
183: } catch (ClassCastException e) {
184: return signal(new TypeError(first,
185: Symbol.STANDARD_OBJECT));
186: }
187: }
188: };
189:
190: // ### %set-instance-ref
191: // %set-instance-ref object index new-value => new-value
192: private static final Primitive3 _SET_INSTANCE_REF = new Primitive3(
193: "%set-instance-ref", PACKAGE_SYS, false) {
194: public LispObject execute(LispObject first, LispObject second,
195: LispObject third) throws ConditionThrowable {
196: try {
197: ((StandardObject) first).slots.setRowMajor(Fixnum
198: .getValue(second), third);
199: return third;
200: } catch (ClassCastException e) {
201: return signal(new TypeError(first,
202: Symbol.STANDARD_OBJECT));
203: }
204: }
205: };
206:
207: // ### allocate-slot-storage
208: // allocate-slot-storage size initial-value
209: private static final Primitive2 ALLOCATE_SLOT_STORAGE = new Primitive2(
210: "allocate-slot-storage", PACKAGE_SYS, false) {
211: public LispObject execute(LispObject first, LispObject second)
212: throws ConditionThrowable {
213: try {
214: SimpleVector v = new SimpleVector(
215: ((Fixnum) first).value);
216: v.fill(second);
217: return v;
218: } catch (ClassCastException e) {
219: return signal(new TypeError(first, Symbol.FIXNUM));
220: }
221: }
222: };
223:
224: // ### allocate-std-instance
225: // allocate-std-instance class slots => instance
226: private static final Primitive2 ALLOCATE_STD_INSTANCE = new Primitive2(
227: "allocate-std-instance", PACKAGE_SYS, false) {
228: public LispObject execute(LispObject first, LispObject second)
229: throws ConditionThrowable {
230: if (first == BuiltInClass.STANDARD_CLASS)
231: return new StandardClass();
232: if (first instanceof LispClass) {
233: if (second instanceof SimpleVector) {
234: Symbol symbol = ((LispClass) first).getSymbol();
235: SimpleVector slots = (SimpleVector) second;
236: if (symbol == Symbol.STANDARD_GENERIC_FUNCTION)
237: return new GenericFunction((LispClass) first,
238: slots);
239: LispObject cpl = ((LispClass) first).getCPL();
240: while (cpl != NIL) {
241: LispObject obj = cpl.car();
242: if (obj == BuiltInClass.CONDITION)
243: return new Condition((LispClass) first,
244: slots);
245: cpl = cpl.cdr();
246: }
247: return new StandardObject((LispClass) first, slots);
248: }
249: return signal(new TypeError(second,
250: Symbol.SIMPLE_VECTOR));
251: }
252: return signal(new TypeError(first, Symbol.CLASS));
253: }
254: };
255: }
|