fun.src (97156B)
1 # 31jul13abu 2 # (c) Software Lab. Alexander Burger 3 4 # Ersatz PicoLisp Functions 5 6 ############ main ############ 7 # (env ['lst] | ['sym 'val] ..) -> lst 8 env (i x y) 9 y = Nil; 10 if (!((ex = ex.Cdr) instanceof Cell)) { 11 for (Bind p = Break? Env.Bind.Link : Env.Bind; p != null; p = p.Link) { 12 if (p.Eswp == 0) { 13 for (i = p.Cnt; --i > 0; --i) { 14 for (x = y; ; x = x.Cdr) { 15 if (!(x instanceof Cell)) { 16 y = new Cell(new Cell(p.Data[i], p.Data[i].Car), y); 17 break; 18 } 19 if (x.Car.Car == p.Data[i]) 20 break; 21 } 22 } 23 } 24 } 25 } 26 else { 27 do { 28 if ((x = ex.Car.eval()) instanceof Cell) { 29 do 30 y = new Cell(x.Car instanceof Cell? new Cell(x.Car.Car, x.Car.Cdr) : new Cell(x.Car, x.Car.Car), y); 31 while ((x = x.Cdr) instanceof Cell); 32 } 33 else if (x != Nil) { 34 ex = ex.Cdr; 35 y = new Cell(new Cell(x, ex.Car.eval()), y); 36 } 37 } 38 while ((ex = ex.Cdr) instanceof Cell); 39 } 40 return y; 41 42 # (up [cnt] sym ['val]) -> any 43 up (i j k x) 44 if (!((x = (ex = ex.Cdr).Car) instanceof Number)) 45 k = 1; 46 else { 47 k = ((Number)x).Cnt; 48 ex = ex.Cdr; 49 x = ex.Car; 50 } 51 j = 0; 52 Bind q = null; 53 for (Bind p = Break? Env.Bind.Link : Env.Bind; p != null; p = p.Link) { 54 for (i = 0; i < p.Cnt; i += 2) { 55 if (p.Data[i+1] == x) { 56 if (--k == 0) { 57 if ((ex = ex.Cdr) instanceof Cell) 58 return p.Data[i] = ex.Car.eval(); 59 return p.Data[i]; 60 } 61 q = p; 62 } 63 } 64 } 65 if ((ex = ex.Cdr) instanceof Cell) 66 if (q == null) 67 x.Car = ex.Car.eval(); 68 else 69 q.Data[j] = ex.Car.eval(); 70 return q == null? x.Car : q.Data[j]; 71 72 # (sys 'any) -> sym 73 sys () 74 return mkStr(System.getenv(evString(ex.Cdr))); 75 76 # (quit ['any ['any]]) 77 quit (str) 78 str = evString(ex = ex.Cdr); 79 return err(null, (ex = ex.Cdr) instanceof Cell? ex.Car.eval() : null, str); 80 81 # (java 'cls 'T ['any ..]) -> obj 82 # (java 'cls 'msg ['any ..]) -> obj 83 # (java 'obj 'msg ['any ..]) -> obj 84 # (java 'obj ['cnt]) -> any 85 java (num i j k x y z s v o) 86 y = (x = ex.Cdr).Car.eval(); 87 if ((z = (x = x.Cdr).Car.eval()) == Nil || z instanceof Number) { 88 if ((s = (Symbol)y).Obj instanceof Boolean) 89 return ((Boolean)s.Obj).booleanValue()? T : Nil; 90 if (s.Obj instanceof Byte) 91 return new Number(((Byte)s.Obj).byteValue()); 92 if (s.Obj instanceof Character) 93 return new Number(((Character)s.Obj).charValue()); 94 if (s.Obj instanceof Integer) 95 return new Number(((Integer)s.Obj).intValue()); 96 if (s.Obj instanceof Long) 97 return new Number(((Long)s.Obj).longValue()); 98 if (s.Obj instanceof Float) 99 return strToNum(Float.toString(((Float)s.Obj).floatValue()), xInt(z)); 100 if (s.Obj instanceof Double) 101 return strToNum(Double.toString(((Double)s.Obj).doubleValue()), xInt(z)); 102 if (s.Obj instanceof BigInteger) 103 return new Number((BigInteger)s.Obj); 104 if (s.Obj instanceof String) 105 return mkStr((String)s.Obj); 106 x = Nil; 107 if (s.Obj instanceof byte[]) { 108 byte[] a = (byte[])s.Obj; 109 for (i = a.length; --i >= 0;) 110 x = new Cell(new Number(a[i]), x); 111 } 112 else if (s.Obj instanceof char[]) { 113 char[] a = (char[])s.Obj; 114 for (i = a.length; --i >= 0;) 115 x = new Cell(new Number(a[i]), x); 116 } 117 else if (s.Obj instanceof int[]) { 118 int[] a = (int[])s.Obj; 119 for (i = a.length; --i >= 0;) 120 x = new Cell(new Number(a[i]), x); 121 } 122 else if (s.Obj instanceof long[]) { 123 long[] a = (long[])s.Obj; 124 for (i = a.length; --i >= 0;) 125 x = new Cell(new Number(a[i]), x); 126 } 127 else if (s.Obj instanceof float[]) { 128 float[] a = (float[])s.Obj; 129 j = xInt(z); 130 for (i = a.length; --i >= 0;) 131 x = new Cell(strToNum(Float.toString(a[i]), i), x); 132 } 133 else if (s.Obj instanceof double[]) { 134 double[] a = (double[])s.Obj; 135 j = xInt(z); 136 for (i = a.length; --i >= 0;) 137 x = new Cell(strToNum(Double.toString(a[i]), i), x); 138 } 139 return x; 140 } 141 for (v = new Any[6], i = 0; (x = x.Cdr) instanceof Cell;) 142 v = append(v, i++, x.Car.eval()); 143 Object[] arg = new Object[i]; 144 Class[] par = new Class[i]; 145 while (--i >= 0) { 146 if (v[i] == Nil || v[i] == T) { 147 arg[i] = v[i] == T; 148 par[i] = Boolean.TYPE; 149 } 150 else if (v[i] instanceof Number) { 151 if ((num = (Number)v[i]).Big != null) 152 cntError(ex, num); 153 arg[i] = new Integer(num.Cnt); 154 par[i] = Integer.TYPE; 155 } 156 else if (v[i] instanceof Cell) { 157 k = (int)v[i].length(); 158 if (v[i].Car instanceof Number) { 159 arg[i] = new int[k]; 160 for (j = 0; j < k; ++j, v[i] = v[i].Cdr) 161 Array.setInt(arg[i], j, ((Number)v[i].Car).Cnt); 162 } 163 else if (v[i].Car instanceof Cell) 164 argError(ex, v[i]); 165 else if ((s = (Symbol)v[i].Car).Obj == null) { 166 arg[i] = Array.newInstance(s.Name.getClass(), k); 167 for (j = 0; j < k; ++j, v[i] = v[i].Cdr) 168 Array.set(arg[i], j, ((Symbol)v[i].Car).Name); 169 } 170 else { 171 if (s.Obj instanceof Byte) 172 arg[i] = Array.newInstance(Byte.TYPE, k); 173 else if (s.Obj instanceof Character) 174 arg[i] = Array.newInstance(Character.TYPE, k); 175 else if (s.Obj instanceof Integer) 176 arg[i] = Array.newInstance(Integer.TYPE, k); 177 else if (s.Obj instanceof Long) 178 arg[i] = Array.newInstance(Long.TYPE, k); 179 else if (s.Obj instanceof Float) 180 arg[i] = Array.newInstance(Float.TYPE, k); 181 else if (s.Obj instanceof Double) 182 arg[i] = Array.newInstance(Double.TYPE, k); 183 else 184 arg[i] = Array.newInstance(s.Obj.getClass(), k); 185 for (j = 0; j < k; ++j, v[i] = v[i].Cdr) 186 Array.set(arg[i], j, ((Symbol)v[i].Car).Obj); 187 } 188 par[i] = arg[i].getClass(); 189 } 190 else if ((s = (Symbol)v[i]).Obj == null) 191 par[i] = (arg[i] = s.Name).getClass(); 192 else { 193 arg[i] = s.Obj; 194 if (s.Obj instanceof Byte) 195 par[i] = Byte.TYPE; 196 else if (s.Obj instanceof Character) 197 par[i] = Character.TYPE; 198 else if (s.Obj instanceof Integer) 199 par[i] = Integer.TYPE; 200 else if (s.Obj instanceof Long) 201 par[i] = Long.TYPE; 202 else if (s.Obj instanceof Float) 203 par[i] = Float.TYPE; 204 else if (s.Obj instanceof Double) 205 par[i] = Double.TYPE; 206 else 207 par[i] = s.Obj.getClass(); 208 } 209 } 210 try { 211 if (z == T) 212 return new Symbol(javaConstructor(ex, java.lang.Class.forName(y.name()), par).newInstance(arg)); 213 Method m = javaMethod(ex, (s = (Symbol)y).Obj == null? java.lang.Class.forName(s.Name) : s.Obj.getClass(), z.name(), par); 214 o = m.invoke(s.Obj, arg); 215 if (m.getReturnType() == Void.TYPE) 216 return Nil; 217 return o == null? Nil : new Symbol(o); 218 } 219 catch (Exception e) {return err(ex, null, e.toString());} 220 221 # (public 'obj 'any ['any ..]) -> obj 222 # (public 'cls 'any ['any ..]) -> obj 223 public (x y z s o) 224 y = (x = ex.Cdr).Car.eval(); 225 z = (x = x.Cdr).Car.eval(); 226 try { 227 if ((s = (Symbol)y).Obj != null) 228 o = s.Obj.getClass().getField(z.name()).get(s.Obj); 229 else { 230 java.lang.Class cls = java.lang.Class.forName(s.Name); 231 o = cls.getField(z.name()).get(cls); 232 } 233 while ((x = x.Cdr) instanceof Cell) 234 o = o.getClass().getField(x.Car.eval().name()).get(o); 235 return new Symbol(o); 236 } 237 catch (Exception e) {return err(ex, null, e.toString());} 238 239 # (interface 'cls|lst 'sym 'fun ..) -> obj 240 interface (i x y) 241 y = (x = ex.Cdr).Car.eval(); 242 Class[] c = new Class[y instanceof Cell? (int)y.length() : 1]; 243 try { 244 if (y instanceof Cell) 245 for (i = 0; i < c.length; ++i, y = y.Cdr) 246 c[i] = java.lang.Class.forName(y.Car.name()); 247 else 248 c[0] = java.lang.Class.forName(y.name()); 249 } 250 catch (Exception e) {err(ex, null, e.toString());} 251 final HashMap<String,Any> act = new HashMap<String,Any>(); 252 while ((x = x.Cdr) instanceof Cell) { 253 y = x.Car.eval(); 254 act.put(y.name(), (x = x.Cdr).Car.eval()); 255 } 256 InvocationHandler h = new InvocationHandler() { 257 public Object invoke(Object o, Method m, Object[] arg) { 258 Any w; 259 if ((w = act.get(m.getName())) == null) 260 err(null, mkStr(m.getName()), "Can't invoke"); 261 if (arg == null) 262 return w.apply(null, false, null, 0); 263 else { 264 Any[] v = new Any[arg.length]; 265 v[0] = new Symbol(o); 266 for (int i = 0; i < arg.length; ++i) 267 v[i] = new Symbol(arg[i]); 268 return w.apply(null, false, v, v.length); 269 } 270 } 271 }; 272 return new Symbol(java.lang.reflect.Proxy.newProxyInstance(ClassLoader.getSystemClassLoader(), c, h)); 273 274 # (byte: 'num|sym) -> obj 275 byte: (x) 276 x = ex.Cdr.Car.eval(); 277 return new Symbol(new Byte(x instanceof Number? (byte)((Number)x).Cnt : (byte)x.name().charAt(0))); 278 279 # (char: 'num|sym) -> obj 280 char: (x) 281 x = ex.Cdr.Car.eval(); 282 return new Symbol(new Character(x instanceof Number? (char)((Number)x).Cnt : x.name().charAt(0))); 283 284 # (int: 'num) -> obj 285 int: () 286 return new Symbol(new Integer(evInt(ex.Cdr))); 287 288 # (long: 'num) -> obj 289 long: () 290 return new Symbol(new Long(evLong(ex.Cdr))); 291 292 # (float: 'str 'cnt) -> obj 293 # (float: 'num 'cnt) -> obj 294 float: (x) 295 if ((x = (ex = ex.Cdr).Car.eval()) instanceof Number) 296 return new Symbol(new Float(((Number)x).toString(evInt(ex.Cdr), '.', '\0'))); 297 return new Symbol(new Float(x.name())); 298 299 # (double: 'str 'cnt) -> obj 300 # (double: 'num 'cnt) -> obj 301 double: (x) 302 if ((x = (ex = ex.Cdr).Car.eval()) instanceof Number) 303 return new Symbol(new Double(((Number)x).toString(evInt(ex.Cdr), '.', '\0'))); 304 return new Symbol(new Double(x.name())); 305 306 # (big: 'num) -> obj 307 big: (num) 308 num = (Number)(ex.Cdr.Car.eval()); 309 return new Symbol(num.Big == null? big(num.Cnt) : num.Big); 310 311 # (args) -> flg 312 args T 313 return Env.Next < Env.ArgC? T : Nil; 314 315 # (next) -> any 316 next () 317 return Env.Next < Env.ArgC? (Env.Arg = Env.Args[Env.Next++]) : Nil; 318 319 # (arg ['cnt]) -> any 320 arg (i) 321 if (ex.Cdr instanceof Cell) 322 return (i = evInt(ex.Cdr)+Env.Next-1) >= 0 && i < Env.ArgC? Env.Args[i] : Nil; 323 return Env.Arg; 324 325 # (rest) -> lst 326 rest (i x) 327 for (x = Nil, i = Env.ArgC; --i >= Env.Next;) 328 x = new Cell(Env.Args[i], x); 329 return x; 330 331 # (date ['T]) -> dat 332 # (date 'dat) -> (y m d) 333 # (date 'y 'm 'd) -> dat | NIL 334 # (date '(y m d)) -> dat | NIL 335 date (i j x z) 336 if (!((x = ex.Cdr) instanceof Cell)) { 337 Cal = new GregorianCalendar(); 338 return date(Cal.get(Calendar.YEAR), Cal.get(Calendar.MONTH)+1, Cal.get(Calendar.DATE)); 339 } 340 if ((z = x.Car.eval()) == T) { 341 Cal = new GregorianCalendar(TimeZone.getTimeZone("GMT")); 342 return date(Cal.get(Calendar.YEAR), Cal.get(Calendar.MONTH)+1, Cal.get(Calendar.DATE)); 343 } 344 if (z == Nil) 345 return Nil; 346 if (z instanceof Cell) 347 return date(xInt(z.Car), xInt(z.Cdr.Car), xInt(z.Cdr.Cdr.Car)); 348 i = xInt(z); 349 if (!((x = x.Cdr) instanceof Cell)) 350 return date(i); 351 j = evInt(x); 352 return date(i, j, evInt(x.Cdr)); 353 354 # (time ['T]) -> tim 355 # (time 'tim) -> (h m s) 356 # (time 'h 'm ['s]) -> tim | NIL 357 # (time '(h m [s])) -> tim | NIL 358 time (i j x z) 359 if (!((x = ex.Cdr) instanceof Cell)) 360 return time(new GregorianCalendar()); 361 if ((z = x.Car.eval()) == T) 362 return time(Cal); 363 if (z == Nil) 364 return Nil; 365 if (z instanceof Cell) 366 return time(xInt(z.Car), xInt(z.Cdr.Car), z.Cdr.Cdr instanceof Cell? xInt(z.Cdr.Cdr.Car) : 0); 367 i = xInt(z); 368 if (!((x = x.Cdr) instanceof Cell)) 369 return new Cell(new Number(i / 3600), new Cell(new Number(i / 60 % 60), new Cell(new Number(i % 60), Nil))); 370 j = evInt(x); 371 return time(i, j, x.Cdr instanceof Cell? evInt(x.Cdr) : 0); 372 373 # (usec ['flg]) -> num 374 usec () 375 return new Number(ex.Cdr.Car.eval() == Nil? 376 System.nanoTime()/1000 - USec : 377 Cal.get(Calendar.MILLISECOND) * 1000 ); 378 379 # (pwd) -> sym 380 pwd T 381 return mkStr(System.getProperty("user.dir")); 382 383 # (info 'any) -> (cnt|T dat . tim) 384 info () 385 File f = new File(path(evString(ex.Cdr))); 386 if (!f.exists()) 387 return Nil; 388 Calendar c = new GregorianCalendar(TimeZone.getTimeZone("GMT")); 389 c.setTimeInMillis(f.lastModified()); 390 return 391 new Cell( 392 f.isDirectory()? T : new Number(f.length()), 393 new Cell( 394 date(c.get(Calendar.YEAR), c.get(Calendar.MONTH)+1, c.get(Calendar.DATE)), 395 time(c) ) ); 396 397 # (file) -> (sym1 sym2 . num) | NIL 398 file (i x) 399 if (InFile.Name == null) 400 return Nil; 401 x = new Number(InFile.Src); 402 if ((i = InFile.Name.lastIndexOf('/')) >= 0) 403 return new Cell(mkStr(InFile.Name.substring(0, i+1)), new Cell(mkStr(InFile.Name.substring(i+1)), x)); 404 return new Cell(mkStr("./"), new Cell(mkStr(InFile.Name), x)); 405 406 # (dir ['any] ['flg]) -> lst 407 dir (i x y str) 408 String[] lst = new File((str = evString(x = ex.Cdr)).length() == 0? "." : path(str)).list(); 409 x = x.Cdr.Car.eval(); 410 if (lst == null) 411 return Nil; 412 for (y = Nil, i = lst.length; --i >= 0;) 413 if (x != Nil || lst[i].charAt(0) != '.') 414 y = new Cell(mkStr(lst[i]), y); 415 return y; 416 417 # (argv [var ..] [. sym]) -> lst|sym 418 argv (i j x y) 419 i = Argv.length > 0 && Argv[0].equals("-")? 1 : 0; 420 if ((x = ex.Cdr) == Nil) { 421 if (i == Argv.length) 422 return Nil; 423 for (j = Argv.length; --j >= i;) 424 x = new Cell(mkStr(Argv[j]), x); 425 return x; 426 } 427 do { 428 if (!(x instanceof Cell)) { 429 if (i == Argv.length) 430 return x.Car = Nil; 431 for (y = Nil, j = Argv.length; --j >= i;) 432 y = new Cell(mkStr(Argv[j]), y); 433 return x.Car = y; 434 } 435 (y = x.Car).Car = i == Argv.length? Nil : mkStr(Argv[i++]); 436 } while ((x = x.Cdr) != Nil); 437 return y.Car; 438 439 # (opt) -> sym 440 opt (str) 441 return (str = opt()) == null? Nil : mkStr(str); 442 443 # (version ['flg]) -> lst 444 version (i x) 445 if (ex.Cdr.Car.eval() == Nil) { 446 for (i = 0; i < 4; ++i) 447 OutFile.Wr.print(Version[i] + (i == 3? " " : ".")); 448 OutFile.Wr.println("JVM"); 449 OutFile.Wr.flush(); 450 } 451 for (x = Nil, i = 4; --i >= 0;) 452 x = new Cell(new Number(Version[i]), x); 453 return x; 454 455 ############ gc ############ 456 # (gc) -> NIL 457 gc T 458 System.gc(); 459 return Nil; 460 461 ############ apply ############ 462 # (apply 'fun 'lst ['any ..]) -> any 463 apply (i w x y v) 464 w = (x = ex.Cdr).Car.eval(); 465 y = (x = x.Cdr).Car.eval(); 466 for (v = new Any[6], i = 0; (x = x.Cdr) instanceof Cell;) 467 v = append(v, i++, x.Car.eval()); 468 while (y instanceof Cell) { 469 v = append(v, i++, y.Car); 470 y = y.Cdr; 471 } 472 return w.apply(ex, false, v, i); 473 474 # (pass 'fun ['any ..]) -> any 475 pass (i j w x v) 476 w = (x = ex.Cdr).Car.eval(); 477 for (v = new Any[6], i = 0; (x = x.Cdr) instanceof Cell;) 478 v = append(v, i++, x.Car.eval()); 479 for (j = Env.Next; j < Env.ArgC; ++j) 480 v = append(v, i++, Env.Args[j]); 481 return w.apply(ex, false, v, i); 482 483 # (maps 'fun 'sym ['lst ..]) -> any 484 maps (i j k w x y s v) 485 w = (x = ex.Cdr).Car.eval(); 486 if ((y = (x = x.Cdr).Car.eval()) == Nil || (s = (Symbol)y).Prop == null) 487 return Nil; 488 v = new Any[6]; 489 i = 1; 490 append(v, 0, null); 491 while ((x = x.Cdr) instanceof Cell) 492 v = append(v, i++, x.Car.eval()); 493 k = s.Prop.length; 494 do 495 if ((x = s.Prop[--k]) != null) { 496 v[0] = new Cell(x,Nil); 497 x = w.apply(ex, true, v, i); 498 for (j = i; --j > 0;) 499 v[j] = v[j].Cdr; 500 } 501 while (k != 0); 502 return x; 503 504 # (map 'fun 'lst ..) -> lst 505 map (i j w x v) 506 w = (x = ex.Cdr).Car.eval(); 507 if ((x = x.Cdr) instanceof Cell) { 508 v = new Any[6]; 509 i = 0; 510 do 511 v = append(v, i++, x.Car.eval()); 512 while ((x = x.Cdr) instanceof Cell); 513 while (v[0] instanceof Cell) { 514 x = w.apply(ex, false, v, i); 515 for (j = i; --j >= 0;) 516 v[j] = v[j].Cdr; 517 } 518 } 519 return x; 520 521 # (mapc 'fun 'lst ..) -> any 522 mapc (i j w x v) 523 w = (x = ex.Cdr).Car.eval(); 524 if ((x = x.Cdr) instanceof Cell) { 525 v = new Any[6]; 526 i = 0; 527 do 528 v = append(v, i++, x.Car.eval()); 529 while ((x = x.Cdr) instanceof Cell); 530 while (v[0] instanceof Cell) { 531 x = w.apply(ex, true, v, i); 532 for (j = i; --j >= 0;) 533 v[j] = v[j].Cdr; 534 } 535 } 536 return x; 537 538 # (maplist 'fun 'lst ..) -> lst 539 maplist (i j w x z v) 540 w = (x = ex.Cdr).Car.eval(); 541 z = Nil; 542 if ((x = x.Cdr) instanceof Cell) { 543 v = new Any[6]; 544 i = 0; 545 do 546 v = append(v, i++, x.Car.eval()); 547 while ((x = x.Cdr) instanceof Cell); 548 if (!(v[0] instanceof Cell)) 549 return z; 550 z = x = new Cell(w.apply(ex, false, v, i), Nil); 551 while (v[0].Cdr instanceof Cell) { 552 for (j = i; --j >= 0;) 553 v[j] = v[j].Cdr; 554 x = x.Cdr = new Cell(w.apply(ex, false, v, i), Nil); 555 } 556 } 557 return z; 558 559 # (mapcar 'fun 'lst ..) -> lst 560 mapcar (i j w x z v) 561 w = (x = ex.Cdr).Car.eval(); 562 z = Nil; 563 if ((x = x.Cdr) instanceof Cell) { 564 v = new Any[6]; 565 i = 0; 566 do 567 v = append(v, i++, x.Car.eval()); 568 while ((x = x.Cdr) instanceof Cell); 569 if (!(v[0] instanceof Cell)) 570 return z; 571 z = x = new Cell(w.apply(ex, true, v, i), Nil); 572 while (v[0].Cdr instanceof Cell) { 573 for (j = i; --j >= 0;) 574 v[j] = v[j].Cdr; 575 x = x.Cdr = new Cell(w.apply(ex, true, v, i), Nil); 576 } 577 } 578 return z; 579 580 # (mapcon 'fun 'lst ..) -> lst 581 mapcon (i j w x z v) 582 w = (x = ex.Cdr).Car.eval(); 583 z = Nil; 584 if ((x = x.Cdr) instanceof Cell) { 585 v = new Any[6]; 586 i = 0; 587 do 588 v = append(v, i++, x.Car.eval()); 589 while ((x = x.Cdr) instanceof Cell); 590 if (!(v[0] instanceof Cell)) 591 return z; 592 while (!((x = w.apply(ex, false, v, i)) instanceof Cell)) { 593 if (!(v[0].Cdr instanceof Cell)) 594 return z; 595 for (j = i; --j >= 0;) 596 v[j] = v[j].Cdr; 597 } 598 z = x; 599 while (v[0].Cdr instanceof Cell) { 600 for (j = i; --j >= 0;) 601 v[j] = v[j].Cdr; 602 while (x.Cdr instanceof Cell) 603 x = x.Cdr; 604 x.Cdr = w.apply(ex, false, v, i); 605 } 606 } 607 return z; 608 609 # (mapcan 'fun 'lst ..) -> lst 610 mapcan (i j w x z v) 611 w = (x = ex.Cdr).Car.eval(); 612 z = Nil; 613 if ((x = x.Cdr) instanceof Cell) { 614 v = new Any[6]; 615 i = 0; 616 do 617 v = append(v, i++, x.Car.eval()); 618 while ((x = x.Cdr) instanceof Cell); 619 if (!(v[0] instanceof Cell)) 620 return z; 621 while (!((x = w.apply(ex, true, v, i)) instanceof Cell)) { 622 if (!(v[0].Cdr instanceof Cell)) 623 return z; 624 for (j = i; --j >= 0;) 625 v[j] = v[j].Cdr; 626 } 627 z = x; 628 while (v[0].Cdr instanceof Cell) { 629 for (j = i; --j >= 0;) 630 v[j] = v[j].Cdr; 631 while (x.Cdr instanceof Cell) 632 x = x.Cdr; 633 x.Cdr = w.apply(ex, true, v, i); 634 } 635 } 636 return z; 637 638 # (filter 'fun 'lst ..) -> lst 639 filter (i j w x z v) 640 w = (x = ex.Cdr).Car.eval(); 641 z = Nil; 642 if ((x = x.Cdr) instanceof Cell) { 643 v = new Any[6]; 644 i = 0; 645 do 646 v = append(v, i++, x.Car.eval()); 647 while ((x = x.Cdr) instanceof Cell); 648 if (!(v[0] instanceof Cell)) 649 return z; 650 while (w.apply(ex, true, v, i) == Nil) { 651 if (!(v[0].Cdr instanceof Cell)) 652 return z; 653 for (j = i; --j >= 0;) 654 v[j] = v[j].Cdr; 655 } 656 z = x = new Cell(v[0].Car, Nil); 657 while (v[0].Cdr instanceof Cell) { 658 for (j = i; --j >= 0;) 659 v[j] = v[j].Cdr; 660 if (w.apply(ex, true, v, i) != Nil) 661 x = x.Cdr = new Cell(v[0].Car, Nil); 662 } 663 } 664 return z; 665 666 # (extract 'fun 'lst ..) -> lst 667 extract (i j w x y z v) 668 w = (x = ex.Cdr).Car.eval(); 669 z = Nil; 670 if ((x = x.Cdr) instanceof Cell) { 671 v = new Any[6]; 672 i = 0; 673 do 674 v = append(v, i++, x.Car.eval()); 675 while ((x = x.Cdr) instanceof Cell); 676 if (!(v[0] instanceof Cell)) 677 return z; 678 while ((y = w.apply(ex, true, v, i)) == Nil) { 679 if (!(v[0].Cdr instanceof Cell)) 680 return z; 681 for (j = i; --j >= 0;) 682 v[j] = v[j].Cdr; 683 } 684 z = x = new Cell(y, Nil); 685 while (v[0].Cdr instanceof Cell) { 686 for (j = i; --j >= 0;) 687 v[j] = v[j].Cdr; 688 if ((y = w.apply(ex, true, v, i)) != Nil) 689 x = x.Cdr = new Cell(y, Nil); 690 } 691 } 692 return z; 693 694 # (seek 'fun 'lst ..) -> lst 695 seek (i j w x v) 696 w = (x = ex.Cdr).Car.eval(); 697 if ((x = x.Cdr) instanceof Cell) { 698 v = new Any[6]; 699 i = 0; 700 do 701 v = append(v, i++, x.Car.eval()); 702 while ((x = x.Cdr) instanceof Cell); 703 while (v[0] instanceof Cell) { 704 if (w.apply(ex, false, v, i) != Nil) 705 return v[0]; 706 for (j = i; --j >= 0;) 707 v[j] = v[j].Cdr; 708 } 709 } 710 return Nil; 711 712 # (find 'fun 'lst ..) -> any 713 find (i j w x v) 714 w = (x = ex.Cdr).Car.eval(); 715 if ((x = x.Cdr) instanceof Cell) { 716 v = new Any[6]; 717 i = 0; 718 do 719 v = append(v, i++, x.Car.eval()); 720 while ((x = x.Cdr) instanceof Cell); 721 while (v[0] instanceof Cell) { 722 if (w.apply(ex, true, v, i) != Nil) 723 return v[0].Car; 724 for (j = i; --j >= 0;) 725 v[j] = v[j].Cdr; 726 } 727 } 728 return Nil; 729 730 # (pick 'fun 'lst ..) -> any 731 pick (i j w x v) 732 w = (x = ex.Cdr).Car.eval(); 733 if ((x = x.Cdr) instanceof Cell) { 734 v = new Any[6]; 735 i = 0; 736 do 737 v = append(v, i++, x.Car.eval()); 738 while ((x = x.Cdr) instanceof Cell); 739 while (v[0] instanceof Cell) { 740 if ((x = w.apply(ex, true, v, i)) != Nil) 741 return x; 742 for (j = i; --j >= 0;) 743 v[j] = v[j].Cdr; 744 } 745 } 746 return Nil; 747 748 # (cnt 'fun 'lst ..) -> cnt 749 cnt (i j n w x v) 750 w = (x = ex.Cdr).Car.eval(); 751 n = 0; 752 if ((x = x.Cdr) instanceof Cell) { 753 v = new Any[6]; 754 i = 0; 755 do 756 v = append(v, i++, x.Car.eval()); 757 while ((x = x.Cdr) instanceof Cell); 758 while (v[0] instanceof Cell) { 759 if (w.apply(ex, true, v, i) != Nil) 760 ++n; 761 for (j = i; --j >= 0;) 762 v[j] = v[j].Cdr; 763 } 764 } 765 return new Number(n); 766 767 # (sum 'fun 'lst ..) -> num 768 sum (num i j w x y v) 769 w = (x = ex.Cdr).Car.eval(); 770 num = Zero; 771 if ((x = x.Cdr) instanceof Cell) { 772 v = new Any[6]; 773 i = 0; 774 do 775 v = append(v, i++, x.Car.eval()); 776 while ((x = x.Cdr) instanceof Cell); 777 while (v[0] instanceof Cell) { 778 if ((y = w.apply(ex, true, v, i)) instanceof Number) 779 num = num.add((Number)y); 780 for (j = i; --j >= 0;) 781 v[j] = v[j].Cdr; 782 } 783 } 784 return num; 785 786 # (maxi 'fun 'lst ..) -> any 787 maxi (i j w x y z v) 788 w = (x = ex.Cdr).Car.eval(); 789 y = z = Nil; 790 if ((x = x.Cdr) instanceof Cell) { 791 v = new Any[6]; 792 i = 0; 793 do 794 v = append(v, i++, x.Car.eval()); 795 while ((x = x.Cdr) instanceof Cell); 796 while (v[0] instanceof Cell) { 797 if ((x = w.apply(ex, true, v, i)).compare(y) > 0) { 798 z = v[0].Car; 799 y = x; 800 } 801 for (j = i; --j >= 0;) 802 v[j] = v[j].Cdr; 803 } 804 } 805 return z; 806 807 # (mini 'fun 'lst ..) -> any 808 mini (i j w x y z v) 809 w = (x = ex.Cdr).Car.eval(); 810 y = T; 811 z = Nil; 812 if ((x = x.Cdr) instanceof Cell) { 813 v = new Any[6]; 814 i = 0; 815 do 816 v = append(v, i++, x.Car.eval()); 817 while ((x = x.Cdr) instanceof Cell); 818 while (v[0] instanceof Cell) { 819 if ((x = w.apply(ex, true, v, i)).compare(y) < 0) { 820 z = v[0].Car; 821 y = x; 822 } 823 for (j = i; --j >= 0;) 824 v[j] = v[j].Cdr; 825 } 826 } 827 return z; 828 829 # (fish 'fun 'any) -> lst 830 fish (w v) 831 w = ex.Cdr.Car.eval(); 832 (v = new Any[1])[0] = ex.Cdr.Cdr.Car.eval(); 833 return fish(ex, w, v, Nil); 834 835 # (by 'fun1 'fun2 'lst ..) -> lst 836 by (i j w x y z v) 837 w = (x = ex.Cdr).Car.eval(); 838 y = (x = x.Cdr).Car.eval(); 839 z = Nil; 840 if ((x = x.Cdr) instanceof Cell) { 841 v = new Any[6]; 842 i = 0; 843 do 844 v = append(v, i++, x.Car.eval()); 845 while ((x = x.Cdr) instanceof Cell); 846 z = x = new Cell(new Cell(w.apply(ex, true, v, i), v[0].Car), Nil); 847 while (v[0].Cdr instanceof Cell) { 848 for (j = i; --j >= 0;) 849 v[j] = v[j].Cdr; 850 x = x.Cdr = new Cell(new Cell(w.apply(ex, true, v, i), v[0].Car), Nil); 851 } 852 v[0] = z; 853 z = y.apply(ex, false, v, 1); 854 for (x = z; x instanceof Cell; x = x.Cdr) 855 x.Car = x.Car.Cdr; 856 } 857 return z; 858 859 ############ flow ############ 860 # (as 'any1 . any2) -> any2 | NIL 861 as () 862 return ex.Cdr.Car.eval() == Nil? Nil : ex.Cdr.Cdr; 863 864 # (lit 'any) -> any 865 lit (x) 866 return (x = ex.Cdr.Car.eval()) instanceof Number || x == Nil || x == T || x instanceof Cell && x.Car instanceof Number? x : new Cell(Quote, x); 867 868 # (eval 'any ['cnt ['lst]]) -> any 869 eval (y) 870 if ((y = (ex = ex.Cdr).Car.eval()) instanceof Number) 871 return y; 872 if (ex.Cdr == Nil || Env.Bind == null) 873 return y.eval(); 874 return evRun(true, y, evInt(ex.Cdr), ex.Cdr.Cdr.Car.eval()); 875 876 # (run 'any ['cnt ['lst]]) -> any 877 run (y) 878 if ((y = (ex = ex.Cdr).Car.eval()) instanceof Number) 879 return y; 880 if (ex.Cdr == Nil || Env.Bind == null) 881 return y.run(); 882 return evRun(false, y, evInt(ex.Cdr), ex.Cdr.Cdr.Car.eval()); 883 884 # (def 'sym 'any) -> sym 885 # (def 'sym 'sym 'any) -> sym 886 def (w x y s) 887 s = (Symbol)(ex = ex.Cdr).Car.eval(); 888 x = (ex = ex.Cdr).Car.eval(); 889 if (ex.Cdr == Nil) { 890 if (s.Car != Nil && s.Car != s && !x.equal(s.Car)) 891 redefMsg(s, null); 892 s.Car = x; 893 putSrc(s, null); 894 } 895 else { 896 y = ex.Cdr.Car.eval(); 897 if ((w = s.get(x)) != Nil && !x.equal(w)) 898 redefMsg(s,x); 899 s.put(x,y); 900 putSrc(s,x); 901 } 902 return s; 903 904 # (de sym . any) -> sym 905 de () 906 ex = ex.Cdr; 907 redefine((Symbol)ex.Car, ex.Cdr); 908 return ex.Car; 909 910 # (dm sym . fun|cls2) -> sym 911 # (dm (sym . cls) . fun|cls2) -> sym 912 # (dm (sym sym2 [. cls]) . fun|cls2) -> sym 913 dm (x y s t) 914 if (!((x = ex.Cdr).Car instanceof Cell)) { 915 s = (Symbol)x.Car; 916 t = (Symbol)Class.Car; 917 } 918 else { 919 s = (Symbol)x.Car.Car; 920 t = (Symbol) 921 (!((y = x.Car).Cdr instanceof Cell)? 922 y.Cdr : 923 (y.Cdr.Cdr == Nil? Class.Car : y.Cdr.Cdr).get(y.Cdr.Car) ); 924 } 925 if (s != T) 926 redefine(s, Meth.Car); 927 if (x.Cdr instanceof Symbol) { 928 y = x.Cdr.Car; 929 for (;;) { 930 if (!(y instanceof Cell) || !(y.Car instanceof Cell)) 931 err(ex, s, "Bad message"); 932 if (y.Car.Car == s) { 933 x = y.Car; 934 break; 935 } 936 y = y.Cdr; 937 } 938 } 939 for (y = t.Car; y instanceof Cell && y.Car instanceof Cell; y = y.Cdr) 940 if (y.Car.Car == s) { 941 if (!x.Cdr.equal(y.Cdr.Car)) 942 redefMsg(s, t); 943 y.Car.Cdr = x.Cdr; 944 putSrc(t, s); 945 return s; 946 } 947 t.Car = x.Car instanceof Cell? 948 new Cell(new Cell(s, x.Cdr), t.Car) : 949 new Cell(x, t.Car); 950 putSrc(t, s); 951 return s; 952 953 # (box 'any) -> sym 954 box () 955 return mkSymbol(ex.Cdr.Car.eval()); 956 957 # (new ['typ ['any ..]]) -> obj 958 new (x s) 959 s = mkSymbol((ex = ex.Cdr).Car.eval()); 960 TheKey = T; TheCls = null; 961 if ((x = method(s)) != null) 962 evMethod(s, x, ex.Cdr); 963 else { 964 while ((ex = ex.Cdr) != Nil) { 965 x = ex.Car.eval(); 966 s.put(x, (ex = ex.Cdr).Car.eval()); 967 } 968 } 969 return s; 970 971 # (type 'any) -> lst 972 type (x y z) 973 if ((x = ex.Cdr.Car.eval()) instanceof Symbol) { 974 z = x = x.Car; 975 while (x instanceof Cell) { 976 if (!(x.Car instanceof Cell)) { 977 y = x; 978 while (x.Car instanceof Symbol) { 979 if (!((x = x.Cdr) instanceof Cell)) 980 return x == Nil? y : Nil; 981 if (z == x) 982 return Nil; 983 } 984 return Nil; 985 } 986 if (z == (x = x.Cdr)) 987 return Nil; 988 } 989 } 990 return Nil; 991 992 # (isa 'cls|typ 'any) -> obj | NIL 993 isa (x y) 994 x = (ex = ex.Cdr).Car.eval(); 995 if ((y = ex.Cdr.Car.eval()) instanceof Symbol) { 996 if (x instanceof Symbol) 997 return isa(x,y)? y : Nil; 998 while (x instanceof Cell) { 999 if (!isa(x.Car, y)) 1000 return Nil; 1001 x = x.Cdr; 1002 } 1003 return y; 1004 } 1005 return Nil; 1006 1007 # (method 'msg 'obj) -> fun 1008 method (x y) 1009 x = (ex = ex.Cdr).Car.eval(); 1010 y = ex.Cdr.Car.eval(); 1011 TheKey = x; 1012 return (x = method(y)) == null? Nil : x; 1013 1014 # (send 'msg 'obj ['any ..]) -> any 1015 send (x y z) 1016 y = (x = ex.Cdr).Car.eval(); 1017 z = (x = x.Cdr).Car.eval(); 1018 TheKey = y; TheCls = null; 1019 if ((y = method(z)) == null) 1020 err(ex, TheKey, "Bad message"); 1021 return evMethod(z, y, x.Cdr); 1022 1023 # (try 'msg 'obj ['any ..]) -> any 1024 try (x y) 1025 x = (ex = ex.Cdr).Car.eval(); 1026 if ((y = (ex = ex.Cdr).Car.eval()) instanceof Symbol) { 1027 TheKey = x; TheCls = null; 1028 if ((x = method(y)) != null) 1029 return evMethod(y, x, ex.Cdr); 1030 } 1031 return Nil; 1032 1033 # (super ['any ..]) -> any 1034 super (w x y z) 1035 TheKey = Env.Key; 1036 x = Env.Cls == null? This.Car : Env.Cls.Car.Car; 1037 while (x.Car instanceof Cell) 1038 x = x.Cdr; 1039 for (;;) { 1040 if (!(x instanceof Cell)) 1041 err(ex, TheKey, "Bad super"); 1042 if ((y = method((TheCls = x).Car)) != null) { 1043 z = Env.Cls; Env.Cls = TheCls; 1044 w = Env.Key; Env.Key = TheKey; 1045 x = y.func(ex); 1046 Env.Key = w; Env.Cls = z; 1047 return x; 1048 } 1049 x = x.Cdr; 1050 } 1051 1052 # (extra ['any ..]) -> any 1053 extra (x y z) 1054 TheKey = Env.Key; 1055 if ((x = extra(This.Car)) == null || x == T) 1056 err(ex, TheKey, "Bad extra"); 1057 y = Env.Cls; Env.Cls = TheCls; 1058 z = Env.Key; Env.Key = TheKey; 1059 x = x.func(ex); 1060 Env.Key = z; Env.Cls = y; 1061 return x; 1062 1063 # (with 'sym . prg) -> any 1064 with (x bnd) 1065 if ((x = ex.Cdr.Car.eval()) != Nil) { 1066 (bnd = new Bind()).add(This.Car); 1067 bnd.add(This); 1068 This.Car = x; 1069 Env.Bind = bnd; 1070 x = ex.Cdr.Cdr.prog(); 1071 This.Car = bnd.Data[0]; 1072 } 1073 return x; 1074 1075 # (bind 'sym|lst . prg) -> any 1076 bind (i x y z bnd) 1077 if ((y = (x = ex.Cdr).Car.eval()) == Nil) 1078 return x.Cdr.prog(); 1079 bnd = new Bind(); 1080 if (y instanceof Symbol) { 1081 bnd.add(y.Car); 1082 bnd.add(y); 1083 } 1084 else { 1085 do { 1086 if (y.Car instanceof Symbol) { 1087 bnd.add(y.Car.Car); 1088 bnd.add(y.Car); 1089 } 1090 else { 1091 z = y.Car.Car; 1092 bnd.add(z.Car); 1093 bnd.add(z); 1094 z.Car = y.Car.Cdr; 1095 } 1096 } while ((y = y.Cdr) instanceof Cell); 1097 } 1098 Env.Bind = bnd; 1099 x = x.Cdr.prog(); 1100 for (i = bnd.Cnt; (i -= 2) >= 0;) 1101 bnd.Data[i+1].Car = bnd.Data[i]; 1102 Env.Bind = bnd.Link; 1103 return x; 1104 1105 # (job 'lst . prg) -> any 1106 job (i w x y z bnd) 1107 bnd = new Bind(); 1108 for (z = y = (x = ex.Cdr).Car.eval(); y instanceof Cell; y = y.Cdr) { 1109 w = y.Car.Car; 1110 bnd.add(w.Car); 1111 bnd.add(w); 1112 w.Car = y.Car.Cdr; 1113 } 1114 Env.Bind = bnd; 1115 x = x.Cdr.prog(); 1116 for (i = 0; z instanceof Cell; i += 2, z = z.Cdr) { 1117 w = z.Car.Car; 1118 z.Car.Cdr = w.Car; 1119 w.Car = bnd.Data[i]; 1120 } 1121 Env.Bind = bnd.Link; 1122 return x; 1123 1124 # (let sym 'any . prg) -> any 1125 # (let (sym 'any ..) . prg) -> any 1126 let (i x y z bnd) 1127 bnd = new Bind(); 1128 if ((y = (x = ex.Cdr).Car) instanceof Symbol) { 1129 bnd.add(y.Car); 1130 bnd.add(y); 1131 y.Car = (x = x.Cdr).Car.eval(); 1132 } 1133 else { 1134 do { 1135 z = y.Car; 1136 bnd.add(z.Car); 1137 bnd.add(z); 1138 z.Car = (y = y.Cdr).Car.eval(); 1139 } while ((y = y.Cdr) instanceof Cell); 1140 } 1141 Env.Bind = bnd; 1142 x = x.Cdr.prog(); 1143 for (i = bnd.Cnt; (i -= 2) >= 0;) 1144 bnd.Data[i+1].Car = bnd.Data[i]; 1145 Env.Bind = bnd.Link; 1146 return x; 1147 1148 # (let? sym 'any . prg) -> any 1149 let? (x y z bnd) 1150 z = (x = ex.Cdr).Car; 1151 if ((y = (x = x.Cdr).Car.eval()) != Nil) { 1152 (bnd = new Bind()).add(z.Car); 1153 bnd.add(z); 1154 z.Car = y; 1155 Env.Bind = bnd; 1156 y = x.Cdr.prog(); 1157 z.Car = bnd.Data[0]; 1158 } 1159 return y; 1160 1161 # (use sym . prg) -> any 1162 # (use (sym ..) . prg) -> any 1163 use (i x y bnd) 1164 bnd = new Bind(); 1165 if ((y = (x = ex.Cdr).Car) instanceof Symbol) { 1166 bnd.add(y.Car); 1167 bnd.add(y); 1168 } 1169 else { 1170 do { 1171 bnd.add(y.Car.Car); 1172 bnd.add(y.Car); 1173 } while ((y = y.Cdr) instanceof Cell); 1174 } 1175 Env.Bind = bnd; 1176 x = x.Cdr.prog(); 1177 for (i = bnd.Cnt; (i -= 2) >= 0;) 1178 bnd.Data[i+1].Car = bnd.Data[i]; 1179 Env.Bind = bnd.Link; 1180 return x; 1181 1182 # (and 'any ..) -> any 1183 and (w) 1184 ex = ex.Cdr; 1185 do { 1186 if ((w = ex.Car.eval()) == Nil) 1187 return Nil; 1188 At.Car = w; 1189 } while ((ex = ex.Cdr) instanceof Cell); 1190 return w; 1191 1192 # (or 'any ..) -> any 1193 or (w) 1194 ex = ex.Cdr; 1195 do 1196 if ((w = ex.Car.eval()) != Nil) 1197 return At.Car = w; 1198 while ((ex = ex.Cdr) instanceof Cell); 1199 return Nil; 1200 1201 # (nand 'any ..) -> flg 1202 nand (w) 1203 ex = ex.Cdr; 1204 do { 1205 if ((w = ex.Car.eval()) == Nil) 1206 return T; 1207 At.Car = w; 1208 } while ((ex = ex.Cdr) instanceof Cell); 1209 return Nil; 1210 1211 # (nor 'any ..) -> flg 1212 nor (w) 1213 ex = ex.Cdr; 1214 do 1215 if ((w = ex.Car.eval()) != Nil) { 1216 At.Car = w; 1217 return Nil; 1218 } 1219 while ((ex = ex.Cdr) instanceof Cell); 1220 return T; 1221 1222 # (xor 'any 'any) -> flg 1223 xor (x y) 1224 y = (x = ex.Cdr).Car.eval(); 1225 x = x.Cdr.Car.eval(); 1226 return y == Nil ^ x == Nil? T : Nil; 1227 1228 # (bool 'any) -> flg 1229 bool T 1230 return ex.Cdr.Car.eval() == Nil? Nil : T; 1231 1232 # (not 'any) -> flg 1233 not (w) 1234 if ((w = ex.Cdr.Car.eval()) == Nil) 1235 return T; 1236 At.Car = w; 1237 return Nil; 1238 1239 # (nil . prg) -> NIL 1240 nil () 1241 ex.Cdr.prog(); 1242 return Nil; 1243 1244 # (t . prg) -> T 1245 t () 1246 ex.Cdr.prog(); 1247 return T; 1248 1249 # (prog . prg) -> any 1250 prog T 1251 return ex.Cdr.prog(); 1252 1253 # (prog1 'any1 . prg) -> any1 1254 prog1 (w) 1255 w = At.Car = ex.Cdr.Car.eval(); 1256 ex.Cdr.Cdr.prog(); 1257 return w; 1258 1259 # (prog2 'any1 'any2 . prg) -> any2 1260 prog2 (w) 1261 (ex = ex.Cdr).Car.eval(); 1262 w = At.Car = (ex = ex.Cdr).Car.eval(); 1263 ex.Cdr.prog(); 1264 return w; 1265 1266 # (if 'any1 'any2 . prg) -> any 1267 if (w) 1268 if ((w = (ex = ex.Cdr).Car.eval()) == Nil) 1269 return ex.Cdr.Cdr.prog(); 1270 At.Car = w; 1271 return ex.Cdr.Car.eval(); 1272 1273 # (if2 'any1 'any2 'any3 'any4 'any5 . prg) -> any 1274 if2 (w) 1275 if ((w = (ex = ex.Cdr).Car.eval()) == Nil) { 1276 if ((w = (ex = ex.Cdr).Car.eval()) == Nil) 1277 return ex.Cdr.Cdr.Cdr.Cdr.prog(); 1278 At.Car = w; 1279 return ex.Cdr.Cdr.Cdr.Car.eval(); 1280 } 1281 At.Car = w; 1282 if ((w = (ex = ex.Cdr).Car.eval()) == Nil) 1283 return ex.Cdr.Cdr.Car.eval(); 1284 At.Car = w; 1285 return ex.Cdr.Car.eval(); 1286 1287 # (ifn 'any1 'any2 . prg) -> any 1288 ifn (w) 1289 if ((w = (ex = ex.Cdr).Car.eval()) != Nil) { 1290 At.Car = w; 1291 return ex.Cdr.Cdr.prog(); 1292 } 1293 return ex.Cdr.Car.eval(); 1294 1295 # (when 'any . prg) -> any 1296 when (w) 1297 if ((w = (ex = ex.Cdr).Car.eval()) == Nil) 1298 return Nil; 1299 At.Car = w; 1300 return ex.Cdr.prog(); 1301 1302 # (unless 'any . prg) -> any 1303 unless (w) 1304 if ((w = (ex = ex.Cdr).Car.eval()) != Nil) 1305 return Nil; 1306 At.Car = w; 1307 return ex.Cdr.prog(); 1308 1309 # (cond ('any1 . prg1) ('any2 . prg2) ..) -> any 1310 cond (w) 1311 while ((ex = ex.Cdr) instanceof Cell) 1312 if ((w = ex.Car.Car.eval()) != Nil) { 1313 At.Car = w; 1314 return ex.Car.Cdr.prog(); 1315 } 1316 return Nil; 1317 1318 # (nond ('any1 . prg1) ('any2 . prg2) ..) -> any 1319 nond (w) 1320 while ((ex = ex.Cdr) instanceof Cell) { 1321 if ((w = ex.Car.Car.eval()) == Nil) 1322 return ex.Car.Cdr.prog(); 1323 At.Car = w; 1324 } 1325 return Nil; 1326 1327 # (case 'any (any1 . prg1) (any2 . prg2) ..) -> any 1328 case (x y) 1329 At.Car = (ex = ex.Cdr).Car.eval(); 1330 while ((ex = ex.Cdr) instanceof Cell) { 1331 x = ex.Car; y = x.Car; 1332 if (y == T || At.Car.equal(y)) 1333 return x.Cdr.prog(); 1334 if (y instanceof Cell) { 1335 do 1336 if (At.Car.equal(y.Car)) 1337 return x.Cdr.prog(); 1338 while ((y = y.Cdr) instanceof Cell); 1339 } 1340 } 1341 return Nil; 1342 1343 # (casq 'any (any1 . prg1) (any2 . prg2) ..) -> any 1344 casq (x y) 1345 At.Car = (ex = ex.Cdr).Car.eval(); 1346 while ((ex = ex.Cdr) instanceof Cell) { 1347 x = ex.Car; y = x.Car; 1348 if (y == T || y == At.Car) 1349 return x.Cdr.prog(); 1350 if (y instanceof Cell) { 1351 do 1352 if (y.Car == At.Car) 1353 return x.Cdr.prog(); 1354 while ((y = y.Cdr) instanceof Cell); 1355 } 1356 } 1357 return Nil; 1358 1359 # (state 'var (sym|lst exe [. prg]) ..) -> any 1360 state (w x y z) 1361 z = (x = ex.Cdr).Car.eval(); 1362 while ((x = x.Cdr) instanceof Cell) { 1363 y = x.Car; 1364 if (y.Car == T || memq(z.Car, y.Car) != null) { 1365 y = y.Cdr; 1366 if ((w = y.Car.eval()) != Nil) { 1367 At.Car = z.Car = w; 1368 return y.Cdr.prog(); 1369 } 1370 } 1371 } 1372 return Nil; 1373 1374 # (while 'any . prg) -> any 1375 while (w x y) 1376 x = (ex = ex.Cdr).Car; 1377 ex = ex.Cdr; 1378 y = Nil; 1379 while ((w = x.eval()) != Nil) { 1380 At.Car = w; 1381 y = ex.prog(); 1382 } 1383 return y; 1384 1385 # (until 'any . prg) -> any 1386 until (w x y) 1387 x = (ex = ex.Cdr).Car; 1388 ex = ex.Cdr; 1389 y = Nil; 1390 while ((w = x.eval()) == Nil) 1391 y = ex.prog(); 1392 At.Car = w; 1393 return y; 1394 1395 # (do 'flg|cnt ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any 1396 do (n w x y) 1397 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 1398 return Nil; 1399 if (!(x instanceof Number)) 1400 return loop(ex.Cdr); 1401 for (ex = ex.Cdr, y = Nil, n = ((Number)x).longValue(); --n >= 0;) { 1402 x = ex; 1403 do { 1404 if (!((y = x.Car) instanceof Cell)) 1405 y = y.eval(); 1406 else if (y.Car == Nil) { 1407 if ((w = (y = y.Cdr).Car.eval()) == Nil) 1408 return y.Cdr.prog(); 1409 At.Car = w; 1410 y = Nil; 1411 } 1412 else if (y.Car == T) { 1413 if ((w = (y = y.Cdr).Car.eval()) != Nil) { 1414 At.Car = w; 1415 return y.Cdr.prog(); 1416 } 1417 y = Nil; 1418 } 1419 else 1420 y = y.eval(); 1421 } while ((x = x.Cdr) instanceof Cell); 1422 } 1423 return y; 1424 1425 # (loop ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any 1426 loop T 1427 return loop(ex.Cdr); 1428 1429 # (at '(cnt1 . cnt2|NIL) . prg) -> any 1430 at (num x) 1431 x = (ex = ex.Cdr).Car.eval(); 1432 if (x.Cdr == Nil) 1433 return Nil; 1434 if ((num = ((Number)x.Car).add(One)).compare((Number)x.Cdr) < 0) { 1435 x.Car = num; 1436 return Nil; 1437 } 1438 x.Car = Zero; 1439 return ex.Cdr.prog(); 1440 1441 # (for sym 'num ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any 1442 # (for sym|(sym2 . sym) 'lst ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any 1443 # (for (sym|(sym2 . sym) 'any1 'any2 [. prg]) ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any 1444 for (i w x y z bnd) 1445 bnd = new Bind(); 1446 if (!((y = (ex = ex.Cdr).Car) instanceof Cell) || !(y.Cdr instanceof Cell)) { 1447 if (!(y instanceof Cell)) { 1448 bnd.add(y.Car); 1449 bnd.add(y); 1450 } 1451 else { 1452 bnd.add(y.Cdr.Car); 1453 bnd.add(y.Cdr); 1454 bnd.add((z = y.Car).Car); 1455 bnd.add(z); 1456 z.Car = Zero; 1457 } 1458 Env.Bind = bnd; 1459 if ((z = (ex = ex.Cdr).Car.eval()) instanceof Number) 1460 bnd.Data[1].Car = Zero; 1461 for1: 1462 for (y = Nil;;) { 1463 if (z instanceof Number) { 1464 if (((Number)(bnd.Data[1].Car = ((Number)bnd.Data[1].Car).add(One))).compare((Number)z) > 0) 1465 break; 1466 } 1467 else { 1468 if (!(z instanceof Cell)) 1469 break; 1470 bnd.Data[1].Car = z.Car; 1471 if (!((z = z.Cdr) instanceof Cell)) 1472 z = Nil; 1473 } 1474 if (bnd.Cnt == 4) 1475 bnd.Data[3].Car = ((Number)bnd.Data[3].Car).add(One); 1476 x = ex.Cdr; 1477 do { 1478 if (!((y = x.Car) instanceof Cell)) 1479 y = y.eval(); 1480 else if (y.Car == Nil) { 1481 if ((w = (y = y.Cdr).Car.eval()) == Nil) { 1482 y = y.Cdr.prog(); 1483 break for1; 1484 } 1485 At.Car = w; 1486 y = Nil; 1487 } 1488 else if (y.Car == T) { 1489 if ((w = (y = y.Cdr).Car.eval()) != Nil) { 1490 At.Car = w; 1491 y = y.Cdr.prog(); 1492 break for1; 1493 } 1494 y = Nil; 1495 } 1496 else 1497 y = y.eval(); 1498 } while ((x = x.Cdr) instanceof Cell); 1499 } 1500 } 1501 else { 1502 if (!((z = y.Car) instanceof Cell)) { 1503 bnd.add(z.Car); 1504 bnd.add(z); 1505 } 1506 else { 1507 bnd.add(z.Cdr.Car); 1508 bnd.add(z.Cdr); 1509 bnd.add((z = z.Car).Car); 1510 bnd.add(z); 1511 z.Car = Zero; 1512 } 1513 Env.Bind = bnd; 1514 bnd.Data[1].Car = (y = y.Cdr).Car.eval(); 1515 z = y.Cdr; 1516 for2: 1517 for (y = Nil;;) { 1518 if (bnd.Cnt == 4) 1519 bnd.Data[3].Car = ((Number)bnd.Data[3].Car).add(One); 1520 if ((w = z.Car.eval()) == Nil) 1521 break; 1522 At.Car = w; 1523 x = ex.Cdr; 1524 do { 1525 if (!((y = x.Car) instanceof Cell)) 1526 y = y.eval(); 1527 else if (y.Car == Nil) { 1528 if ((w = (y = y.Cdr).Car.eval()) == Nil) { 1529 y = y.Cdr.prog(); 1530 break for2; 1531 } 1532 At.Car = w; 1533 y = Nil; 1534 } 1535 else if (y.Car == T) { 1536 if ((w = (y = y.Cdr).Car.eval()) != Nil) { 1537 At.Car = w; 1538 y = y.Cdr.prog(); 1539 break for2; 1540 } 1541 y = Nil; 1542 } 1543 else 1544 y = y.eval(); 1545 } while ((x = x.Cdr) instanceof Cell); 1546 if (z.Cdr instanceof Cell) 1547 bnd.Data[1].Car = z.Cdr.prog(); 1548 } 1549 } 1550 for (i = bnd.Cnt; (i -= 2) >= 0;) 1551 bnd.Data[i+1].Car = bnd.Data[i]; 1552 Env.Bind = bnd.Link; 1553 return y; 1554 1555 # (catch 'any . prg) -> any 1556 catch (x y) 1557 new Catch(y = (x = ex.Cdr).Car.eval(), Zero, Env); 1558 try { 1559 x = x.Cdr.prog(); 1560 Catch = Catch.Link; 1561 return x; 1562 } 1563 catch (Control e) { 1564 if (y == e.Tag) 1565 return e.Val; 1566 throw e; 1567 } 1568 catch (RuntimeException e) { 1569 if (y instanceof Cell && e.toString().indexOf(y.Car.name()) >= 0) 1570 return y.Car; 1571 throw e; 1572 } 1573 1574 # (throw 'sym 'any) 1575 throw (x y) 1576 y = (x = ex.Cdr).Car.eval(); 1577 throw new Control(ex, y, x.Cdr.Car.eval()); 1578 1579 # (finally exe . prg) -> any 1580 finally (x y) 1581 new Catch(null, y = (x = ex.Cdr).Car, Env); 1582 x = x.Cdr.prog(); 1583 y.eval(); 1584 Catch = Catch.Link; 1585 return x; 1586 1587 # (! . exe) -> any 1588 ! (x) 1589 x = ex.Cdr; 1590 if (Dbg.Car != Nil) 1591 x = brkLoad(x); 1592 return x.eval(); 1593 1594 # (e . prg) -> any 1595 e (w x y z) 1596 if (!Break) 1597 err(ex, null, "No Break"); 1598 w = Dbg.Car; Dbg.Car = Nil; 1599 x = At.Car; At.Car = Brk.Data[4]; 1600 y = Run.Car; Run.Car = Brk.Data[2]; 1601 InFrame in = Env.InFrames; Env.popInFiles(); 1602 OutFrame out = Env.OutFrames; Env.popOutFiles(); 1603 z = ex.Cdr instanceof Cell? ex.Cdr.prog() : Up.Car.eval(); 1604 OutFile.Wr.flush(); 1605 Env.pushOutFile(out); 1606 Env.pushInFile(in); 1607 Dbg.Car = w; 1608 At.Car = x; 1609 Run.Car = y; 1610 return z; 1611 1612 # ($ sym|lst lst . prg) -> any 1613 $ (i x) 1614 ex = ex.Cdr; 1615 if (Dbg.Car == Nil) 1616 return ex.Cdr.Cdr.prog(); 1617 trace(++Env.Trace, ex.Car, " :"); 1618 for (x = ex.Cdr.Car; x instanceof Cell; x = x.Cdr) { 1619 StdErr.space(); 1620 StdErr.print(x.Car.Car); 1621 } 1622 if (x != Nil) { 1623 if (x != At) { 1624 StdErr.space(); 1625 StdErr.print(x.Car); 1626 } 1627 else 1628 for (i = Env.Next; i < Env.ArgC; ++i) { 1629 StdErr.space(); 1630 StdErr.print(Env.Args[i]); 1631 } 1632 } 1633 StdErr.newline(); 1634 x = ex.Cdr.Cdr.prog(); 1635 trace(Env.Trace--, ex.Car, " = "); 1636 StdErr.print(x); 1637 StdErr.newline(); 1638 return x; 1639 1640 # (call 'any ..) -> flg 1641 call (x) 1642 ArrayList<String> cmd = new ArrayList<String>(); 1643 for (x = ex.Cdr; x instanceof Cell; x = x.Cdr) 1644 cmd.add(x.Car.eval().name()); 1645 try { 1646 ProcessBuilder pb = new ProcessBuilder(cmd); 1647 pb.redirectErrorStream(true); 1648 Process p = pb.start(); 1649 BufferedReader in = new BufferedReader(new InputStreamReader(p.getInputStream())); 1650 String line; 1651 while ((line = in.readLine()) != null) 1652 System.out.println(line); 1653 return p.waitFor() == 0? T : Nil; 1654 } 1655 catch (IOException e) {System.err.println(cmd.get(0) + ": Can't exec");} 1656 catch (InterruptedException e) {} //#! sighandler() 1657 return Nil; 1658 1659 # (ipid) -> pid | NIL 1660 ipid () 1661 return Env.InFrames != null && Env.InFrames.Pid > 1? new Number(Env.InFrames.Pid) : Nil; 1662 1663 # (opid) -> pid | NIL 1664 opid () 1665 return Env.OutFrames != null && Env.OutFrames.Pid > 1? new Number(Env.OutFrames.Pid) : Nil; 1666 1667 # (kill 'pid ['cnt]) -> flg 1668 kill (i) 1669 if (Pids[i = evInt(ex = ex.Cdr)] == null) 1670 return Nil; 1671 if ((ex = ex.Cdr) instanceof Cell && evInt(ex) == 0) 1672 return T; 1673 Pids[i].destroy(); 1674 return T; 1675 1676 # (bye 'cnt|NIL) 1677 bye (x) 1678 x = ex.Cdr.Car.eval(); 1679 return bye(x == Nil? 0 : ((Number)x).Cnt); 1680 1681 ############ sym ############ 1682 # (name 'sym ['sym2]) -> sym 1683 name (x y s) 1684 y = (x = ex.Cdr).Car.eval(); 1685 if (!((x = x.Cdr) instanceof Cell)) 1686 return mkStr(y.name()); 1687 if ((s = ((Symbol)y)).Name != null && Env.intern().get(s.Name) == s) 1688 err(ex, s, "Can't rename"); 1689 if (Transient.get(((Symbol)y).Name) == y) 1690 Transient.remove(((Symbol)y).Name); 1691 s.Name = ((Symbol)(x = x.Car.eval())).Name; 1692 return s; 1693 1694 # (sp? 'any) -> flg 1695 sp? () 1696 return isBlank(ex.Cdr.Car.eval())? T : Nil; 1697 1698 # (pat? 'any) -> sym | NIL 1699 pat? (x) 1700 return ((x = ex.Cdr.Car.eval()) instanceof Symbol) && firstChar(x) == '@'? x : Nil; 1701 1702 # (fun? 'any) -> any 1703 fun? () 1704 return funq(ex.Cdr.Car.eval()); 1705 1706 # (getd 'any) -> fun | NIL 1707 getd (x) 1708 if (!((x = ex.Cdr.Car.eval()) instanceof Symbol)) 1709 return Nil; 1710 return funq(x.Car) != Nil? x.Car : Nil; // ... reflection 1711 1712 # (all ['T]) -> lst 1713 all () 1714 return all(ex.Cdr.Car.eval() == Nil? Env.intern() : Transient); 1715 1716 # (symbols) -> sym 1717 # (symbols 'sym1) -> sym2 1718 # (symbols 'sym1 'sym ..) -> sym2 1719 symbols (x s t) 1720 if (ex.Cdr instanceof Cell) { 1721 s = (Symbol)ex.Cdr.Car.eval(); 1722 if ((x = ex.Cdr.Cdr) instanceof Cell) { 1723 s.Car = new Symbol(new Namespace()); 1724 do { 1725 t = (Symbol)x.Car.eval(); 1726 if (!(t.Car instanceof Symbol) || !(((Symbol)t.Car).Obj instanceof Namespace)) 1727 symNsError(ex, t); 1728 ((Namespace)(((Symbol)t.Car).Obj)).copy((Namespace)(((Symbol)s.Car).Obj)); 1729 } while ((x = x.Cdr) instanceof Cell); 1730 } 1731 else if (!(s.Car instanceof Symbol) || !(((Symbol)s.Car).Obj instanceof Namespace)) 1732 symNsError(ex, s); 1733 t = Env.Intern; 1734 Env.Intern = s; 1735 return t; 1736 } 1737 return Env.Intern; 1738 1739 # (intern 'sym) -> sym 1740 intern (s t str) 1741 s = (Symbol)ex.Cdr.Car.eval(); 1742 if ((str = s.name()).length() == 0 || str.equals("NIL")) 1743 return Nil; 1744 if ((t = Env.intern().get(str)) != null) 1745 return t; 1746 Env.intern().put(str, s); 1747 return s; 1748 1749 # (==== ['sym ..]) -> NIL 1750 ==== (x y) 1751 Transient.clear(); 1752 for (x = ex.Cdr; x instanceof Cell; x = x.Cdr) { 1753 y = x.Car.eval(); 1754 Transient.put(((Symbol)y).Name, (Symbol)y); 1755 } 1756 return Nil; 1757 1758 # (box? 'any) -> sym | NIL 1759 box? (x) 1760 return ((x = ex.Cdr.Car.eval()) instanceof Symbol) && x.name().length() == 0? x : Nil; 1761 1762 # (str? 'any) -> sym | NIL 1763 str? (x) 1764 return ((x = ex.Cdr.Car.eval()) instanceof Symbol) && Env.intern().get(x.name()) != x? x : Nil; 1765 1766 # (ext? 'any) -> sym | NIL 1767 ext? T 1768 return Nil; 1769 1770 # (zap 'sym) -> sym 1771 zap (s) 1772 s = (Symbol)ex.Cdr.Car.eval(); 1773 if (Env.intern().get(s.Name) == s) 1774 Env.intern().remove(s.Name); 1775 return s; 1776 1777 # (chop 'any) -> lst 1778 chop (x y str) 1779 x = ex.Cdr.Car.eval(); 1780 if (!(x instanceof Cell)) { 1781 str = x.name(); 1782 if (str.length() == 0) 1783 return Nil; 1784 y = x = new Cell(mkChar(str.charAt(0)), Nil); 1785 for (int i = 1; i < str.length(); ++i) 1786 y = y.Cdr = new Cell(mkChar(str.charAt(i)), Nil); 1787 } 1788 return x; 1789 1790 # (pack 'any ..) -> sym 1791 pack (sb) 1792 sb = new StringBuilder(); 1793 for (ex = ex.Cdr; ex instanceof Cell; ex = ex.Cdr) 1794 sb.append(evString(ex)); 1795 return mkStr(sb); 1796 1797 # (glue 'any 'lst) -> sym 1798 glue (x y sb) 1799 x = ex.Cdr.Car.eval(); 1800 if (!((y = ex.Cdr.Cdr.Car.eval()) instanceof Cell)) 1801 return y; 1802 for (sb = new StringBuilder(), sb.append(y.Car.name()); (y = y.Cdr) instanceof Cell;) { 1803 sb.append(x.name()); 1804 sb.append(y.Car.name()); 1805 } 1806 return mkStr(sb); 1807 1808 # (text 'any1 'any ..) -> sym 1809 text (i j k c str sb v) 1810 str = evString(ex = ex.Cdr); 1811 v = new Any[6]; 1812 i = 0; 1813 while ((ex = ex.Cdr) instanceof Cell) 1814 v = append(v, i++, ex.Car.eval()); 1815 sb = new StringBuilder(); 1816 k = str.length(); 1817 for (j = 0; j < k; ++j) 1818 if ((c = str.charAt(j)) != '@') 1819 sb.append(c); 1820 else if (++j == k) 1821 break; 1822 else if ((c = str.charAt(j)) == '@') 1823 sb.append('@'); 1824 else if (c >= '1') { 1825 if ((c -= '1') > 8) 1826 c -= 7; 1827 if (i > c) 1828 sb.append(v[c].name()); 1829 } 1830 return mkStr(sb); 1831 1832 # (pre? 'any1 'any2) -> any2 | NIL 1833 pre? (x str) 1834 str = evString(ex = ex.Cdr); 1835 return (x = ex.Cdr.Car.eval()).name().startsWith(str)? x : Nil; 1836 1837 # (sub? 'any1 'any2) -> any2 | NIL 1838 sub? (x str) 1839 str = evString(ex = ex.Cdr); 1840 return (x = ex.Cdr.Car.eval()).name().indexOf(str) >= 0? x : Nil; 1841 1842 # (val 'var) -> any 1843 val T 1844 return ex.Cdr.Car.eval().Car; 1845 1846 # (set 'var 'any ..) -> any 1847 set (x y) 1848 x = ex.Cdr; 1849 do { 1850 y = x.Car.eval(); 1851 needVar(ex, y); 1852 y.Car = (x = x.Cdr).Car.eval(); 1853 } while ((x = x.Cdr) instanceof Cell); 1854 return y.Car; 1855 1856 # (setq var 'any ..) -> any 1857 setq (x y) 1858 x = ex.Cdr; 1859 do { 1860 y = x.Car; 1861 needVar(ex, y); 1862 y.Car = (x = x.Cdr).Car.eval(); 1863 } while ((x = x.Cdr) instanceof Cell); 1864 return y.Car; 1865 1866 # (xchg 'var 'var ..) -> any 1867 xchg (w x y z) 1868 x = ex.Cdr; 1869 do { 1870 needVar(ex, y = x.Car.eval()); 1871 needVar(ex, z = (x = x.Cdr).Car.eval()); 1872 w = y.Car; y.Car = z.Car; z.Car = w; 1873 } while ((x = x.Cdr) instanceof Cell); 1874 return w; 1875 1876 # (on var ..) -> T 1877 on (x) 1878 x = ex.Cdr; 1879 do 1880 x.Car.Car = T; 1881 while ((x = x.Cdr) instanceof Cell); 1882 return T; 1883 1884 # (off var ..) -> NIL 1885 off (x) 1886 x = ex.Cdr; 1887 do 1888 x.Car.Car = Nil; 1889 while ((x = x.Cdr) instanceof Cell); 1890 return Nil; 1891 1892 # (onOff var ..) -> flg 1893 onOff (x y) 1894 x = ex.Cdr; 1895 do 1896 y = x.Car.Car = x.Car.Car == Nil? T : Nil; 1897 while ((x = x.Cdr) instanceof Cell); 1898 return y; 1899 1900 # (zero var ..) -> 0 1901 zero (x) 1902 x = ex.Cdr; 1903 do 1904 x.Car.Car = Zero; 1905 while ((x = x.Cdr) instanceof Cell); 1906 return Zero; 1907 1908 # (one var ..) -> 1 1909 one (x) 1910 x = ex.Cdr; 1911 do 1912 x.Car.Car = One; 1913 while ((x = x.Cdr) instanceof Cell); 1914 return One; 1915 1916 # (default var 'any ..) -> any 1917 default (x y) 1918 x = ex.Cdr; 1919 do { 1920 y = x.Car; 1921 x = x.Cdr; 1922 needVar(ex, y); 1923 if (y.Car == Nil) 1924 y.Car = x.Car.eval(); 1925 } while ((x = x.Cdr) instanceof Cell); 1926 return y.Car; 1927 1928 # (push 'var 'any ..) -> any 1929 push (x y z) 1930 needVar(ex, y = (x = ex.Cdr).Car.eval()); 1931 do 1932 y.Car = new Cell(z = (x = x.Cdr).Car.eval(), y.Car); 1933 while (x.Cdr instanceof Cell); 1934 return z; 1935 1936 # (push1 'var 'any ..) -> any 1937 push1 (x y z) 1938 needVar(ex, y = (x = ex.Cdr).Car.eval()); 1939 do 1940 if (member(z = (x = x.Cdr).Car.eval(), y.Car) == null) 1941 y.Car = new Cell(z, y.Car); 1942 while (x.Cdr instanceof Cell); 1943 return z; 1944 1945 # (pop 'var) -> any 1946 pop (x y) 1947 needVar(ex, x = ex.Cdr.Car.eval()); 1948 if ((y = x.Car) instanceof Cell) { 1949 x.Car = x.Car.Cdr; 1950 y = y.Car; 1951 } 1952 return y; 1953 1954 # (cut 'cnt 'var) -> lst 1955 cut (n x y z) 1956 if ((n = evLong(ex.Cdr)) <= 0) 1957 return Nil; 1958 needVar(ex, x = ex.Cdr.Cdr.Car.eval()); 1959 if (x.Car instanceof Cell) { 1960 z = y = new Cell(x.Car.Car, Nil); 1961 while ((x.Car = x.Car.Cdr) instanceof Cell && --n != 0) 1962 y = y.Cdr = new Cell(x.Car.Car, Nil); 1963 return z; 1964 } 1965 return x.Car; 1966 1967 # (del 'any 'var) -> lst 1968 del (w lst x y z) 1969 w = ex.Cdr.Car.eval(); 1970 needVar(ex, x = ex.Cdr.Cdr.Car.eval()); 1971 if ((lst = x.Car) instanceof Cell) { 1972 if (w.equal(lst.Car)) 1973 return x.Car = lst.Cdr; 1974 for (z = y = new Cell(lst.Car, Nil); (lst = lst.Cdr) instanceof Cell; y = y.Cdr = new Cell(lst.Car, Nil)) 1975 if (w.equal(lst.Car)) { 1976 y.Cdr = lst.Cdr; 1977 return x.Car = z; 1978 } 1979 } 1980 return x.Car; 1981 1982 # (queue 'var 'any) -> any 1983 queue (x y) 1984 needVar(ex, x = ex.Cdr.Car.eval()); 1985 y = ex.Cdr.Cdr.Car.eval(); 1986 if (!(x.Car instanceof Cell)) 1987 x.Car = new Cell(y, Nil); 1988 else { 1989 for (x = x.Car; x.Cdr instanceof Cell; x = x.Cdr); 1990 x.Cdr = new Cell(y, Nil); 1991 } 1992 return y; 1993 1994 # (fifo 'var ['any ..]) -> any 1995 fifo (x y z lst) 1996 needVar(ex, y = (x = ex.Cdr).Car.eval()); 1997 if ((x = x.Cdr) instanceof Cell) { 1998 z = x.Car.eval(); 1999 if ((lst = y.Car) instanceof Cell) 2000 y.Car = lst = lst.Cdr = new Cell(z, lst.Cdr); 2001 else { 2002 lst = y.Car = new Cell(z, Nil); 2003 lst.Cdr = lst; 2004 } 2005 while ((x = x.Cdr) instanceof Cell) 2006 y.Car = lst = lst.Cdr = new Cell(z = x.Car.eval(), lst.Cdr); 2007 return z; 2008 } 2009 if (!((lst = y.Car) instanceof Cell)) 2010 return Nil; 2011 if (lst == lst.Cdr) { 2012 z = lst.Car; 2013 y.Car = Nil; 2014 } 2015 else { 2016 z = lst.Cdr.Car; 2017 lst.Cdr = lst.Cdr.Cdr; 2018 } 2019 return z; 2020 2021 # (idx 'var 'any 'flg) -> lst 2022 # (idx 'var 'any) -> lst 2023 # (idx 'var) -> lst 2024 idx (x y) 2025 needVar(ex, x = (ex = ex.Cdr).Car.eval()); 2026 if (!((ex = ex.Cdr) instanceof Cell)) 2027 return idx(x, null, 0); 2028 y = ex.Car.eval(); 2029 return idx(x, y, ex.Cdr instanceof Cell? (ex.Cdr.Car.eval() == Nil? -1 : +1) : 0); 2030 2031 # (lup 'lst 'any) -> lst 2032 # (lup 'lst 'any 'any2) -> lst 2033 lup (i x y z) 2034 x = (ex = ex.Cdr).Car.eval(); 2035 y = (ex = ex.Cdr).Car.eval(); 2036 if ((z = ex.Cdr.Car.eval()) != Nil) 2037 return consLup(x, Nil, y, z); 2038 while (x instanceof Cell) { 2039 if (x.Car == T) 2040 x = x.Cdr.Car; 2041 else if (!(x.Car instanceof Cell)) 2042 x = x.Cdr.Cdr; 2043 else if ((i = y.compare(x.Car.Car)) == 0) 2044 return x.Car; 2045 else 2046 x = i < 0? x.Cdr.Car : x.Cdr.Cdr; 2047 } 2048 return Nil; 2049 2050 # (put 'sym1|lst ['sym2|cnt ..] 'sym|0 'any) -> any 2051 put (x y) 2052 x = (ex = ex.Cdr).Car.eval(); 2053 for (;;) { 2054 y = (ex = ex.Cdr).Car.eval(); 2055 if (!(ex.Cdr.Cdr instanceof Cell)) 2056 return x.put(y, ex.Cdr.Car.eval()); 2057 x = x.get(y); 2058 } 2059 2060 # (get 'sym1|lst ['sym2|cnt ..]) -> any 2061 get (x) 2062 x = (ex = ex.Cdr).Car.eval(); 2063 while ((ex = ex.Cdr) instanceof Cell) 2064 x = x.get(ex.Car.eval()); 2065 return x; 2066 2067 # (prop 'sym1|lst ['sym2|cnt ..] 'sym) -> var 2068 prop (x) 2069 x = (ex = ex.Cdr).Car.eval(); 2070 while ((ex = ex.Cdr).Cdr instanceof Cell) 2071 x = x.get(ex.Car.eval()); 2072 return x.prop(ex.Car.eval()); 2073 2074 # (; 'sym1|lst [sym2|cnt ..]) -> any 2075 ; (x) 2076 x = (ex = ex.Cdr).Car.eval(); 2077 while ((ex = ex.Cdr) instanceof Cell) 2078 x = x.get(ex.Car); 2079 return x; 2080 2081 # (=: sym|0 [sym1|cnt .. sym2|0] 'any) -> any 2082 =: (x y) 2083 for (x = This.Car;;) { 2084 y = (ex = ex.Cdr).Car; 2085 if (!(ex.Cdr.Cdr instanceof Cell)) 2086 return x.put(y, ex.Cdr.Car.eval()); 2087 x = x.get(y); 2088 } 2089 2090 # (: sym|0 [sym1|cnt ..]) -> any 2091 : (x) 2092 x = This.Car; 2093 do 2094 x = x.get((ex = ex.Cdr).Car); 2095 while (ex.Cdr instanceof Cell); 2096 return x; 2097 2098 # (:: sym|0 [sym1|cnt .. sym2]) -> var 2099 :: (x) 2100 x = This.Car; 2101 while ((ex = ex.Cdr).Cdr instanceof Cell) 2102 x = x.get(ex.Car); 2103 return x.prop(ex.Car); 2104 2105 # (putl 'sym1|lst1 ['sym2|cnt ..] 'lst) -> lst 2106 putl (x) 2107 x = (ex = ex.Cdr).Car.eval(); 2108 while ((ex = ex.Cdr).Cdr instanceof Cell) 2109 x = x.get(ex.Car.eval()); 2110 return x.putl(ex.Car.eval()); 2111 2112 # (getl 'sym1|lst1 ['sym2|cnt ..]) -> lst 2113 getl (x) 2114 x = (ex = ex.Cdr).Car.eval(); 2115 while ((ex = ex.Cdr) instanceof Cell) 2116 x = x.get(ex.Car.eval()); 2117 return x.getl(); 2118 2119 # (wipe 'sym|lst) -> sym 2120 wipe (x y) 2121 if ((x = ex.Cdr.Car.eval()) != Nil) 2122 if (!(x instanceof Cell)) 2123 ((Symbol)x).wipe(); 2124 else { 2125 y = x; do 2126 ((Symbol)y.Car).wipe(); 2127 while ((y = y.Cdr) instanceof Cell); 2128 } 2129 return x; 2130 2131 # (meta 'obj|typ 'sym ['sym2|cnt ..]) -> any 2132 meta (x) 2133 if ((x = (ex = ex.Cdr).Car.eval()) instanceof Symbol) 2134 x = x.Car; 2135 for (x = meta(x, (ex = ex.Cdr).Car.eval()); (ex = ex.Cdr) instanceof Cell;) 2136 x = x.get(ex.Car.eval()); 2137 return x; 2138 2139 # (low? 'any) -> sym | NIL 2140 low? (x) 2141 return (x = ex.Cdr.Car.eval()) instanceof Symbol && Character.isLowerCase(firstChar(x))? x : Nil; 2142 2143 # (upp? 'any) -> sym | NIL 2144 upp? (x) 2145 return (x = ex.Cdr.Car.eval()) instanceof Symbol && Character.isUpperCase(firstChar(x))? x : Nil; 2146 2147 # (lowc 'any) -> any 2148 lowc (i j x str sb) 2149 if (!((x = ex.Cdr.Car.eval()) instanceof Symbol) || (j = (str = x.name()).length()) == 0) 2150 return x; 2151 sb = new StringBuilder(); 2152 for (i = 0; i < j; ++i) 2153 sb.append(Character.toLowerCase(str.charAt(i))); 2154 return mkStr(sb); 2155 2156 # (uppc 'any) -> any 2157 uppc (i j x str sb) 2158 if (!((x = ex.Cdr.Car.eval()) instanceof Symbol) || (j = (str = x.name()).length()) == 0) 2159 return x; 2160 sb = new StringBuilder(); 2161 for (i = 0; i < j; ++i) 2162 sb.append(Character.toUpperCase(str.charAt(i))); 2163 return mkStr(sb); 2164 2165 # (fold 'any ['cnt]) -> sym 2166 fold (i j k x str c sb) 2167 if (!((x = (ex = ex.Cdr).Car.eval()) instanceof Symbol) || (j = (str = x.name()).length()) == 0) 2168 return x; 2169 for (i = 0; !Character.isLetterOrDigit(c = str.charAt(i));) 2170 if (++i == j) 2171 return Nil; 2172 k = (ex = ex.Cdr) instanceof Cell? evInt(ex) : 0; 2173 sb = new StringBuilder(); 2174 sb.append(Character.toLowerCase(c)); 2175 while (++i < j) 2176 if (Character.isLetterOrDigit(c = str.charAt(i))) { 2177 if (--k == 0) 2178 break; 2179 sb.append(Character.toLowerCase(c)); 2180 } 2181 return mkStr(sb); 2182 2183 ############ subr ############ 2184 # (Car -> any 2185 car T 2186 return ex.Cdr.Car.eval().Car; 2187 2188 # (cdr 'lst) -> any 2189 cdr T 2190 return ex.Cdr.Car.eval().Cdr; 2191 2192 caar T 2193 return ex.Cdr.Car.eval().Car.Car; 2194 2195 cadr T 2196 return ex.Cdr.Car.eval().Cdr.Car; 2197 2198 cdar T 2199 return ex.Cdr.Car.eval().Car.Cdr; 2200 2201 cddr T 2202 return ex.Cdr.Car.eval().Cdr.Cdr; 2203 2204 caaar () 2205 return ex.Cdr.Car.eval().Car.Car.Car; 2206 2207 caadr () 2208 return ex.Cdr.Car.eval().Cdr.Car.Car; 2209 2210 cadar () 2211 return ex.Cdr.Car.eval().Car.Cdr.Car; 2212 2213 caddr () 2214 return ex.Cdr.Car.eval().Cdr.Cdr.Car; 2215 2216 cdaar () 2217 return ex.Cdr.Car.eval().Car.Car.Cdr; 2218 2219 cdadr () 2220 return ex.Cdr.Car.eval().Cdr.Car.Cdr; 2221 2222 cddar () 2223 return ex.Cdr.Car.eval().Car.Cdr.Cdr; 2224 2225 cdddr () 2226 return ex.Cdr.Car.eval().Cdr.Cdr.Cdr; 2227 2228 caaaar () 2229 return ex.Cdr.Car.eval().Car.Car.Car.Car; 2230 2231 caaadr () 2232 return ex.Cdr.Car.eval().Cdr.Car.Car.Car; 2233 2234 caadar () 2235 return ex.Cdr.Car.eval().Car.Cdr.Car.Car; 2236 2237 caaddr () 2238 return ex.Cdr.Car.eval().Cdr.Cdr.Car.Car; 2239 2240 cadaar () 2241 return ex.Cdr.Car.eval().Car.Car.Cdr.Car; 2242 2243 cadadr () 2244 return ex.Cdr.Car.eval().Cdr.Car.Cdr.Car; 2245 2246 caddar () 2247 return ex.Cdr.Car.eval().Car.Cdr.Cdr.Car; 2248 2249 cadddr () 2250 return ex.Cdr.Car.eval().Cdr.Cdr.Cdr.Car; 2251 2252 cdaaar () 2253 return ex.Cdr.Car.eval().Car.Car.Car.Cdr; 2254 2255 cdaadr () 2256 return ex.Cdr.Car.eval().Cdr.Car.Car.Cdr; 2257 2258 cdadar () 2259 return ex.Cdr.Car.eval().Car.Cdr.Car.Cdr; 2260 2261 cdaddr () 2262 return ex.Cdr.Car.eval().Cdr.Cdr.Car.Cdr; 2263 2264 cddaar () 2265 return ex.Cdr.Car.eval().Car.Car.Cdr.Cdr; 2266 2267 cddadr () 2268 return ex.Cdr.Car.eval().Cdr.Car.Cdr.Cdr; 2269 2270 cdddar () 2271 return ex.Cdr.Car.eval().Car.Cdr.Cdr.Cdr; 2272 2273 cddddr () 2274 return ex.Cdr.Car.eval().Cdr.Cdr.Cdr.Cdr; 2275 2276 # (nth 'lst 'cnt ..) -> lst 2277 nth (x) 2278 x = (ex = ex.Cdr).Car.eval(); 2279 for (;;) { 2280 if (!(x instanceof Cell)) 2281 return x; 2282 x = nth(evInt(ex = ex.Cdr), x); 2283 if (ex.Cdr == Nil) 2284 return x; 2285 x = x.Car; 2286 } 2287 2288 # (con 'lst 'any) -> any 2289 con (x) 2290 x = ex.Cdr.Car.eval(); 2291 return x.Cdr = ex.Cdr.Cdr.Car.eval(); 2292 2293 # (cons 'any ['any ..]) -> lst 2294 cons (x y) 2295 y = x = new Cell((ex = ex.Cdr).Car.eval(), Nil); 2296 while ((ex = ex.Cdr).Cdr instanceof Cell) 2297 x = x.Cdr = new Cell(ex.Car.eval(), Nil); 2298 x.Cdr = ex.Car.eval(); 2299 return y; 2300 2301 # (conc 'lst ..) -> lst 2302 conc (x y z) 2303 z = x = (ex = ex.Cdr).Car.eval(); 2304 while ((ex = ex.Cdr) instanceof Cell) { 2305 if (!(x instanceof Cell)) 2306 z = x = ex.Car.eval(); 2307 else { 2308 while ((y = x.Cdr) instanceof Cell) 2309 x = y; 2310 x.Cdr = ex.Car.eval(); 2311 } 2312 } 2313 return z; 2314 2315 # (circ 'any ..) -> lst 2316 circ (x y) 2317 y = x = new Cell((ex = ex.Cdr).Car.eval(), Nil); 2318 while ((ex = ex.Cdr) instanceof Cell) 2319 x = x.Cdr = new Cell(ex.Car.eval(), Nil); 2320 x.Cdr = y; 2321 return y; 2322 2323 # (rot 'lst ['cnt]) -> lst 2324 rot (i w x y z) 2325 w = y = (ex = ex.Cdr).Car.eval(); 2326 if (w instanceof Cell) { 2327 i = ex.Cdr == Nil? 0 : evInt(ex.Cdr); 2328 x = y.Car; 2329 while (--i != 0 && (y = y.Cdr) instanceof Cell && y != w) { 2330 z = y.Car; y.Car = x; x = z; 2331 } 2332 w.Car = x; 2333 } 2334 return w; 2335 2336 # (list 'any ['any ..]) -> lst 2337 list (x y) 2338 x = y = new Cell((ex = ex.Cdr).Car.eval(), Nil); 2339 while ((ex = ex.Cdr) instanceof Cell) 2340 x = x.Cdr = new Cell(ex.Car.eval(), Nil); 2341 return y; 2342 2343 # (need 'cnt ['lst ['any]]) -> lst 2344 # (need 'cnt ['num|sym]) -> lst 2345 need (n x y z) 2346 n = evLong(ex = ex.Cdr); 2347 if ((z = (ex = ex.Cdr).Car.eval()) instanceof Cell || z == Nil) 2348 y = ex.Cdr.Car.eval(); 2349 else { 2350 y = z; 2351 z = Nil; 2352 } 2353 x = z; 2354 if (n > 0) 2355 for (n -= x.length(); n > 0; --n) 2356 z = new Cell(y,z); 2357 else if (n != 0) { 2358 if (!(x instanceof Cell)) 2359 z = x = new Cell(y,Nil); 2360 else 2361 while (x.Cdr instanceof Cell) { 2362 ++n; x = x.Cdr; 2363 } 2364 while (++n < 0) 2365 x = x.Cdr = new Cell(y,Nil); 2366 } 2367 return z; 2368 2369 # (range 'num1 'num2 ['num3]) -> lst 2370 range (num x y) 2371 num = (Number)(y = (x = ex.Cdr).Car.eval()); 2372 Number end = (Number)(x = x.Cdr).Car.eval(); 2373 Number inc = (x = x.Cdr.Car.eval()) == Nil? One : (Number)x; 2374 x = y = new Cell(y, Nil); 2375 if (end.compare(num) >= 0) 2376 while (end.compare(num = num.add(inc)) >= 0) 2377 x = x.Cdr = new Cell(num, Nil); 2378 else 2379 while (end.compare(num = num.sub(inc)) <= 0) 2380 x = x.Cdr = new Cell(num, Nil); 2381 return y; 2382 2383 # (full 'any) -> bool 2384 full (x) 2385 for (x = ex.Cdr.Car.eval(); x instanceof Cell; x = x.Cdr) 2386 if (x.Car == Nil) 2387 return Nil; 2388 return T; 2389 2390 # (make .. [(made 'lst ..)] .. [(link 'any ..)] ..) -> any 2391 make (x y z) 2392 x = Env.Make; Env.Make = Nil; 2393 y = Env.Yoke; Env.Yoke = Nil; 2394 ex.Cdr.prog(); 2395 z = Env.Yoke; 2396 Env.Yoke = y; 2397 Env.Make = x; 2398 return z; 2399 2400 # (made ['lst1 ['lst2]]) -> lst 2401 made (x y) 2402 if ((x = ex.Cdr) instanceof Cell) { 2403 Env.Yoke = x.Car.eval(); 2404 x = x.Cdr; 2405 if (!((x = x.Car.eval()) instanceof Cell)) 2406 for (x = Env.Yoke; (y = x.Cdr) instanceof Cell; x = y); 2407 Env.Make = x; 2408 } 2409 return Env.Yoke; 2410 2411 # (chain 'lst ..) -> lst 2412 chain (x y) 2413 ex = ex.Cdr; 2414 do { 2415 x = ex.Car.eval(); 2416 if (Env.Make != Nil) 2417 Env.Make = Env.Make.Cdr = x; 2418 else 2419 Env.Yoke = Env.Make = x; 2420 while ((y = Env.Make.Cdr) instanceof Cell) 2421 Env.Make = y; 2422 } while ((ex = ex.Cdr) instanceof Cell); 2423 return x; 2424 2425 # (link 'any ..) -> any 2426 link (x) 2427 ex = ex.Cdr; 2428 do { 2429 x = ex.Car.eval(); 2430 if (Env.Make != Nil) 2431 Env.Make = Env.Make.Cdr = new Cell(x, Nil); 2432 else 2433 Env.Yoke = Env.Make = new Cell(x, Nil); 2434 } while ((ex = ex.Cdr) instanceof Cell); 2435 return x; 2436 2437 # (yoke 'any ..) -> any 2438 yoke (x) 2439 ex = ex.Cdr; 2440 do { 2441 x = ex.Car.eval(); 2442 Env.Yoke = new Cell(x, Env.Yoke); 2443 if (Env.Make == Nil) 2444 Env.Make = Env.Yoke; 2445 } while ((ex = ex.Cdr) instanceof Cell); 2446 return x; 2447 2448 # (copy 'any) -> any 2449 copy (w x y z) 2450 if (!((x = ex.Cdr.Car.eval()) instanceof Cell)) 2451 return x; 2452 for (w = y = new Cell(x.Car, (z = x).Cdr); (x = y.Cdr) instanceof Cell; y = y.Cdr = new Cell(x.Car, x.Cdr)) 2453 if (x == z) { 2454 y.Cdr = w; 2455 break; 2456 } 2457 return w; 2458 2459 # (mix 'lst cnt|'any ..) -> lst 2460 mix (x y z) 2461 if (!((y = (ex = ex.Cdr).Car.eval()) instanceof Cell) && y != Nil) 2462 return y; 2463 if (!((ex = ex.Cdr) instanceof Cell)) 2464 return Nil; 2465 z = x = new Cell(ex.Car instanceof Number? nth(xInt(ex.Car), y).Car : ex.Car.eval(), Nil); 2466 while ((ex = ex.Cdr) instanceof Cell) 2467 x = x.Cdr = new Cell(ex.Car instanceof Number? nth(xInt(ex.Car), y).Car : ex.Car.eval(), Nil); 2468 return z; 2469 2470 # (append 'lst ..) -> lst 2471 append (x y z) 2472 for (ex = ex.Cdr; (z = ex.Cdr) instanceof Cell; ex = z) { 2473 if ((x = ex.Car.eval()) instanceof Cell) { 2474 z = y = new Cell(x.Car, x.Cdr); 2475 while ((x = y.Cdr) instanceof Cell) 2476 y = y.Cdr = new Cell(x.Car, x.Cdr); 2477 while ((ex = ex.Cdr).Cdr instanceof Cell) { 2478 for (x = ex.Car.eval(); x instanceof Cell; x = y.Cdr) 2479 y = y.Cdr = new Cell(x.Car, x.Cdr); 2480 y.Cdr = x; 2481 } 2482 y.Cdr = ex.Car.eval(); 2483 return z; 2484 } 2485 } 2486 return ex.Car.eval(); 2487 2488 # (delete 'any 'lst) -> lst 2489 delete (w x y z) 2490 y = (x = ex.Cdr).Car.eval(); 2491 if (!((x = x.Cdr.Car.eval()) instanceof Cell)) 2492 return x; 2493 if (y.equal(x.Car)) 2494 return x.Cdr; 2495 w = z = new Cell(x.Car, Nil); 2496 while ((x = x.Cdr) instanceof Cell) { 2497 if (y.equal(x.Car)) { 2498 z.Cdr = x.Cdr; 2499 return w; 2500 } 2501 z = z.Cdr = new Cell(x.Car, Nil); 2502 } 2503 z.Cdr = x; 2504 return w; 2505 2506 # (delq 'any 'lst) -> lst 2507 delq (w x y z) 2508 y = (x = ex.Cdr).Car.eval(); 2509 if (!((x = x.Cdr.Car.eval()) instanceof Cell)) 2510 return x; 2511 if (y == x.Car) 2512 return x.Cdr; 2513 w = z = new Cell(x.Car, Nil); 2514 while ((x = x.Cdr) instanceof Cell) { 2515 if (y == x.Car) { 2516 z.Cdr = x.Cdr; 2517 return w; 2518 } 2519 z = z.Cdr = new Cell(x.Car, Nil); 2520 } 2521 z.Cdr = x; 2522 return w; 2523 2524 # (replace 'lst 'any1 'any2 ..) -> lst 2525 replace (i j w x y z v) 2526 if (!((y = (x = ex.Cdr).Car.eval()) instanceof Cell)) 2527 return y; 2528 for (v = new Any[6], i = 0; (x = x.Cdr) instanceof Cell; ++i) { 2529 v = append(v, i, x.Car.eval()); 2530 v = append(v, ++i, (x = x.Cdr).Car.eval()); 2531 } 2532 for (x = y.Car, j = 0; j < i; j += 2) 2533 if (x.equal(v[j])) { 2534 x = v[j+1]; 2535 break; 2536 } 2537 for (w = z = new Cell(x, Nil); (y = y.Cdr) instanceof Cell; z = z.Cdr = new Cell(x, Nil)) 2538 for (x = y.Car, j = 0; j < i; j += 2) 2539 if (x.equal(v[j])) { 2540 x = v[j+1]; 2541 break; 2542 } 2543 z.Cdr = y; 2544 return w; 2545 2546 # (strip 'any) -> any 2547 strip (x) 2548 for (x = ex.Cdr.Car.eval(); x instanceof Cell && x.Car == Quote && x != x.Cdr; x = x.Cdr); 2549 return x; 2550 2551 # (split 'lst 'any ..) -> lst 2552 split (i j x y z v) 2553 if (!((z = (x = ex.Cdr).Car.eval()) instanceof Cell)) 2554 return z; 2555 for (v = new Any[6], i = 0; (x = x.Cdr) instanceof Cell; ++i) 2556 v = append(v, i, x.Car.eval()); 2557 Any res = x = Nil; 2558 Any sub = y = Nil; 2559 spl: 2560 do { 2561 for (j = 0; j < i; ++j) { 2562 if (z.Car.equal(v[j])) { 2563 if (x == Nil) 2564 x = res = new Cell(sub, Nil); 2565 else 2566 x = x.Cdr = new Cell(sub, Nil); 2567 y = sub = Nil; 2568 continue spl; 2569 } 2570 } 2571 if (y == Nil) 2572 y = sub = new Cell(z.Car, Nil); 2573 else 2574 y = y.Cdr = new Cell(z.Car, Nil); 2575 } while ((z = z.Cdr) instanceof Cell); 2576 y = new Cell(sub, Nil); 2577 if (x == Nil) 2578 return y; 2579 x.Cdr = y; 2580 return res; 2581 2582 # (reverse 'lst) -> lst 2583 reverse (x y) 2584 x = ex.Cdr.Car.eval(); 2585 for (y = Nil; x instanceof Cell; x = x.Cdr) 2586 y = new Cell(x.Car, y); 2587 return y; 2588 2589 # (flip 'lst ['cnt])) -> lst 2590 flip (i x y z) 2591 if (!((y = (ex = ex.Cdr).Car.eval()) instanceof Cell) || !((z = y.Cdr) instanceof Cell)) 2592 return y; 2593 if (ex.Cdr == Nil) { 2594 y.Cdr = Nil; 2595 for (;;) { 2596 x = z.Cdr; z.Cdr = y; 2597 if (!(x instanceof Cell)) 2598 return z; 2599 y = z; z = x; 2600 } 2601 } 2602 if ((i = evInt(ex.Cdr) - 1) <= 0) 2603 return y; 2604 y.Cdr = z.Cdr; z.Cdr = y; 2605 while (--i != 0 && (x = y.Cdr) instanceof Cell) { 2606 y.Cdr = x.Cdr; x.Cdr = z; z = x; 2607 } 2608 return z; 2609 2610 # (trim 'lst) -> lst 2611 trim () 2612 return trim(ex.Cdr.Car.eval()); 2613 2614 # (clip 'lst) -> lst 2615 clip (x) 2616 for (x = ex.Cdr.Car.eval(); x instanceof Cell && isBlank(x.Car); x = x.Cdr); 2617 return trim(x); 2618 2619 # (head 'cnt|lst 'lst) -> lst 2620 head (i x y z) 2621 if ((z = (x = ex.Cdr).Car.eval()) == Nil) 2622 return Nil; 2623 x = x.Cdr.Car.eval(); 2624 if (z instanceof Cell) { 2625 if (x instanceof Cell) { 2626 for (y = z; y.Car.equal(x.Car); x = x.Cdr) 2627 if (!((y = y.Cdr) instanceof Cell)) 2628 return z; 2629 } 2630 return Nil; 2631 } 2632 if ((i = xInt(z)) == 0) 2633 return Nil; 2634 if (!(x instanceof Cell)) 2635 return x; 2636 if (i < 0 && (i += x.length()) <= 0) 2637 return Nil; 2638 z = y = new Cell(x.Car, Nil); 2639 while (--i != 0 && (x = x.Cdr) instanceof Cell) 2640 y = y.Cdr = new Cell(x.Car, Nil); 2641 return z; 2642 2643 # (tail 'cnt|lst 'lst) -> lst 2644 tail (i x y z) 2645 if ((z = (x = ex.Cdr).Car.eval()) == Nil) 2646 return Nil; 2647 x = x.Cdr.Car.eval(); 2648 if (z instanceof Cell) { 2649 if (x instanceof Cell) { 2650 do 2651 if (x.equal(z)) 2652 return z; 2653 while ((x = x.Cdr) instanceof Cell); 2654 } 2655 return Nil; 2656 } 2657 if ((i = xInt(z)) == 0) 2658 return Nil; 2659 if (!(x instanceof Cell)) 2660 return x; 2661 if (i < 0) 2662 return nth(1 - i, x); 2663 for (y = x.Cdr; --i != 0; y = y.Cdr) 2664 if (!(y instanceof Cell)) 2665 return x; 2666 while (y instanceof Cell) { 2667 x = x.Cdr; y = y.Cdr; 2668 } 2669 return x; 2670 2671 # (stem 'lst 'any ..) -> lst 2672 stem (i j x y v) 2673 y = (x = ex.Cdr).Car.eval(); 2674 for (v = new Any[6], i = 0; (x = x.Cdr) instanceof Cell; ++i) 2675 v = append(v, i, x.Car.eval()); 2676 for (x = y; x instanceof Cell; x = x.Cdr) 2677 for (j = 0; j < i; ++j) 2678 if (x.Car.equal(v[j])) { 2679 y = x.Cdr; 2680 break; 2681 } 2682 return y; 2683 2684 # (fin 'any) -> num|sym 2685 fin (x) 2686 for (x = ex.Cdr.Car.eval(); x instanceof Cell; x = x.Cdr); 2687 return x; 2688 2689 # (last 'lst) -> any 2690 last (x) 2691 if (!((x = ex.Cdr.Car.eval()) instanceof Cell)) 2692 return x; 2693 while (x.Cdr instanceof Cell) 2694 x = x.Cdr; 2695 return x.Car; 2696 2697 # (== 'any ..) -> flg 2698 == (x y) 2699 y = (x = ex.Cdr).Car.eval(); 2700 while ((x = x.Cdr) instanceof Cell) 2701 if (y != x.Car.eval()) 2702 return Nil; 2703 return T; 2704 2705 # (n== 'any ..) -> flg 2706 n== (x y) 2707 y = (x = ex.Cdr).Car.eval(); 2708 while ((x = x.Cdr) instanceof Cell) 2709 if (y != x.Car.eval()) 2710 return T; 2711 return Nil; 2712 2713 # (= 'any ..) -> flg 2714 = (x y) 2715 y = (x = ex.Cdr).Car.eval(); 2716 while ((x = x.Cdr) instanceof Cell) 2717 if (!y.equal(x.Car.eval())) 2718 return Nil; 2719 return T; 2720 2721 # (<> 'any ..) -> flg 2722 <> (x y) 2723 y = (x = ex.Cdr).Car.eval(); 2724 while ((x = x.Cdr) instanceof Cell) 2725 if (!y.equal(x.Car.eval())) 2726 return T; 2727 return Nil; 2728 2729 # (=0 'any) -> 0 | NIL 2730 =0 () 2731 return ex.Cdr.Car.eval().equal(Zero)? Zero : Nil; 2732 2733 # (=T 'any) -> flg 2734 =T () 2735 return T == ex.Cdr.Car.eval()? T : Nil; 2736 2737 # (n0 'any) -> flg 2738 n0 () 2739 return ex.Cdr.Car.eval().equal(Zero)? Nil : T; 2740 2741 # (nT 'any) -> flg 2742 nT () 2743 return T == ex.Cdr.Car.eval()? Nil : T; 2744 2745 # (< 'any ..) -> flg 2746 < (x y z) 2747 y = (x = ex.Cdr).Car.eval(); 2748 while ((x = x.Cdr) instanceof Cell) { 2749 z = x.Car.eval(); 2750 if (y.compare(z) >= 0) 2751 return Nil; 2752 y = z; 2753 } 2754 return T; 2755 2756 # (<= 'any ..) -> flg 2757 <= (x y z) 2758 y = (x = ex.Cdr).Car.eval(); 2759 while ((x = x.Cdr) instanceof Cell) { 2760 z = x.Car.eval(); 2761 if (y.compare(z) > 0) 2762 return Nil; 2763 y = z; 2764 } 2765 return T; 2766 2767 # (> 'any ..) -> flg 2768 > (x y) 2769 x = (ex = ex.Cdr).Car.eval(); 2770 while (ex.Cdr instanceof Cell) { 2771 y = (ex = ex.Cdr).Car.eval(); 2772 if (x.compare(y) <= 0) 2773 return Nil; 2774 x = y; 2775 } 2776 return T; 2777 2778 # (>= 'any ..) -> flg 2779 >= (x y z) 2780 y = (x = ex.Cdr).Car.eval(); 2781 while ((x = x.Cdr) instanceof Cell) { 2782 z = x.Car.eval(); 2783 if (y.compare(z) < 0) 2784 return Nil; 2785 y = z; 2786 } 2787 return T; 2788 2789 # (max 'any ..) -> any 2790 max (x y) 2791 for (y = (ex = ex.Cdr).Car.eval(); (ex = ex.Cdr) instanceof Cell;) 2792 if ((x = ex.Car.eval()).compare(y) > 0) 2793 y = x; 2794 return y; 2795 2796 # (min 'any ..) -> any 2797 min (x y) 2798 for (y = (ex = ex.Cdr).Car.eval(); (ex = ex.Cdr) instanceof Cell;) 2799 if ((x = ex.Car.eval()).compare(y) < 0) 2800 y = x; 2801 return y; 2802 2803 # (atom 'any) -> flg 2804 atom () 2805 return ex.Cdr.Car.eval() instanceof Cell? Nil : T; 2806 2807 # (pair 'any) -> any 2808 pair (x) 2809 return (x = ex.Cdr.Car.eval()) instanceof Cell? x : Nil; 2810 2811 # (circ? 'any) -> any 2812 circ? (x) 2813 return (x = ex.Cdr.Car.eval()) instanceof Cell && (x = circ(x)) != null? x : Nil; 2814 2815 # (lst? 'any) -> flg 2816 lst? (x) 2817 return (x = ex.Cdr.Car.eval()) instanceof Cell || x == Nil? T : Nil; 2818 2819 # (num? 'any) -> num | NIL 2820 num? (x) 2821 return (x = ex.Cdr.Car.eval()) instanceof Number? x : Nil; 2822 2823 # (sym? 'any) -> flg 2824 sym? (x) 2825 return (x = ex.Cdr.Car.eval()) instanceof Symbol || x == Nil? T : Nil; 2826 2827 # (flg? 'any) -> flg 2828 flg? (x) 2829 return (x = ex.Cdr.Car.eval()) == Nil || x == T? T : Nil; 2830 2831 # (member 'any 'lst) -> any 2832 member (x) 2833 x = (ex = ex.Cdr).Car.eval(); 2834 return (x = member(x, ex.Cdr.Car.eval())) == null? Nil : x; 2835 2836 # (memq 'any 'lst) -> any 2837 memq (x) 2838 x = (ex = ex.Cdr).Car.eval(); 2839 return (x = memq(x, ex.Cdr.Car.eval())) == null? Nil : x; 2840 2841 # (mmeq 'lst 'lst) -> any 2842 mmeq (x y z) 2843 x = (ex = ex.Cdr).Car.eval(); 2844 for (y = (ex = ex.Cdr).Car.eval(); x instanceof Cell; x = x.Cdr) 2845 if ((z = memq(x.Car, y)) != null) 2846 return z; 2847 return Nil; 2848 2849 # (sect 'lst 'lst) -> lst 2850 sect (w x y z) 2851 y = (x = ex.Cdr).Car.eval(); 2852 z = x.Cdr.Car.eval(); 2853 w = x = Nil; 2854 while (y instanceof Cell) { 2855 if (member(y.Car, z) != null) 2856 if (x == Nil) 2857 x = w = new Cell(y.Car, Nil); 2858 else 2859 x = x.Cdr = new Cell(y.Car, Nil); 2860 y = y.Cdr; 2861 } 2862 return w; 2863 2864 # (diff 'lst 'lst) -> lst 2865 diff (w x y z) 2866 y = (x = ex.Cdr).Car.eval(); 2867 z = x.Cdr.Car.eval(); 2868 w = x = Nil; 2869 while (y instanceof Cell) { 2870 if (member(y.Car, z) == null) 2871 if (x == Nil) 2872 x = w = new Cell(y.Car, Nil); 2873 else 2874 x = x.Cdr = new Cell(y.Car, Nil); 2875 y = y.Cdr; 2876 } 2877 return w; 2878 2879 # (index 'any 'lst) -> cnt | NIL 2880 index (i x y) 2881 y = (x = ex.Cdr).Car.eval(); 2882 return (i = indx(y, x.Cdr.Car.eval())) == 0? Nil : new Number(i); 2883 2884 # (offset 'lst1 'lst2) -> cnt | NIL 2885 offset (i x y) 2886 y = (x = ex.Cdr).Car.eval(); 2887 x = x.Cdr.Car.eval(); 2888 for (i = 1; x instanceof Cell; ++i, x = x.Cdr) 2889 if (x.equal(y)) 2890 return new Number(i); 2891 return Nil; 2892 2893 # (prior 'lst1 'lst2) -> lst | NIL 2894 prior (x y) 2895 y = (x = ex.Cdr).Car.eval(); 2896 x = x.Cdr.Car.eval(); 2897 if (x != y) 2898 while (x instanceof Cell) { 2899 if (y == x.Cdr) 2900 return x; 2901 x = x.Cdr; 2902 } 2903 return Nil; 2904 2905 # (length 'any) -> cnt | T 2906 length (n) 2907 return (n = ex.Cdr.Car.eval().length()) >= 0? new Number(n) : T; 2908 2909 # (size 'any) -> cnt 2910 size () 2911 return new Number(ex.Cdr.Car.eval().size()); 2912 2913 # (assoc 'any 'lst) -> lst 2914 assoc (x y z) 2915 y = (x = ex.Cdr).Car.eval(); 2916 x = x.Cdr.Car.eval(); 2917 for (; x instanceof Cell; x = x.Cdr) 2918 if ((z = x.Car) instanceof Cell && y.equal(z.Car)) 2919 return z; 2920 return Nil; 2921 2922 # (asoq 'any 'lst) -> lst 2923 asoq (x y z) 2924 y = (x = ex.Cdr).Car.eval(); 2925 x = x.Cdr.Car.eval(); 2926 for (; x instanceof Cell; x = x.Cdr) 2927 if ((z = x.Car) instanceof Cell && y == z.Car) 2928 return z; 2929 return Nil; 2930 2931 # (rank 'any 'lst ['flg]) -> lst 2932 rank (w x y z) 2933 w = (x = ex.Cdr).Car.eval(); 2934 y = (x = x.Cdr).Car.eval(); 2935 z = Nil; 2936 if (x.Cdr.Car.eval() == Nil) 2937 for (; y instanceof Cell; y = y.Cdr) { 2938 if ((x = y.Car) instanceof Cell && x.Car.compare(w) > 0) 2939 break; 2940 z = y; 2941 } 2942 else 2943 for (; y instanceof Cell; y = y.Cdr) { 2944 if ((x = y.Car) instanceof Cell && w.compare(x.Car) > 0) 2945 break; 2946 z = y; 2947 } 2948 return z.Car; 2949 2950 # (match 'lst1 'lst2) -> flg 2951 match (x y) 2952 y = (x = ex.Cdr).Car.eval(); 2953 return match(y, x.Cdr.Car.eval())? T : Nil; 2954 2955 # (fill 'any ['sym|lst]) -> any 2956 fill (x y) 2957 y = (x = ex.Cdr).Car.eval(); 2958 return (x = fill(y, x.Cdr.Car.eval())) == null? y : x; 2959 2960 # (prove 'lst ['lst]) -> lst 2961 prove (i x y) 2962 if (!((y = (ex = ex.Cdr).Car.eval()) instanceof Cell)) 2963 return Nil; 2964 Any dbg = ex.Cdr.Car.eval(), at = At.Car, envSave = Penv, nlSave = Pnl; 2965 Penv = y.Car.Car; y.Car = y.Car.Cdr; 2966 Any n = Penv.Car; Penv = Penv.Cdr; 2967 Pnl = Penv.Car; Penv = Penv.Cdr; 2968 Any alt = Penv.Car; Penv = Penv.Cdr; 2969 Any tp1 = Penv.Car; Penv = Penv.Cdr; 2970 Any tp2 = Penv.Car; Penv = Penv.Cdr; 2971 Any e = Nil; 2972 while (tp1 instanceof Cell || tp2 instanceof Cell) { 2973 if (alt instanceof Cell) { 2974 e = Penv; 2975 if (!unify((Number)Pnl.Car, tp1.Car.Cdr, (Number)n, alt.Car.Car)) { 2976 if (!((alt = alt.Cdr) instanceof Cell)) { 2977 Penv = y.Car.Car; y.Car = y.Car.Cdr; 2978 n = Penv.Car; Penv = Penv.Cdr; 2979 Pnl = Penv.Car; Penv = Penv.Cdr; 2980 alt = Penv.Car; Penv = Penv.Cdr; 2981 tp1 = Penv.Car; Penv = Penv.Cdr; 2982 tp2 = Penv.Car; Penv = Penv.Cdr; 2983 } 2984 } 2985 else { 2986 if (dbg != Nil && memq(tp1.Car.Car, dbg) != null) { 2987 OutFile.Wr.print(indx(alt.Car, tp1.Car.Car.get(T))); 2988 OutFile.space(); 2989 OutFile.print(uniFill(tp1.Car)); 2990 OutFile.newline(); 2991 } 2992 if (alt.Cdr instanceof Cell) 2993 y.Car = 2994 new Cell( 2995 new Cell(n, 2996 new Cell(Pnl, 2997 new Cell(alt.Cdr, 2998 new Cell(tp1, new Cell(tp2, e)) ) ) ), 2999 y.Car ); 3000 Pnl = new Cell(n, Pnl); 3001 n = ((Number)n).add(One); 3002 tp2 = new Cell(tp1.Cdr, tp2); 3003 tp1 = alt.Car.Cdr; 3004 alt = Nil; 3005 } 3006 } 3007 else if (!((x = tp1) instanceof Cell)) { 3008 tp1 = tp2.Car; 3009 tp2 = tp2.Cdr; 3010 Pnl = Pnl.Cdr; 3011 } 3012 else if (x.Car == T) { 3013 while (y.Car instanceof Cell && ((Number)y.Car.Car.Car).Cnt >= ((Number)Pnl.Car).Cnt) 3014 y.Car = y.Car.Cdr; 3015 tp1 = x.Cdr; 3016 } 3017 else if (x.Car.Car instanceof Number) { 3018 e = x.Car.Cdr.prog(); 3019 for (i = ((Number)x.Car.Car).Cnt, x = Pnl; --i > 0;) 3020 x = x.Cdr; 3021 Pnl = new Cell(x.Car, Pnl); 3022 tp2 = new Cell(tp1.Cdr, tp2); 3023 tp1 = e; 3024 } 3025 else if (x.Car.Car == Up) { 3026 if ((e = x.Car.Cdr.Cdr.prog()) != Nil && unify((Number)Pnl.Car, x.Car.Cdr.Car, (Number)Pnl.Car, e)) 3027 tp1 = x.Cdr; 3028 else { 3029 Penv = y.Car.Car; y.Car = y.Car.Cdr; 3030 n = Penv.Car; Penv = Penv.Cdr; 3031 Pnl = Penv.Car; Penv = Penv.Cdr; 3032 alt = Penv.Car; Penv = Penv.Cdr; 3033 tp1 = Penv.Car; Penv = Penv.Cdr; 3034 tp2 = Penv.Car; Penv = Penv.Cdr; 3035 } 3036 } 3037 else if (!((alt = x.Car.Car.get(T)) instanceof Cell)) { 3038 Penv = y.Car.Car; y.Car = y.Car.Cdr; 3039 n = Penv.Car; Penv = Penv.Cdr; 3040 Pnl = Penv.Car; Penv = Penv.Cdr; 3041 alt = Penv.Car; Penv = Penv.Cdr; 3042 tp1 = Penv.Car; Penv = Penv.Cdr; 3043 tp2 = Penv.Car; Penv = Penv.Cdr; 3044 } 3045 } 3046 for (e = Nil, x = Penv; x.Cdr instanceof Cell; x = x.Cdr) 3047 if (x.Car.Car.Car.equal(Zero)) 3048 e = new Cell(new Cell(x.Car.Car.Cdr, lookup(Zero, x.Car.Car.Cdr)), e); 3049 At.Car = at; 3050 x = e instanceof Cell? e : Penv instanceof Cell? T : Nil; 3051 Penv = envSave; Pnl = nlSave; 3052 return x; 3053 3054 # (-> any [num]) -> any 3055 -> (i x) 3056 if (!(ex.Cdr.Cdr.Car instanceof Number)) 3057 return lookup((Number)Pnl.Car, ex.Cdr.Car); 3058 for (i = ((Number)ex.Cdr.Cdr.Car).Cnt, x = Pnl; --i > 0;) 3059 x = x.Cdr; 3060 return lookup((Number)x.Car, ex.Cdr.Car); 3061 3062 # (unify 'any) -> lst 3063 unify (x) 3064 x = ex.Cdr.Car.eval(); 3065 return unify((Number)Pnl.Cdr.Car, x, (Number)Pnl.Car, x)? Penv : Nil; 3066 3067 # (sort 'lst ['fun]) -> lst 3068 sort (x) 3069 return (x = ex.Cdr.Car.eval()) instanceof Cell && x.Cdr instanceof Cell? sort(ex, x, ex.Cdr.Cdr.Car.eval()) : x; 3070 3071 ############ big ############ 3072 # (format 'num ['cnt ['sym1 ['sym2]]]) -> sym 3073 # (format 'sym|lst ['cnt ['sym1 ['sym2]]]) -> num 3074 format (i x y) 3075 x = (ex = ex.Cdr).Car.eval(); 3076 i = (y = (ex = ex.Cdr).Car.eval()) == Nil? 0 : ((Number)y).Cnt; 3077 return format(x, i, ex.Cdr); 3078 3079 # (+ 'num ..) -> num 3080 + (num x) 3081 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3082 return Nil; 3083 for (num = (Number)x; ex.Cdr instanceof Cell; num = num.add((Number)x)) 3084 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3085 return Nil; 3086 return num; 3087 3088 # (- 'num ..) -> num 3089 - (num x) 3090 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3091 return Nil; 3092 num = (Number)x; 3093 if (!(ex.Cdr instanceof Cell)) 3094 return num.neg(); 3095 do { 3096 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3097 return Nil; 3098 num = num.sub((Number)x); 3099 } while (ex.Cdr instanceof Cell); 3100 return num; 3101 3102 # (inc 'num) -> num 3103 # (inc 'var ['num]) -> num 3104 inc (x y) 3105 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3106 return Nil; 3107 if (x instanceof Number) 3108 return ((Number)x).add(One); 3109 if (!(ex.Cdr instanceof Cell)) { 3110 if (x.Car == Nil) 3111 return Nil; 3112 x.Car = y = ((Number)x.Car).add(One); 3113 } 3114 else { 3115 y = ex.Cdr.Car.eval(); 3116 if (x.Car == Nil || y == Nil) 3117 return Nil; 3118 x.Car = y = ((Number)x.Car).add((Number)y); 3119 } 3120 return y; 3121 3122 # (dec 'num) -> num 3123 # (dec 'var ['num]) -> num 3124 dec (x y) 3125 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3126 return Nil; 3127 if (x instanceof Number) 3128 return ((Number)x).sub(One); 3129 if (!(ex.Cdr instanceof Cell)) { 3130 if (x.Car == Nil) 3131 return Nil; 3132 x.Car = y = ((Number)x.Car).sub(One); 3133 } 3134 else { 3135 y = ex.Cdr.Car.eval(); 3136 if (x.Car == Nil || y == Nil) 3137 return Nil; 3138 x.Car = y = ((Number)x.Car).sub((Number)y); 3139 } 3140 return y; 3141 3142 # (* 'num ..) -> num 3143 * (num x) 3144 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3145 return Nil; 3146 for (num = (Number)x; ex.Cdr instanceof Cell; num = num.mul((Number)x)) 3147 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3148 return Nil; 3149 return num; 3150 3151 # (*/ 'num1 ['num2 ..] 'num3) -> num 3152 */ (num x) 3153 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3154 return Nil; 3155 for (num = (Number)x; ; num = num.mul((Number)x)) { 3156 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3157 return Nil; 3158 if (!((ex.Cdr) instanceof Cell)) 3159 return num.add(((Number)x).div(Two)).div(((Number)x)); 3160 } 3161 3162 # (/ 'num ..) -> num 3163 / (num x) 3164 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3165 return Nil; 3166 for (num = (Number)x; ex.Cdr instanceof Cell; num = num.div((Number)x)) 3167 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3168 return Nil; 3169 return num; 3170 3171 # (% 'num ..) -> num 3172 % (num x) 3173 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3174 return Nil; 3175 for (num = (Number)x; ex.Cdr instanceof Cell; num = num.rem((Number)x)) 3176 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3177 return Nil; 3178 return num; 3179 3180 # (>> 'cnt 'num) -> num 3181 >> (i x) 3182 i = evInt(ex = ex.Cdr); 3183 if ((x = ex.Cdr.Car.eval()) == Nil) 3184 return Nil; 3185 return ((Number)x).shift(i); 3186 3187 # (lt0 'any) -> num | NIL 3188 lt0 (x) 3189 return (x = ex.Cdr.Car.eval()) instanceof Number && x.compare(Zero) < 0? x : Nil; 3190 3191 # (le0 'any) -> num | NIL 3192 le0 (x) 3193 return (x = ex.Cdr.Car.eval()) instanceof Number && x.compare(Zero) <= 0? x : Nil; 3194 3195 # (ge0 'any) -> num | NIL 3196 ge0 (x) 3197 return (x = ex.Cdr.Car.eval()) instanceof Number && x.compare(Zero) >= 0? x : Nil; 3198 3199 # (gt0 'any) -> num | NIL 3200 gt0 (x) 3201 return (x = ex.Cdr.Car.eval()) instanceof Number && x.compare(Zero) > 0? x : Nil; 3202 3203 # (abs 'num) -> num 3204 abs () 3205 return ((Number)ex.Cdr.Car.eval()).abs(); 3206 3207 # (bit? 'num ..) -> num | NIL 3208 bit? (num x) 3209 num = (Number)(ex = ex.Cdr).Car.eval(); 3210 while ((ex = ex.Cdr) instanceof Cell) 3211 if ((x = ex.Car.eval()) == Nil || !num.tst((Number)x)) 3212 return Nil; 3213 return num; 3214 3215 # (& 'num ..) -> num 3216 & (num x) 3217 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3218 return Nil; 3219 for (num = (Number)x; ex.Cdr instanceof Cell; num = num.and((Number)x)) 3220 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3221 return Nil; 3222 return num; 3223 3224 # (| 'num ..) -> num 3225 | (num x) 3226 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3227 return Nil; 3228 for (num = (Number)x; ex.Cdr instanceof Cell; num = num.or((Number)x)) 3229 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3230 return Nil; 3231 return num; 3232 3233 # (x| 'num ..) -> num 3234 x| (num x) 3235 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3236 return Nil; 3237 for (num = (Number)x; ex.Cdr instanceof Cell; num = num.xor((Number)x)) 3238 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3239 return Nil; 3240 return num; 3241 3242 # (seed 'any) -> cnt 3243 seed (n) 3244 n = initSeed(ex.Cdr.Car.eval()) * 6364136223846793005L; 3245 return new Number(Seed = n); 3246 3247 # (hash 'any) -> cnt 3248 hash (i j n) 3249 n = initSeed(ex.Cdr.Car.eval()); 3250 i = 64; 3251 j = 0; 3252 do { 3253 if ((((int)n ^ j) & 1) != 0) 3254 j ^= 0x14002; /* CRC Polynom x**16 + x**15 + x**2 + 1 */ 3255 n >>>= 1; j >>= 1; 3256 } while (--i != 0); 3257 return new Number(j + 1); 3258 3259 # (rand ['cnt1 'cnt2] | ['T]) -> cnt | flg 3260 rand (x) 3261 Seed = Seed * 6364136223846793005L + 1; 3262 if ((x = (ex = ex.Cdr).Car.eval()) == Nil) 3263 return new Number(Seed); 3264 if (x == T) 3265 return (Seed & 0x100000000L) == 0? Nil : T; 3266 return new Number(((Number)x).Cnt + (int)(Seed >>> 33) % (evInt(ex.Cdr) + 1 - ((Number)x).Cnt)); 3267 3268 ############ io ############ 3269 # (path 'any) -> sym 3270 path () 3271 return mkStr(path(evString(ex.Cdr))); 3272 3273 # (read ['sym1 ['sym2]]) -> any 3274 read (x y) 3275 if (!((x = ex.Cdr) instanceof Cell)) 3276 x = InFile.read('\0'); 3277 else { 3278 y = x.Car.eval(); 3279 if ((x = InFile.token(y, (x = x.Cdr.Car.eval()) == Nil? '\0' : firstChar(x))) == null) 3280 x = Nil; 3281 } 3282 if (InFile.Name == null && InFile.Chr == '\n') 3283 InFile.Chr = 0; 3284 return x; 3285 3286 # (wait ['cnt] . prg) -> any 3287 wait (i x y) 3288 i = (y = (x = ex.Cdr).Car.eval()) == Nil? -1 : xInt(y); 3289 for (x = x.Cdr; (y = x.prog()) == Nil;) 3290 if ((i = waitFd(ex, -1, i)) == 0) 3291 return x.prog(); 3292 return y; 3293 3294 # (poll 'cnt) -> cnt | NIL 3295 poll (i x) 3296 if ((i = xInt(x = ex.Cdr.Car.eval())) < 0 || i >= InFiles.length) 3297 badFd(ex,x); 3298 if (InFiles[i] == null) 3299 return Nil; 3300 try { 3301 Selector sel = Selector.open(); 3302 if (InFiles[i].ready(sel)) 3303 return x; 3304 InFiles[i].register(sel); 3305 sel.selectNow(); 3306 if (InFiles[i].ready(sel)) 3307 return x; 3308 } 3309 catch (IOException e) {giveup(e);} 3310 return Nil; 3311 3312 # (peek) -> sym 3313 peek () 3314 if (InFile.Chr == 0) 3315 InFile.get(); 3316 return InFile.Chr<0? Nil : mkChar(InFile.Chr); 3317 3318 # (char) -> sym 3319 # (char 'cnt) -> sym 3320 # (char T) -> sym 3321 # (char 'sym) -> cnt 3322 char (x) 3323 if (!((ex = ex.Cdr) instanceof Cell)) { 3324 if (InFile.Chr == 0) 3325 InFile.get(); 3326 x = InFile.Chr < 0? Nil : mkChar(InFile.Chr); 3327 InFile.get(); 3328 return x; 3329 } 3330 if ((x = ex.Car.eval()) instanceof Number) 3331 return x.equal(Zero)? Nil : mkChar(((Number)x).Cnt); 3332 return x == T? mkChar(0x10000) : new Number(firstChar(x)); 3333 3334 # (skip ['any]) -> sym 3335 skip () 3336 return InFile.skipc(firstChar(ex.Cdr.Car.eval())) < 0? Nil : mkChar(InFile.Chr); 3337 3338 # (eol) -> flg 3339 eol () 3340 return InFile.Chr=='\n' || InFile.Chr<=0? T : Nil; 3341 3342 # (eof ['flg]) -> flg 3343 eof () 3344 if (ex.Cdr.Car.eval() != Nil) { 3345 InFile.Chr = -1; 3346 return T; 3347 } 3348 if (InFile.Chr == 0) 3349 InFile.get(); 3350 return InFile.Chr < 0? T : Nil; 3351 3352 # (from 'any ..) -> sym 3353 from (i j k x v) 3354 if ((k = (int)(x = ex.Cdr).length()) == 0) 3355 return Nil; 3356 int[] p = new int[k]; 3357 String[] av = new String[k]; 3358 for (v = new Any[k], i = 0; i < k; ++i, x = x.Cdr) 3359 av[i] = (v[i] = x.Car.eval()).name(); 3360 if (InFile.Chr == 0) 3361 InFile.get(); 3362 while (InFile.Chr >= 0) { 3363 for (i = 0; i < k; ++i) { 3364 for (;;) { 3365 if (av[i].charAt(p[i]) == (char)InFile.Chr) { 3366 if (++p[i] != av[i].length()) 3367 break; 3368 InFile.get(); 3369 return v[i]; 3370 } 3371 if (p[i] == 0) 3372 break; 3373 for (j = 1; --p[i] != 0; ++j) 3374 if (av[i].substring(0, p[i]).equals(av[i].substring(j, j + p[i]))) 3375 break; 3376 } 3377 } 3378 InFile.get(); 3379 } 3380 return Nil; 3381 3382 # (till 'any ['flg]) -> lst|sym 3383 till (x y str sb) 3384 str = evString(x = ex.Cdr); 3385 if (InFile.Chr == 0) 3386 InFile.get(); 3387 if (InFile.Chr < 0 || str.indexOf((char)InFile.Chr) >= 0) 3388 return Nil; 3389 if (x.Cdr.Car.eval() == Nil) { 3390 y = x = new Cell(mkChar(InFile.Chr), Nil); 3391 while (InFile.get() > 0 && str.indexOf((char)InFile.Chr) < 0) 3392 x = x.Cdr = new Cell(mkChar(InFile.Chr), Nil); 3393 return y; 3394 } 3395 sb = new StringBuilder(); 3396 do 3397 sb.append((char)InFile.Chr); 3398 while (InFile.get() > 0 && str.indexOf((char)InFile.Chr) < 0); 3399 return mkStr(sb); 3400 3401 # (line 'flg) -> lst|sym 3402 line (x y sb) 3403 if (InFile.Chr == 0) 3404 InFile.get(); 3405 if (InFile.eol()) 3406 return Nil; 3407 if (ex.Cdr.Car.eval() != Nil) { 3408 sb = new StringBuilder(); 3409 do { 3410 sb.append((char)InFile.Chr); 3411 InFile.get(); 3412 } while (!InFile.eol()); 3413 return mkStr(sb); 3414 } 3415 for (x = y = new Cell(mkChar(InFile.Chr), Nil);;) { 3416 InFile.get(); 3417 if (InFile.eol()) 3418 return x; 3419 y = y.Cdr = new Cell(mkChar(InFile.Chr), Nil); 3420 } 3421 3422 # (any 'sym) -> any 3423 any (x) 3424 if ((x = ex.Cdr.Car.eval()) == Nil) 3425 return Nil; 3426 PicoLispReader rd = new PicoLispReader(x.name(), ' ', '\0'); 3427 rd.get(); 3428 return rd.read0(true); 3429 3430 # (sym 'any) -> sym 3431 sym () 3432 StringWriter sw = new StringWriter(); 3433 PrintWriter wr = new PrintWriter(sw); 3434 wr.print(ex.Cdr.Car.eval().toString()); 3435 return mkStr(sw.toString()); 3436 3437 # (str 'sym ['sym1]) -> lst 3438 # (str 'lst) -> sym 3439 str (x y) 3440 if ((y = (x = ex.Cdr).Car.eval()) == Nil) 3441 return Nil; 3442 if (y instanceof Number) 3443 argError(ex, y); 3444 if (y instanceof Symbol) 3445 return ((Symbol)y).parse(false, (x = x.Cdr) instanceof Cell? x.Car.eval() : null); 3446 StringWriter sw = new StringWriter(); 3447 PrintWriter wr = new PrintWriter(sw); 3448 for (;;) { 3449 wr.print(y.Car.toString()); 3450 if (!((y = y.Cdr) instanceof Cell)) 3451 break; 3452 wr.print(' '); 3453 } 3454 return mkStr(sw.toString()); 3455 3456 # (load 'any ..) -> any 3457 load (x y) 3458 x = ex.Cdr; 3459 do { 3460 if ((y = x.Car.eval()) != T) 3461 y = load(ex, '>', y); 3462 else 3463 y = loadAll(ex); 3464 } while ((x = x.Cdr) instanceof Cell); 3465 return y; 3466 3467 # (in 'any . prg) -> any 3468 in (x) 3469 Env.pushInFile((x = ex.Cdr).Car.eval().rdOpen(ex)); 3470 x = x.Cdr.prog(); 3471 Env.popInFiles(); 3472 return x; 3473 3474 # (out 'any . prg) -> any 3475 out (x) 3476 Env.pushOutFile((x = ex.Cdr).Car.eval().wrOpen(ex)); 3477 x = x.Cdr.prog(); 3478 Env.popOutFiles(); 3479 return x; 3480 3481 # (open 'any) -> cnt | NIL 3482 open (str) 3483 str = evString(ex.Cdr); 3484 try {return new Number(new PicoLispReader(new FileReader(str), str, allocFd(), null, 0).Fd);} 3485 catch (IOException e) {} 3486 return Nil; 3487 3488 # (close 'cnt) -> cnt | NIL 3489 close (i x) 3490 if ((i = xInt(x = ex.Cdr.Car.eval())) >= 0 && i < InFiles.length) { 3491 if (InFiles[i] != null) { 3492 InFiles[i].close(); 3493 if (OutFiles[i] != null) 3494 OutFiles[i].close(); 3495 return x; 3496 } 3497 if (OutFiles[i] != null) { 3498 OutFiles[i].close(); 3499 return x; 3500 } 3501 } 3502 return Nil; 3503 3504 # (echo ['cnt ['cnt]] | ['sym ..]) -> sym 3505 echo (i j k n x y v) 3506 y = (x = ex.Cdr).Car.eval(); 3507 if (InFile.Chr == 0) 3508 InFile.get(); 3509 if (y == Nil && !(x.Cdr instanceof Cell)) { 3510 while (InFile.Chr >= 0) { 3511 OutFile.Wr.print((char)InFile.Chr); 3512 InFile.get(); 3513 } 3514 return T; 3515 } 3516 if (y instanceof Symbol) { 3517 k = (int)x.length(); 3518 int[] p = new int[k]; 3519 String[] av = new String[k]; 3520 for (v = new Any[k], i = 0; i < k; ++i, y = (x = x.Cdr).Car.eval()) 3521 av[i] = (v[i] = y).name(); 3522 int m = -1, d, om, op = 0; /* Brain-dead Java: 'op' _is_ initialized */ 3523 while (InFile.Chr >= 0) { 3524 if ((om = m) >= 0) 3525 op = p[m]; 3526 for (i = 0; i < k; ++i) { 3527 for (;;) { 3528 if (av[i].charAt(p[i]) == (char)InFile.Chr) { 3529 if (++p[i] != av[i].length()) { 3530 if (m < 0 || p[i] > p[m]) 3531 m = i; 3532 break; 3533 } 3534 if (om >= 0) 3535 for (j = 0, d = op-p[i]; j <= d; ++j) 3536 OutFile.Wr.print(av[om].charAt(j)); 3537 InFile.Chr = 0; 3538 return v[i]; 3539 } 3540 if (p[i] == 0) 3541 break; 3542 for (j = 1; --p[i] != 0; ++j) 3543 if (av[i].substring(0, p[i]).equals(av[i].substring(j, j + p[i]))) 3544 break; 3545 if (m == i) 3546 for (m = -1, j = 0; j < k; ++j) 3547 if (p[j] != 0 && (m < 0 || p[j] > p[m])) 3548 m = j; 3549 } 3550 } 3551 if (m < 0) { 3552 if (om >= 0) 3553 for (i = 0; i < op; ++i) 3554 OutFile.Wr.print(av[om].charAt(i)); 3555 OutFile.Wr.print((char)InFile.Chr); 3556 } 3557 else if (om >= 0) 3558 for (i = 0, d = op-p[m]; i <= d; ++i) 3559 OutFile.Wr.print(av[om].charAt(i)); 3560 InFile.get(); 3561 } 3562 return Nil; 3563 } 3564 if ((x = x.Cdr) instanceof Cell) { 3565 for (n = xLong(y), y = x.Car.eval(); --n >= 0; InFile.get()) 3566 if (InFile.Chr < 0) 3567 return Nil; 3568 } 3569 if ((n = xLong(y)) > 0) { 3570 for (;;) { 3571 if (InFile.Chr < 0) 3572 return Nil; 3573 OutFile.Wr.print((char)InFile.Chr); 3574 if (--n == 0) 3575 break; 3576 InFile.get(); 3577 } 3578 } 3579 InFile.Chr = 0; 3580 return T; 3581 3582 # (prin 'any ..) -> any 3583 prin (x) 3584 for (x = Nil; (ex = ex.Cdr) instanceof Cell; OutFile.Wr.print((x = ex.Car.eval()).name())); 3585 return x; 3586 3587 # (prinl 'any ..) -> any 3588 prinl (x) 3589 for (x = Nil; (ex = ex.Cdr) instanceof Cell; OutFile.Wr.print((x = ex.Car.eval()).name())); 3590 OutFile.newline(); 3591 return x; 3592 3593 # (space ['cnt]) -> cnt 3594 space (i x) 3595 if ((x = ex.Cdr.Car.eval()) == Nil) { 3596 OutFile.space(); 3597 return One; 3598 } 3599 for (i = xInt(x); i > 0; --i) 3600 OutFile.space(); 3601 return x; 3602 3603 # (print 'any ..) -> any 3604 print (x y) 3605 OutFile.print(y = (x = ex.Cdr).Car.eval()); 3606 while ((x = x.Cdr) instanceof Cell) { 3607 OutFile.space(); 3608 OutFile.print(y = x.Car.eval()); 3609 } 3610 return y; 3611 3612 # (printsp 'any ..) -> any 3613 printsp (x y) 3614 x = ex.Cdr; 3615 do { 3616 OutFile.print(y = x.Car.eval()); 3617 OutFile.space(); 3618 } while ((x = x.Cdr) instanceof Cell); 3619 return y; 3620 3621 # (println 'any ..) -> any 3622 println (x y) 3623 OutFile.print(y = (x = ex.Cdr).Car.eval()); 3624 while ((x = x.Cdr) instanceof Cell) { 3625 OutFile.space(); 3626 OutFile.print(y = x.Car.eval()); 3627 } 3628 OutFile.newline(); 3629 return y; 3630 3631 # (flush) -> flg 3632 flush () 3633 return OutFile.Wr.checkError()? Nil : T; 3634 3635 ############ net ############ 3636 # (port 'cnt) -> cnt 3637 port () 3638 try { 3639 ServerSocketChannel chan = ServerSocketChannel.open();; 3640 chan.socket().bind(new InetSocketAddress(evInt(ex.Cdr))); 3641 return new Number(new PicoLispReader(null, allocFd(), chan, SelectionKey.OP_ACCEPT).Fd); 3642 } 3643 catch (IOException e) {err(ex, null, e.toString());} 3644 return Nil; 3645 3646 # (accept 'cnt) -> cnt | NIL 3647 accept (i x) 3648 if ((i = xInt(x = ex.Cdr.Car.eval())) < 0 || i >= InFiles.length || InFiles[i] == null || InFiles[i].Chan == null) 3649 err(ex, x, "Bad socket"); 3650 return (x = accept(ex, i)) == null? Nil : x; 3651 3652 # (listen 'cnt1 ['cnt2]) -> cnt | NIL 3653 listen (i j x y) 3654 if ((i = xInt(y = (x = ex.Cdr).Car.eval())) < 0 || i >= InFiles.length || InFiles[i] == null || InFiles[i].Chan == null) 3655 err(ex, y, "Bad socket"); 3656 j = (y = x.Cdr.Car.eval()) == Nil? -1 : xInt(y); 3657 for (;;) { 3658 if (waitFd(ex, i, j) == 0) 3659 return Nil; 3660 if ((y = accept(ex, i)) != null) 3661 return y; 3662 } 3663 3664 # (connect 'any 'cnt) -> cnt | NIL 3665 connect () 3666 try { 3667 SocketChannel chan = SocketChannel.open(); 3668 if (chan.connect(new InetSocketAddress(evString(ex.Cdr), evInt(ex.Cdr.Cdr)))) 3669 return mkSocket(chan); 3670 } 3671 catch (IOException e) {} 3672 return Nil; 3673 3674 # vi:et:ts=3:sw=3