001: /*
002: * Cons.java
003: *
004: * Copyright (C) 2002-2004 Peter Graves
005: * $Id: Cons.java,v 1.45 2004/08/21 18:09:06 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 Cons extends LispObject {
025: private LispObject car;
026: private LispObject cdr;
027:
028: public Cons(LispObject car, LispObject cdr) {
029: this .car = car;
030: this .cdr = cdr;
031: ++count;
032: }
033:
034: public Cons(LispObject car) {
035: this .car = car;
036: this .cdr = NIL;
037: ++count;
038: }
039:
040: public Cons(String name, LispObject value) {
041: this .car = new SimpleString(name);
042: this .cdr = value != null ? value : UNBOUND;
043: ++count;
044: }
045:
046: public LispObject typeOf() {
047: return Symbol.CONS;
048: }
049:
050: public LispClass classOf() {
051: return BuiltInClass.CONS;
052: }
053:
054: public LispObject typep(LispObject typeSpecifier)
055: throws ConditionThrowable {
056: if (typeSpecifier == Symbol.LIST)
057: return T;
058: if (typeSpecifier == Symbol.CONS)
059: return T;
060: if (typeSpecifier == Symbol.SEQUENCE)
061: return T;
062: if (typeSpecifier == BuiltInClass.LIST)
063: return T;
064: if (typeSpecifier == BuiltInClass.CONS)
065: return T;
066: if (typeSpecifier == BuiltInClass.SEQUENCE)
067: return T;
068: if (typeSpecifier == Symbol.ATOM)
069: return NIL;
070: return super .typep(typeSpecifier);
071: }
072:
073: public final boolean constantp() {
074: if (car == Symbol.QUOTE) {
075: if (cdr instanceof Cons)
076: if (((Cons) cdr).cdr == NIL)
077: return true;
078: }
079: return false;
080: }
081:
082: public LispObject ATOM() {
083: return NIL;
084: }
085:
086: public boolean atom() {
087: return false;
088: }
089:
090: public final LispObject car() {
091: return car;
092: }
093:
094: public final LispObject cdr() {
095: return cdr;
096: }
097:
098: public final void setCar(LispObject obj) {
099: car = obj;
100: }
101:
102: public LispObject RPLACA(LispObject obj) throws ConditionThrowable {
103: car = obj;
104: return this ;
105: }
106:
107: public LispObject _RPLACA(LispObject obj) throws ConditionThrowable {
108: car = obj;
109: return obj;
110: }
111:
112: public final void setCdr(LispObject obj) {
113: cdr = obj;
114: }
115:
116: public LispObject RPLACD(LispObject obj) throws ConditionThrowable {
117: cdr = obj;
118: return this ;
119: }
120:
121: public LispObject _RPLACD(LispObject obj) throws ConditionThrowable {
122: cdr = obj;
123: return obj;
124: }
125:
126: public final LispObject cadr() throws ConditionThrowable {
127: return cdr.car();
128: }
129:
130: public final LispObject cddr() throws ConditionThrowable {
131: return cdr.cdr();
132: }
133:
134: public final LispObject push(LispObject obj) {
135: return new Cons(obj, this );
136: }
137:
138: public final int sxhash() throws ConditionThrowable {
139: return computeHash(this , 4);
140: }
141:
142: private static final int computeHash(LispObject obj, int depth)
143: throws ConditionThrowable {
144: if (obj instanceof Cons) {
145: if (depth > 0) {
146: int n1 = computeHash(((Cons) obj).car, depth - 1);
147: int n2 = computeHash(((Cons) obj).cdr, depth - 1);
148: return n1 ^ n2;
149: } else {
150: // This number comes from SBCL, but since we're not really
151: // using SBCL's SXHASH algorithm, it's probably not optimal.
152: // But who knows?
153: return 261835505;
154: }
155: } else
156: return obj.sxhash();
157: }
158:
159: public final boolean equal(LispObject obj)
160: throws ConditionThrowable {
161: if (this == obj)
162: return true;
163: if (obj instanceof Cons) {
164: if (car.equal(((Cons) obj).car)
165: && cdr.equal(((Cons) obj).cdr))
166: return true;
167: }
168: return false;
169: }
170:
171: public final boolean equalp(LispObject obj)
172: throws ConditionThrowable {
173: if (this == obj)
174: return true;
175: if (obj instanceof Cons) {
176: if (car.equalp(((Cons) obj).car)
177: && cdr.equalp(((Cons) obj).cdr))
178: return true;
179: }
180: return false;
181: }
182:
183: public final int length() throws ConditionThrowable {
184: int length = 0;
185: LispObject obj = this ;
186: try {
187: while (obj != NIL) {
188: ++length;
189: obj = ((Cons) obj).cdr;
190: }
191: } catch (ClassCastException e) {
192: signal(new TypeError(obj, Symbol.LIST));
193: }
194: return length;
195: }
196:
197: public LispObject elt(int index) throws ConditionThrowable {
198: if (index < 0) {
199: signal(new TypeError("ELT: invalid index " + index
200: + " for " + writeToString()));
201: }
202: int i = 0;
203: Cons cons = this ;
204: try {
205: while (true) {
206: if (i == index)
207: return cons.car;
208: cons = (Cons) cons.cdr;
209: ++i;
210: }
211: } catch (ClassCastException e) {
212: if (cons.cdr == NIL)
213: signal(new TypeError("ELT: invalid index " + index
214: + " for " + writeToString()));
215: else
216: signal(new TypeError(this , "proper sequence"));
217: // Not reached.
218: return NIL;
219: }
220: }
221:
222: public final LispObject nreverse() throws ConditionThrowable {
223: // Following code is adapted from CLISP.
224: if (cdr instanceof Cons) {
225: Cons cons = (Cons) cdr;
226: if (cons.cdr instanceof Cons) {
227: Cons cons1 = cons;
228: LispObject list = NIL;
229: do {
230: Cons h = (Cons) cons.cdr;
231: cons.cdr = list;
232: list = cons;
233: cons = h;
234: } while (cons.cdr instanceof Cons);
235: cdr = list;
236: cons1.cdr = cons;
237: }
238: LispObject h = car;
239: car = cons.car;
240: cons.car = h;
241: }
242: return this ;
243: }
244:
245: public final boolean listp() {
246: return true;
247: }
248:
249: public final LispObject LISTP() {
250: return T;
251: }
252:
253: public final boolean endp() {
254: return false;
255: }
256:
257: public final LispObject ENDP() {
258: return NIL;
259: }
260:
261: public final LispObject[] copyToArray() throws ConditionThrowable {
262: final int length = length();
263: LispObject[] array = new LispObject[length];
264: LispObject rest = this ;
265: for (int i = 0; i < length; i++) {
266: array[i] = rest.car();
267: rest = rest.cdr();
268: }
269: return array;
270: }
271:
272: public String writeToString() throws ConditionThrowable {
273: final LispObject printLength = _PRINT_LENGTH_.symbolValue();
274: final int limit;
275: if (printLength instanceof Fixnum)
276: limit = ((Fixnum) printLength).value;
277: else
278: limit = Integer.MAX_VALUE;
279: StringBuffer sb = new StringBuffer();
280: if (car == Symbol.QUOTE) {
281: if (cdr instanceof Cons) {
282: // Not a dotted list.
283: if (cdr.cdr() == NIL) {
284: sb.append('\'');
285: sb.append(cdr.car().writeToString());
286: return sb.toString();
287: }
288: }
289: }
290: if (car == Symbol.FUNCTION) {
291: if (cdr instanceof Cons) {
292: // Not a dotted list.
293: if (cdr.cdr() == NIL) {
294: sb.append("#'");
295: sb.append(cdr.car().writeToString());
296: return sb.toString();
297: }
298: }
299: }
300: int count = 0;
301: boolean truncated = false;
302: sb.append('(');
303: if (count < limit) {
304: LispObject p = this ;
305: sb.append(p.car().writeToString());
306: ++count;
307: while ((p = p.cdr()) instanceof Cons) {
308: if (count < limit) {
309: sb.append(' ');
310: sb.append(p.car().writeToString());
311: ++count;
312: } else {
313: truncated = true;
314: break;
315: }
316: }
317: if (!truncated && p != NIL) {
318: sb.append(" . ");
319: sb.append(p.writeToString());
320: }
321: } else
322: truncated = true;
323: if (truncated)
324: sb.append(" ...");
325: sb.append(')');
326: return sb.toString();
327: }
328:
329: // Statistics for TIME.
330: private static long count;
331:
332: /*package*/static long getCount() {
333: return count;
334: }
335:
336: /*package*/static void setCount(long n) {
337: count = n;
338: }
339: }
|