001: /*
002: * StandardObject.java
003: *
004: * Copyright (C) 2003 Peter Graves
005: * $Id: StandardObject.java,v 1.6 2003/11/15 11:03:33 beedlem 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: // Slots.
026: private LispClass cls;
027: private LispObject slots; // A simple vector.
028:
029: protected StandardObject() {
030: }
031:
032: protected StandardObject(LispClass cls, LispObject slots) {
033: this .cls = cls;
034: this .slots = slots;
035: }
036:
037: public final LispClass getLispClass() {
038: return cls;
039: }
040:
041: public final LispObject getSlots() {
042: return slots;
043: }
044:
045: public LispObject typeOf() {
046: return cls != null ? cls.getSymbol() : Symbol.STANDARD_OBJECT;
047: }
048:
049: public LispClass classOf() {
050: return cls != null ? cls : BuiltInClass.STANDARD_OBJECT;
051: }
052:
053: public LispObject typep(LispObject type) throws ConditionThrowable {
054: if (type == Symbol.STANDARD_OBJECT)
055: return T;
056: if (type == BuiltInClass.STANDARD_OBJECT)
057: return T;
058: if (cls != null) {
059: if (type == cls)
060: return T;
061: if (type == cls.getSymbol())
062: return T;
063: LispObject cpl = cls.getCPL();
064: while (cpl != NIL) {
065: if (type == cpl.car())
066: return T;
067: if (type == ((LispClass) cpl.car()).getSymbol())
068: return T;
069: cpl = cpl.cdr();
070: }
071: }
072: return super .typep(type);
073: }
074:
075: public String toString() {
076: StringBuffer sb = new StringBuffer("#<");
077: if (cls != null)
078: sb.append(cls.getSymbol().getName());
079: else
080: sb.append("STANDARD-OBJECT");
081: sb.append(" @ #x");
082: sb.append(Integer.toHexString(hashCode()));
083: sb.append(">");
084: return sb.toString();
085: }
086:
087: // ### std-instance-class
088: private static final Primitive1 STD_INSTANCE_CLASS = new Primitive1(
089: "std-instance-class", PACKAGE_SYS, false) {
090: public LispObject execute(LispObject arg)
091: throws ConditionThrowable {
092: if (arg instanceof StandardObject)
093: return ((StandardObject) arg).cls;
094: throw new ConditionThrowable(new TypeError(arg,
095: "standard object"));
096: }
097: };
098:
099: // ### %set-std-instance-class
100: private static final Primitive2 _SET_STD_INSTANCE_CLASS = new Primitive2(
101: "%set-std-instance-class", PACKAGE_SYS, false) {
102: public LispObject execute(LispObject first, LispObject second)
103: throws ConditionThrowable {
104: if (first instanceof StandardObject) {
105: ((StandardObject) first).cls = (LispClass) second;
106: return second;
107: }
108: throw new ConditionThrowable(new TypeError(first,
109: "standard object"));
110: }
111: };
112:
113: // ### std-instance-slots
114: private static final Primitive1 STD_INSTANCE_SLOTS = new Primitive1(
115: "std-instance-slots", PACKAGE_SYS, false) {
116: public LispObject execute(LispObject arg)
117: throws ConditionThrowable {
118: if (arg instanceof StandardObject)
119: return ((StandardObject) arg).slots;
120: throw new ConditionThrowable(new TypeError(arg,
121: "standard object"));
122: }
123: };
124:
125: // ### %set-std-instance-slots
126: private static final Primitive2 _SET_STD_INSTANCE_SLOTS = new Primitive2(
127: "%set-std-instance-slots", PACKAGE_SYS, false) {
128: public LispObject execute(LispObject first, LispObject second)
129: throws ConditionThrowable {
130: if (first instanceof StandardObject) {
131: ((StandardObject) first).slots = second;
132: return second;
133: }
134: throw new ConditionThrowable(new TypeError(first,
135: "standard object"));
136: }
137: };
138:
139: // ### allocate-std-instance
140: // allocate-std-instance class slots => instance
141: private static final Primitive2 ALLOCATE_STD_INSTANCE = new Primitive2(
142: "allocate-std-instance", PACKAGE_SYS, false) {
143: public LispObject execute(LispObject first, LispObject second)
144: throws ConditionThrowable {
145: if (first == BuiltInClass.STANDARD_CLASS)
146: return new StandardClass();
147: if (first instanceof LispClass) {
148: Symbol symbol = ((LispClass) first).getSymbol();
149: if (symbol == Symbol.STANDARD_GENERIC_FUNCTION)
150: return new GenericFunction((LispClass) first,
151: second);
152: LispObject cpl = ((LispClass) first).getCPL();
153: while (cpl != NIL) {
154: LispObject obj = cpl.car();
155: if (obj == BuiltInClass.CONDITION)
156: return new Condition((LispClass) first, second);
157: cpl = cpl.cdr();
158: }
159: return new StandardObject((LispClass) first, second);
160: }
161: throw new ConditionThrowable(new TypeError(first, "class"));
162: }
163: };
164: }
|