001: /*
002: * StandardClass.java
003: *
004: * Copyright (C) 2003 Peter Graves
005: * $Id: StandardClass.java,v 1.7 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 StandardClass extends LispClass {
025: private LispObject directSlots = NIL;
026: private LispObject effectiveSlots = NIL;
027: private LispObject directDefaultInitargs = NIL;
028: private LispObject effectiveDefaultInitargs = NIL;
029:
030: public StandardClass() {
031: }
032:
033: public StandardClass(Symbol symbol, LispObject directSuperclasses) {
034: super (symbol, directSuperclasses);
035: }
036:
037: public LispObject typeOf() {
038: return Symbol.STANDARD_CLASS;
039: }
040:
041: public LispClass classOf() {
042: return BuiltInClass.STANDARD_CLASS;
043: }
044:
045: public LispObject typep(LispObject type) throws ConditionThrowable {
046: if (type == Symbol.STANDARD_CLASS)
047: return T;
048: if (type == BuiltInClass.STANDARD_CLASS)
049: return T;
050: return super .typep(type);
051: }
052:
053: public String toString() {
054: StringBuffer sb = new StringBuffer("#<STANDARD-CLASS ");
055: sb.append(symbol.getName());
056: sb.append('>');
057: return sb.toString();
058: }
059:
060: // ### class-direct-slots
061: private static final Primitive1 CLASS_DIRECT_SLOTS = new Primitive1(
062: "class-direct-slots", PACKAGE_SYS, false) {
063: public LispObject execute(LispObject arg)
064: throws ConditionThrowable {
065: if (arg instanceof StandardClass)
066: return ((StandardClass) arg).directSlots;
067: if (arg instanceof BuiltInClass)
068: return NIL;
069: throw new ConditionThrowable(new TypeError(arg,
070: "standard class"));
071: }
072: };
073:
074: // ### %set-class-direct-slots
075: private static final Primitive2 _SET_CLASS_DIRECT_SLOTS = new Primitive2(
076: "%set-class-direct-slots", PACKAGE_SYS, false) {
077: public LispObject execute(LispObject first, LispObject second)
078: throws ConditionThrowable {
079: if (first instanceof StandardClass) {
080: ((StandardClass) first).directSlots = second;
081: return second;
082: }
083: throw new ConditionThrowable(new TypeError(first,
084: "standard class"));
085: }
086: };
087:
088: // ### class-slots
089: private static final Primitive1 CLASS_SLOTS = new Primitive1(
090: "class-slots", PACKAGE_SYS, false) {
091: public LispObject execute(LispObject arg)
092: throws ConditionThrowable {
093: if (arg instanceof StandardClass)
094: return ((StandardClass) arg).effectiveSlots;
095: if (arg instanceof BuiltInClass)
096: return NIL;
097: throw new ConditionThrowable(new TypeError(arg,
098: "standard class"));
099: }
100: };
101:
102: // ### %set-class-slots
103: private static final Primitive2 _SET_CLASS_SLOTS = new Primitive2(
104: "%set-class-slots", PACKAGE_SYS, false) {
105: public LispObject execute(LispObject first, LispObject second)
106: throws ConditionThrowable {
107: if (first instanceof StandardClass) {
108: ((StandardClass) first).effectiveSlots = second;
109: return second;
110: }
111: throw new ConditionThrowable(new TypeError(first,
112: "standard class"));
113: }
114: };
115:
116: // ### class-direct-default-initargs
117: private static final Primitive1 CLASS_DIRECT_DEFAULT_INITARGS = new Primitive1(
118: "class-direct-default-initargs", PACKAGE_SYS, false) {
119: public LispObject execute(LispObject arg)
120: throws ConditionThrowable {
121: if (arg instanceof StandardClass)
122: return ((StandardClass) arg).directDefaultInitargs;
123: if (arg instanceof BuiltInClass)
124: return NIL;
125: throw new ConditionThrowable(new TypeError(arg,
126: "standard class"));
127: }
128: };
129:
130: // ### %set-class-direct-default-initargs
131: private static final Primitive2 _SET_CLASS_DIRECT_DEFAULT_INITARGS = new Primitive2(
132: "%set-class-direct-default-initargs", PACKAGE_SYS, false) {
133: public LispObject execute(LispObject first, LispObject second)
134: throws ConditionThrowable {
135: if (first instanceof StandardClass) {
136: ((StandardClass) first).directDefaultInitargs = second;
137: return second;
138: }
139: throw new ConditionThrowable(new TypeError(first,
140: "standard class"));
141: }
142: };
143:
144: // ### class-default-initargs
145: private static final Primitive1 CLASS_DEFAULT_INITARGS = new Primitive1(
146: "class-default-initargs", PACKAGE_SYS, false) {
147: public LispObject execute(LispObject arg)
148: throws ConditionThrowable {
149: if (arg instanceof StandardClass)
150: return ((StandardClass) arg).effectiveDefaultInitargs;
151: if (arg instanceof BuiltInClass)
152: return NIL;
153: throw new ConditionThrowable(new TypeError(arg,
154: "standard class"));
155: }
156: };
157:
158: // ### %set-class-default-initargs
159: private static final Primitive2 _SET_CLASS_DEFAULT_INITARGS = new Primitive2(
160: "%set-class-default-initargs", PACKAGE_SYS, false) {
161: public LispObject execute(LispObject first, LispObject second)
162: throws ConditionThrowable {
163: if (first instanceof StandardClass) {
164: ((StandardClass) first).effectiveDefaultInitargs = second;
165: return second;
166: }
167: throw new ConditionThrowable(new TypeError(first,
168: "standard class"));
169: }
170: };
171: }
|