KickJava   Java API By Example, From Geeks To Geeks.

Java > Open Source Codes > org > armedbear > lisp > Cons


1 /*
2  * Cons.java
3  *
4  * Copyright (C) 2002-2004 Peter Graves
5  * $Id: Cons.java,v 1.45 2004/08/21 18:09:06 piso Exp $
6  *
7  * This program is free software; you can redistribute it and/or
8  * modify it under the terms of the GNU General Public License
9  * as published by the Free Software Foundation; either version 2
10  * of the License, or (at your option) any later version.
11  *
12  * This program is distributed in the hope that it will be useful,
13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15  * GNU General Public License for more details.
16  *
17  * You should have received a copy of the GNU General Public License
18  * along with this program; if not, write to the Free Software
19  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
20  */

21
22 package org.armedbear.lisp;
23
24 public final class Cons extends LispObject
25 {
26     private LispObject car;
27     private LispObject cdr;
28
29     public Cons(LispObject car, LispObject cdr)
30     {
31         this.car = car;
32         this.cdr = cdr;
33         ++count;
34     }
35
36     public Cons(LispObject car)
37     {
38         this.car = car;
39         this.cdr = NIL;
40         ++count;
41     }
42
43     public Cons(String JavaDoc name, LispObject value)
44     {
45         this.car = new SimpleString(name);
46         this.cdr = value != null ? value : UNBOUND;
47         ++count;
48     }
49
50     public LispObject typeOf()
51     {
52         return Symbol.CONS;
53     }
54
55     public LispClass classOf()
56     {
57         return BuiltInClass.CONS;
58     }
59
60     public LispObject typep(LispObject typeSpecifier) throws ConditionThrowable
61     {
62         if (typeSpecifier == Symbol.LIST)
63             return T;
64         if (typeSpecifier == Symbol.CONS)
65             return T;
66         if (typeSpecifier == Symbol.SEQUENCE)
67             return T;
68         if (typeSpecifier == BuiltInClass.LIST)
69             return T;
70         if (typeSpecifier == BuiltInClass.CONS)
71             return T;
72         if (typeSpecifier == BuiltInClass.SEQUENCE)
73             return T;
74         if (typeSpecifier == Symbol.ATOM)
75             return NIL;
76         return super.typep(typeSpecifier);
77     }
78
79     public final boolean constantp()
80     {
81         if (car == Symbol.QUOTE) {
82             if (cdr instanceof Cons)
83                 if (((Cons)cdr).cdr == NIL)
84                     return true;
85         }
86         return false;
87     }
88
89     public LispObject ATOM()
90     {
91         return NIL;
92     }
93
94     public boolean atom()
95     {
96         return false;
97     }
98
99     public final LispObject car()
100     {
101         return car;
102     }
103
104     public final LispObject cdr()
105     {
106         return cdr;
107     }
108
109     public final void setCar(LispObject obj)
110     {
111         car = obj;
112     }
113
114     public LispObject RPLACA(LispObject obj) throws ConditionThrowable
115     {
116         car = obj;
117         return this;
118     }
119
120     public LispObject _RPLACA(LispObject obj) throws ConditionThrowable
121     {
122         car = obj;
123         return obj;
124     }
125
126     public final void setCdr(LispObject obj)
127     {
128         cdr = obj;
129     }
130
131     public LispObject RPLACD(LispObject obj) throws ConditionThrowable
132     {
133         cdr = obj;
134         return this;
135     }
136
137     public LispObject _RPLACD(LispObject obj) throws ConditionThrowable
138     {
139         cdr = obj;
140         return obj;
141     }
142
143     public final LispObject cadr() throws ConditionThrowable
144     {
145         return cdr.car();
146     }
147
148     public final LispObject cddr() throws ConditionThrowable
149     {
150         return cdr.cdr();
151     }
152
153     public final LispObject push(LispObject obj)
154     {
155         return new Cons(obj, this);
156     }
157
158     public final int sxhash() throws ConditionThrowable
159     {
160         return computeHash(this, 4);
161     }
162
163     private static final int computeHash(LispObject obj, int depth)
164         throws ConditionThrowable
165     {
166         if (obj instanceof Cons) {
167             if (depth > 0) {
168                 int n1 = computeHash(((Cons)obj).car, depth - 1);
169                 int n2 = computeHash(((Cons)obj).cdr, depth - 1);
170                 return n1 ^ n2;
171             } else {
172                 // This number comes from SBCL, but since we're not really
173
// using SBCL's SXHASH algorithm, it's probably not optimal.
174
// But who knows?
175
return 261835505;
176             }
177         } else
178             return obj.sxhash();
179     }
180
181     public final boolean equal(LispObject obj) throws ConditionThrowable
182     {
183         if (this == obj)
184             return true;
185         if (obj instanceof Cons) {
186             if (car.equal(((Cons)obj).car) && cdr.equal(((Cons)obj).cdr))
187                 return true;
188         }
189         return false;
190     }
191
192     public final boolean equalp(LispObject obj) throws ConditionThrowable
193     {
194         if (this == obj)
195             return true;
196         if (obj instanceof Cons) {
197             if (car.equalp(((Cons)obj).car) && cdr.equalp(((Cons)obj).cdr))
198                 return true;
199         }
200         return false;
201     }
202
203     public final int length() throws ConditionThrowable
204     {
205         int length = 0;
206         LispObject obj = this;
207         try {
208             while (obj != NIL) {
209                 ++length;
210                 obj = ((Cons)obj).cdr;
211             }
212         }
213         catch (ClassCastException JavaDoc e) {
214             signal(new TypeError(obj, Symbol.LIST));
215         }
216         return length;
217     }
218
219     public LispObject elt(int index) throws ConditionThrowable
220     {
221         if (index < 0) {
222             signal(new TypeError("ELT: invalid index " + index + " for " +
223                                  writeToString()));
224         }
225         int i = 0;
226         Cons cons = this;
227         try {
228             while (true) {
229                 if (i == index)
230                     return cons.car;
231                 cons = (Cons) cons.cdr;
232                 ++i;
233             }
234         }
235         catch (ClassCastException JavaDoc e) {
236             if (cons.cdr == NIL)
237                 signal(new TypeError("ELT: invalid index " + index + " for " +
238                                      writeToString()));
239             else
240                 signal(new TypeError(this, "proper sequence"));
241             // Not reached.
242
return NIL;
243         }
244     }
245
246     public final LispObject nreverse() throws ConditionThrowable
247     {
248         // Following code is adapted from CLISP.
249
if (cdr instanceof Cons) {
250             Cons cons = (Cons) cdr;
251             if (cons.cdr instanceof Cons) {
252                 Cons cons1 = cons;
253                 LispObject list = NIL;
254                 do {
255                     Cons h = (Cons) cons.cdr;
256                     cons.cdr = list;
257                     list = cons;
258                     cons = h;
259                 } while (cons.cdr instanceof Cons);
260                 cdr = list;
261                 cons1.cdr = cons;
262             }
263             LispObject h = car;
264             car = cons.car;
265             cons.car = h;
266         }
267         return this;
268     }
269
270     public final boolean listp()
271     {
272         return true;
273     }
274
275     public final LispObject LISTP()
276     {
277         return T;
278     }
279
280     public final boolean endp()
281     {
282         return false;
283     }
284
285     public final LispObject ENDP()
286     {
287         return NIL;
288     }
289
290     public final LispObject[] copyToArray() throws ConditionThrowable
291     {
292         final int length = length();
293         LispObject[] array = new LispObject[length];
294         LispObject rest = this;
295         for (int i = 0; i < length; i++) {
296             array[i] = rest.car();
297             rest = rest.cdr();
298         }
299         return array;
300     }
301
302     public String JavaDoc writeToString() throws ConditionThrowable
303     {
304         final LispObject printLength = _PRINT_LENGTH_.symbolValue();
305         final int limit;
306         if (printLength instanceof Fixnum)
307             limit = ((Fixnum)printLength).value;
308         else
309             limit = Integer.MAX_VALUE;
310         StringBuffer JavaDoc sb = new StringBuffer JavaDoc();
311         if (car == Symbol.QUOTE) {
312             if (cdr instanceof Cons) {
313                 // Not a dotted list.
314
if (cdr.cdr() == NIL) {
315                     sb.append('\'');
316                     sb.append(cdr.car().writeToString());
317                     return sb.toString();
318                 }
319             }
320         }
321         if (car == Symbol.FUNCTION) {
322             if (cdr instanceof Cons) {
323                 // Not a dotted list.
324
if (cdr.cdr() == NIL) {
325                     sb.append("#'");
326                     sb.append(cdr.car().writeToString());
327                     return sb.toString();
328                 }
329             }
330         }
331         int count = 0;
332         boolean truncated = false;
333         sb.append('(');
334         if (count < limit) {
335             LispObject p = this;
336             sb.append(p.car().writeToString());
337             ++count;
338             while ((p = p.cdr()) instanceof Cons) {
339                 if (count < limit) {
340                     sb.append(' ');
341                     sb.append(p.car().writeToString());
342                     ++count;
343                 } else {
344                     truncated = true;
345                     break;
346                 }
347             }
348             if (!truncated && p != NIL) {
349                 sb.append(" . ");
350                 sb.append(p.writeToString());
351             }
352         } else
353             truncated = true;
354         if (truncated)
355             sb.append(" ...");
356         sb.append(')');
357         return sb.toString();
358     }
359
360     // Statistics for TIME.
361
private static long count;
362
363     /*package*/ static long getCount()
364     {
365         return count;
366     }
367
368     /*package*/ static void setCount(long n)
369     {
370         count = n;
371     }
372 }
373
Popular Tags