1 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 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 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 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 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 return NIL; 243 } 244 } 245 246 public final LispObject nreverse() throws ConditionThrowable 247 { 248 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 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 sb = new StringBuffer (); 311 if (car == Symbol.QUOTE) { 312 if (cdr instanceof Cons) { 313 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 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 private static long count; 362 363 static long getCount() 364 { 365 return count; 366 } 367 368 static void setCount(long n) 369 { 370 count = n; 371 } 372 } 373 | Popular Tags |