wl.java (55324B)
1 // wl.java -- (c) 2009 Tomas Hlavaty 2 3 import java.io.UnsupportedEncodingException; 4 import java.io.ByteArrayOutputStream; 5 import java.lang.reflect.Constructor; 6 import java.lang.reflect.InvocationTargetException; 7 import java.lang.reflect.Method; 8 import java.io.PrintStream; 9 import java.util.HashMap; 10 import java.math.BigInteger; 11 import java.io.InputStream; 12 import java.util.ArrayList; 13 import java.lang.reflect.Field; 14 import java.io.FileInputStream; 15 import java.io.FileNotFoundException; 16 import java.util.Comparator; 17 import java.util.List; 18 import java.util.LinkedList; 19 import java.util.Collections; 20 import java.lang.reflect.Proxy; 21 import java.lang.reflect.InvocationHandler; 22 import java.util.concurrent.BlockingQueue; 23 import java.util.concurrent.LinkedBlockingQueue; 24 import java.io.IOException; 25 import java.util.Arrays; 26 import java.util.Iterator; 27 28 class wl implements Runnable { 29 30 final static String Enc = "UTF-8"; 31 32 void dbg(String M) { 33 System.out.println(M); 34 } 35 void dbg(String M, Any E) { 36 System.out.print(M); 37 System.out.print(' '); 38 print(E); 39 System.out.println(); 40 } 41 void dbg(String M, Any E, Any F) { 42 System.out.print(M); 43 System.out.print(' '); 44 print(E); 45 System.out.print(' '); 46 print(F); 47 System.out.println(); 48 } 49 void dbg(String M, Any E, Any F, Any G, Any H) { 50 System.out.print(M); 51 System.out.print(' '); 52 print(E); 53 System.out.print(' '); 54 print(F); 55 System.out.print(' '); 56 print(G); 57 System.out.print(' '); 58 print(H); 59 System.out.println(); 60 } 61 62 void err(Object X, String M) { 63 if(null != X && X instanceof Any) 64 throw new RuntimeException(M + ": " + str((Any) X)); 65 throw new RuntimeException(M + ": " + X); 66 } 67 void err(Object X, Exception M) { 68 if(null != X && X instanceof Any) 69 throw 70 new RuntimeException(M + ":: " + M.getMessage() + ": " + str((Any) X)); 71 throw new RuntimeException(M + ": " + X); 72 } 73 static void err(String M) {throw new RuntimeException(M);} 74 75 static public interface Fn { 76 public Any fn(Any E); 77 } 78 79 static interface Any { 80 public String nm(); 81 public Any car(); 82 public Any cdr(); 83 public Any val(); 84 public Any prop(); 85 public Object obj(); 86 public Any car(Any a); 87 public Any cdr(Any d); 88 public Any val(Any v); 89 public Any prop(Any p); 90 public Object obj(Object x); 91 public boolean isCons(); 92 public boolean isSym(); 93 public boolean isNsym(); 94 public boolean isAsym(); 95 public boolean isObj(); 96 public boolean isOfn(); 97 public boolean isOstr(); 98 public boolean isOnum(); 99 public boolean isOobj(); 100 } 101 static class Cons implements Any { 102 public Any car, cdr; 103 public Cons(Any a, Any d) {car = a; cdr = d;} 104 public String nm() {err("No Cons.nm"); return null;} 105 public Any car() {return car;} 106 public Any cdr() {return cdr;} 107 public Any val() {err("No Cons.val"); return null;} 108 public Any prop() {err("No Cons.prop"); return null;} 109 public Object obj() {err("No Cons.obj"); return null;} 110 public Any car(Any a) {car = a; return car;} 111 public Any cdr(Any d) {cdr = d; return cdr;} 112 public Any val(Any v) {err("No Cons.val"); return null;} 113 public Any prop(Any p) {err("No Cons.prop"); return null;} 114 public Object obj(Object x) {err("No Cons.obj"); return null;} 115 public boolean isCons() {return true;}; 116 public boolean isSym() {return false;}; 117 public boolean isNsym() {return false;}; 118 public boolean isAsym() {return false;}; 119 public boolean isObj() {return false;}; 120 public boolean isOfn() {return false;}; 121 public boolean isOstr() {return false;}; 122 public boolean isOnum() {return false;}; 123 public boolean isOobj() {return false;}; 124 } 125 static interface Sym extends Any {} 126 static class Nsym implements Sym { 127 public String nm; 128 public Any val, prop; 129 public Nsym(String n, Any v, Any p) {nm = n; val = v; prop = p;} 130 public String nm() {return nm;} 131 public Any car() {if(NIL != this) err("No Nsym.car"); return NIL;} 132 public Any cdr() {if(NIL != this) err("No Nsym.cdr"); return NIL;} 133 public Any val() {return val;} 134 public Any prop() {return prop;} 135 public Object obj() {err("No Nsym.obj"); return null;} 136 public Any car(Any a) {err("No Nsym.car"); return null;} 137 public Any cdr(Any d) {err("No Nsym.cdr"); return null;} 138 public Any val(Any v) {val = v; return val;} 139 public Any prop(Any p) {prop = p; return prop;} 140 public Object obj(Object x) {err("No Nsym.obj"); return null;} 141 public boolean isCons() {return false;}; 142 public boolean isSym() {return true;}; 143 public boolean isNsym() {return true;}; 144 public boolean isAsym() {return false;}; 145 public boolean isObj() {return false;}; 146 public boolean isOfn() {return false;}; 147 public boolean isOstr() {return false;}; 148 public boolean isOnum() {return false;}; 149 public boolean isOobj() {return false;}; 150 } 151 static class Asym implements Sym { 152 public Any val, prop; 153 public Asym(Any v, Any p) {val = v; prop = p;} 154 public String nm() {err("No Asym.nm"); return null;} 155 public Any car() {err("No Asym.car"); return null;} 156 public Any cdr() {err("No Asym.cdr"); return null;} 157 public Any val() {return val;} 158 public Any prop() {return prop;} 159 public Object obj() {err("No Asym.obj"); return null;} 160 public Any car(Any a) {err("No Asym.car"); return null;} 161 public Any cdr(Any d) {err("No Asym.cdr"); return null;} 162 public Any val(Any v) {val = v; return val;} 163 public Any prop(Any p) {prop = p; return prop;} 164 public Object obj(Object x) {err("No Asym.obj"); return null;} 165 public boolean isCons() {return false;}; 166 public boolean isSym() {return true;}; 167 public boolean isNsym() {return false;}; 168 public boolean isAsym() {return true;}; 169 public boolean isObj() {return false;}; 170 public boolean isOfn() {return false;}; 171 public boolean isOstr() {return false;}; 172 public boolean isOnum() {return false;}; 173 public boolean isOobj() {return false;}; 174 } 175 static class Obj implements Any { 176 public Object obj; 177 public Obj(Object x) {obj = x;} 178 public String nm() {err("No Obj.nm"); return null;} 179 public Any car() {err("No Obj.car"); return null;} 180 public Any cdr() {err("No Obj.cdr"); return null;} 181 public Any val() {err("No Obj.val"); return null;} 182 public Any prop() {err("No Obj.prop"); return null;} 183 public Object obj() {return obj;} 184 public Any car(Any a) {err("No Obj.car"); return null;} 185 public Any cdr(Any d) {err("No Obj.cdr"); return null;} 186 public Any val(Any v) {err("No Obj.val"); return null;} 187 public Any prop(Any p) {err("No Obj.prop"); return null;} 188 public Object obj(Object x) {obj = x; return obj;} 189 public boolean isCons() {return false;}; 190 public boolean isSym() {return false;}; 191 public boolean isNsym() {return false;}; 192 public boolean isAsym() {return false;}; 193 public boolean isObj() {return true;}; 194 public boolean isOfn() {return obj instanceof Fn;}; 195 public boolean isOstr() {return obj instanceof String;}; 196 public boolean isOnum() {return obj instanceof BigInteger;}; 197 public boolean isOobj() {return !isOfn() && !isOstr() && !isOnum();}; 198 } 199 200 static Any mkCons(Any a, Any d) {return new Cons(a, d);} 201 static Any mkNsym(String n, Any v) {return new Nsym(n, v, NIL);} 202 static Any mkAsym(Any v, Any p) {return new Asym(v, p);} 203 static Any mkObj(Object x) {return new Obj(x);} 204 static Any mkOint(String x) {return mkObj(new BigInteger(x));} 205 Any mkOfix(String x) { 206 int i = x.indexOf('.'); 207 int l = x.length(); 208 int n = ((BigInteger) Scl.val().obj()).intValue(); 209 n = n < 0 ? -n : n; 210 StringBuffer b = new StringBuffer(); 211 b.append(x.substring(0, i)); 212 int j; 213 for(j = i + 1; j < i + 1 + n; j++) b.append(j < l ? x.charAt(j) : "0"); 214 BigInteger m = new BigInteger(b.toString()); 215 if(j < l && charIn(x.charAt(j), "56789")) m = BigInteger.ONE.add(m); 216 return mkObj(m); 217 } 218 219 final static Any NIL = mkNsym("NIL", null); 220 final static Any T = mkNsym("T", null); 221 222 static { 223 NIL.val(NIL); 224 T.val(T); 225 } 226 227 // reader 228 final static Any Lp = mkObj(null); 229 final static Any Rp = mkObj(null); 230 231 final Any Qte = mkNsym("quote", NIL); 232 final Any Dot = mkNsym(".", NIL); 233 final Any At = mkNsym("@", NIL); 234 final Any Args = mkNsym("*Args", NIL); 235 236 public static class In { 237 InputStream s; 238 int b; // -2 ~ unbound, -1 ~ eof, otherwise 0--255 239 Character c; // null ~ NIL 240 public In(InputStream S) {s = S; clear();} 241 public void close() { 242 try { 243 s.close(); 244 } catch(IOException e) { 245 err("Error closing wl$In"); 246 } 247 } 248 void clear() {b = -2; c = null;} 249 public boolean eof() {return b == -1;} 250 public void eof(Any X) {if(NIL != X) b = -1;} 251 public Character peek() { 252 try { 253 if(-2 == b) { 254 // TODO handle utf-8 myself 255 b = s.read(); 256 if(0 <= b) 257 c = (char) b; 258 } 259 } catch(Exception e) {} // TODO eof vs error? 260 return c; 261 } 262 public Character xchar() { 263 Character Z = peek();; 264 clear(); 265 return Z; 266 } 267 } 268 269 final Any In = mkNsym("*In", mkObj(new In(System.in))); 270 final Any Out = mkNsym("*Out", mkObj(System.out)); 271 final Any Env = mkNsym("*Env", NIL); 272 final Any Stk = mkNsym("*Stk", NIL); 273 final Any Scl = mkNsym("*Scl", mkObj(BigInteger.ZERO)); 274 275 Character peek() {return ((In) In.val().obj()).peek();} 276 Character xchar() {return ((In) In.val().obj()).xchar();} 277 boolean eof() {return ((In) In.val().obj()).eof();} 278 void eof(Any X) {((In) In.val().obj()).eof(X);} 279 280 boolean charIn(Character C, String L) {return 0 <= L.indexOf(C);} 281 void skip1() { 282 Character Z; 283 while(null != (Z = peek()) && charIn(Z, " \t\n\r")) xchar(); 284 } 285 void skip() { 286 skip1(); 287 Character Z; 288 while(null != (Z = peek()) && '#' == Z) { 289 while(null != (Z = peek()) && '\n' != Z) xchar(); 290 skip1(); 291 } 292 } 293 Any symbol() { 294 Character C = xchar(); 295 if(charIn(C, "#()\" \t\n\r")) err(C, "Symbol expected"); 296 boolean N = charIn(C, "+-0123456789."); 297 boolean F = '.' == C; 298 StringBuffer b = new StringBuffer(); 299 b.append(C); 300 while((null != (C = peek())) && !charIn(C, "#()\" \t\n\r")) { 301 C = xchar(); 302 b.append(C); 303 if(N && !charIn(C, "0123456789")) { 304 if(!F && '.' == C) F = true; 305 else N = false; 306 } 307 } 308 String M = b.toString(); 309 if(1 == M.length() && charIn(M.charAt(0), "+-.") 310 || 2 == M.length() && ("+.".equals(M) || "-.".equals(M))) 311 N = false; 312 return N ? (F ? mkOfix(M) : mkOint(M)) : intern(M); 313 } 314 Any text() { 315 StringBuffer L = new StringBuffer(); 316 Character Z; 317 while(null != (Z = peek()) && '"' != Z) { 318 Character C = xchar(); 319 if('\\' == C) C = xchar(); 320 else if('^' == C) { 321 C = xchar(); 322 if('I' == C) C = '\t'; 323 else if('J' == C) C = '\n'; 324 else if('M' == C) C = '\r'; 325 else C = (char) ('?' == C ? 127 : C & 0x1f); 326 } 327 L.append(C); 328 } 329 if('"' != xchar()) err("Unbalanced double quote"); 330 if(0 < L.length()) return mkObj(L.toString()); //.replace(/\r\n/g, "\n"); 331 return NIL; 332 } 333 Any read1(boolean Top) { 334 skip(); 335 Any Z = null; 336 Character X = peek(); 337 if(null != X) { 338 switch(X) { 339 case '(': xchar(); Z = readL(); break; 340 case ')': xchar(); if(Top) err("Reader overflow"); Z = Rp; break; 341 case '"': xchar(); Z = text(); break; 342 case '\'': xchar(); Z = mkCons(Qte, read1(false)); break; 343 case '`': xchar(); Z = eval(read1(false)); break; 344 default: Z = symbol(); 345 } 346 } 347 return Z; 348 } 349 Any readL() { 350 Any A = mkCons(NIL, NIL); 351 Any Z = A; 352 Any X; 353 boolean D = false; 354 while(null != (X = read1(false)) && Rp != X) { 355 if(Dot != X) { 356 Z.cdr(D ? X : mkCons(X, NIL)); 357 if(Z.cdr().isCons()) Z = Z.cdr(); 358 } 359 D = Dot == X; 360 } 361 if(null == X) err("Reader underflow"); 362 if(D) Z.cdr(A.cdr()); 363 return A.cdr(); 364 } 365 public void run() { 366 Any Z = null; 367 System.out.print(": "); 368 while(null != (Z = read1(true))) { 369 Any X = eval(Z); 370 System.out.print("-> "); 371 print(X); 372 System.out.println(); 373 System.out.print(": "); 374 } 375 } 376 377 // evaluator 378 HashMap<String, Any> Id = new HashMap<String, Any>(); 379 380 Any intern(String Nm) { 381 if(!Id.containsKey(Nm)) Id.put(Nm, mkNsym(Nm, NIL)); 382 return Id.get(Nm); 383 } 384 385 Any xrun(Any P, int n, Any L) { 386 Any Z = NIL; 387 Any E = undo(n, L); 388 try { 389 if(P.isCons()) 390 while(NIL != P) { 391 Z = eval(P.car()); 392 P = P.cdr(); 393 } 394 else Z = eval(P); 395 } finally {redo(E);} 396 return Z; 397 } 398 Any xrun(Any P) {return xrun(P, 0, NIL);} 399 Any eval(Any X, int n, Any L) { 400 Any Z = NIL; 401 Any E = undo(n, L); 402 try { 403 if(X.isCons()) Z = apply(X); 404 else if(X.isNsym()) Z = X.val(); 405 else if(X.isObj()) Z = X; 406 else err(X, "Don't know how to eval"); 407 } finally {redo(E);} 408 return Z; 409 } 410 Any eval(Any X) {return eval(X, 0, NIL);} 411 Any apply(Any E) { 412 Any Z = NIL; 413 Any F = eval(E.car()); 414 Stk.val(mkCons(E.car(), Stk.val())); 415 if(F.isCons()) Z = applyC(E, F); 416 else if(F.isOfn()) Z = ((Fn) F.obj()).fn(E); 417 else if(F.isObj()) Z = applyO(E, F); 418 else err(E, "Don't know how to apply"); 419 Stk.val(Stk.val().cdr()); 420 return Z; 421 } 422 Any applyC(Any E, Any F) { 423 Any Z = NIL; 424 Any A = E.cdr(); 425 Any Fa = F.car(); 426 Any Fb = F.cdr(); 427 Any B = NIL; 428 if(Fa.isNsym()) { // (@ . P) | (L . P) | (NIL . P) 429 if(NIL != Fa) { 430 if(At == Fa) B = mkCons(mkCons(Args, mkCons(NIL, mapcarEval(A))), B); 431 else B = mkCons(mkCons(Fa, A), B); 432 } 433 } else if(Fa.isCons()) { // ((L ...) . P) 434 while(Fa.isCons()) { 435 B = mkCons(mkCons(Fa.car(), eval(A.car())), B); 436 Fa = Fa.cdr(); 437 A = A.cdr(); 438 } 439 if(NIL != Fa) { 440 if(At == Fa) B = mkCons(mkCons(Args, mkCons(NIL, mapcarEval(A))), B); 441 else B = mkCons(mkCons(Fa, A), B); 442 } 443 } else err(Fa, "Don't know how to bind"); 444 frame(); 445 while(NIL != B) { 446 bind(B.car().car(), B.car().cdr()); 447 B = B.cdr(); 448 } 449 try {Z = xrun(Fb);} 450 finally {unframe();} 451 return Z; 452 } 453 Any mapcarEval(Any E) { 454 Any A = mkCons(NIL, NIL); 455 Any Z = A; 456 while(E.isCons()) { 457 Z.cdr(mkCons(eval(E.car()), NIL)); 458 Z = Z.cdr(); 459 E = E.cdr(); 460 } 461 return A.cdr(); 462 } 463 464 // runtime dispatch 465 class LtM implements Comparator<Method> { 466 public int compare(Method l, Method r) { 467 // most specific first 468 Class[] lc = l.getParameterTypes(); 469 Class[] rc = r.getParameterTypes(); 470 for(int i = 0, j = 0; i < lc.length && j < rc.length; i++, j++) 471 if(!lc[i].equals(rc[i]) && lc[i].isAssignableFrom(rc[i])) 472 return 1; 473 return lc.length < rc.length ? 1 : -1; 474 } 475 } 476 class LtC implements Comparator<Constructor> { 477 public int compare(Constructor l, Constructor r) { 478 // most specific first 479 Class[] lc = l.getParameterTypes(); 480 Class[] rc = r.getParameterTypes(); 481 for(int i = 0, j = 0; i < lc.length && j < rc.length; i++, j++) 482 if(!lc[i].equals(rc[i]) && lc[i].isAssignableFrom(rc[i])) 483 return 1; 484 return lc.length < rc.length ? 1 : -1; 485 } 486 } 487 final LtM ltM = new LtM(); 488 final LtC ltC = new LtC(); 489 boolean isInstance(Class c, Any A) { 490 if(byte.class == c || Byte.class == c 491 || short.class == c || Short.class == c 492 || int.class == c || Integer.class == c 493 || long.class == c || Long.class == c 494 || float.class == c || Float.class == c 495 || double.class == c || Double.class == c) { 496 Object o = A.obj(); 497 return A.isOnum() 498 || o instanceof Byte || o instanceof Short 499 || o instanceof Integer || o instanceof Long 500 || o instanceof Float || o instanceof Double; 501 } 502 if(boolean.class == c || Boolean.class == c) return true; 503 if(char.class == c || Character.class == c) { 504 if(A.isOstr()) return 1 == ((String) A.obj()).length(); 505 else return A.isNsym() && 1 == A.nm().length(); 506 } 507 if(NIL == A && String.class == c) return true; 508 return c.isInstance(A.isNsym() ? A.nm() : A.obj()); 509 } 510 boolean isApplicable(Method m, Any[] a) { 511 Class[] c = m.getParameterTypes(); 512 if(c.length != a.length) return false; // nargs must be same 513 for(int i = 0; i < c.length; i++) 514 if(!isInstance(c[i], a[i])) // must be instanceof 515 if(a[i] != null || !Object.class.equals(c[i])) 516 return false; 517 return true; 518 } 519 boolean isApplicable(Constructor m, Any[] a) { 520 Class[] c = m.getParameterTypes(); 521 if(c.length != a.length) return false; // nargs must be same 522 for(int i = 0; i < c.length; i++) 523 if(!isInstance(c[i], a[i])) // must be instanceof 524 if(a[i] != null || !Object.class.equals(c[i])) 525 return false; 526 return true; 527 } 528 Method applicableMethod(Class c, String nm, Any[] a) { 529 //Method m = c.getMethod(nm, ta); 530 531 // sort methods 532 final List<Method> methods = new LinkedList<Method>(); 533 for(Method m: c.getMethods()) 534 if(m.getName().equals(nm)) 535 methods.add(m); 536 Collections.sort(methods, ltM); 537 // apply first (most specific) applicable method 538 Method m = null; 539 for(Method method: methods) 540 if(isApplicable(method, a)) { 541 m = method; 542 break; 543 } 544 return m; 545 } 546 Constructor applicableConstructor(Class c, Any[] a) { 547 //Constructor c = ((Class) C.obj()).getConstructor(ta); 548 549 // sort methods 550 final List<Constructor> methods = new LinkedList<Constructor>(); 551 for(Constructor m: c.getConstructors()) 552 methods.add(m); 553 Collections.sort(methods, ltC); 554 // apply first (most specific) applicable method 555 Constructor m = null; 556 for(Constructor method: methods) 557 if(isApplicable(method, a)) { 558 m = method; 559 break; 560 } 561 return m; 562 } 563 Object jarg(Class c, Any A) { 564 if(byte.class == c || Byte.class == c) 565 return A.isOnum() ? ((BigInteger) A.obj()).byteValue() : A.obj(); 566 if(short.class == c || Short.class == c) 567 return A.isOnum() ? ((BigInteger) A.obj()).shortValue() : A.obj(); 568 if(int.class == c || Integer.class == c) 569 return A.isOnum() ? ((BigInteger) A.obj()).intValue() : A.obj(); 570 if(long.class == c || Long.class == c) 571 return A.isOnum() ? ((BigInteger) A.obj()).longValue() : A.obj(); 572 if(float.class == c || Float.class == c) 573 return A.isOnum() ? ((BigInteger) A.obj()).floatValue() : A.obj(); 574 if(double.class == c || Double.class == c) 575 return A.isOnum() ? ((BigInteger) A.obj()).doubleValue() : A.obj(); 576 if(boolean.class == c || Boolean.class == c) return NIL != A; 577 if(char.class == c || Character.class == c) 578 return (A.isOstr() ? (String) A.obj() : A.nm()).charAt(0); 579 if(NIL == A && String.class == c) return ""; 580 if(A.isNsym()) return A.nm(); 581 return A.obj(); 582 } 583 Object[] methodArgs(Method m, Any[] a) { 584 Class[] c = m.getParameterTypes(); 585 Object[] z = new Object[a.length]; 586 for(int i = 0; i < c.length; i++) 587 z[i] = jarg(c[i], a[i]); 588 return z; 589 } 590 Object[] constructorArgs(Constructor m, Any[] a) { 591 Class[] c = m.getParameterTypes(); 592 Object[] z = new Object[a.length]; 593 for(int i = 0; i < c.length; i++) 594 z[i] = jarg(c[i], a[i]); 595 return z; 596 } 597 Any applyO(Any E, Any O) { // 'obj 'meth [arg ...] 598 Any I = E.cdr(); 599 Any F = eval(I.car()); 600 Any A = I.cdr(); 601 Any Z = NIL; 602 ArrayList<Any> a = new ArrayList(); 603 for(Any X = A; NIL != X; X = X.cdr()) 604 a.add(eval(X.car())); 605 Object o = O.obj(); 606 Class c = o instanceof Class ? (Class) o : o.getClass(); 607 String nm = F.isOstr() ? (String) F.obj() : F.nm(); 608 Any[] aa = a.toArray(new Any[a.size()]); 609 try { 610 Method m = applicableMethod(c, nm, aa); 611 if(null == m) err(E, "No applicable method"); 612 Object r = m.invoke(o, methodArgs(m, aa)); 613 Z = mkObj(r); 614 } catch(IllegalAccessException e) { 615 err(E, e); 616 } catch(InvocationTargetException e) { 617 err(E, e); 618 } 619 return Z; 620 } 621 void frame() {Env.val(mkCons(T, Env.val()));} 622 void bind(Any S) {Env.val(mkCons(mkCons(S, S.val()), Env.val()));} 623 void bind(Any S, Any V) {bind(S); S.val(V);} 624 void unbind() { 625 Any E = Env.val(); 626 Any X = E.car(); 627 X.car().val(X.cdr()); 628 Env.val(E.cdr()); 629 } 630 void unbind(int n) {for(int i = 0; i < n; i++) unbind();} 631 void unframe() {while(T != Env.val().car()) unbind(); Env.val(Env.val().cdr());} 632 633 void fn(String Nm, Fn F) { 634 Any Z = Id.get(Nm); 635 if(null != Z) Z.val(mkObj(F)); 636 else Id.put(Nm, mkNsym(Nm, mkObj(F))); 637 } 638 boolean member(Any X, Any L) { 639 for(; L.isCons(); L = L.cdr()) 640 if(X == L.car()) return true; 641 return false; 642 } 643 Any undo(int n, Any L) { 644 Any Z = NIL; 645 Any E = Env.val(); 646 for(int i = 0; i < n; i++) { 647 while(E.isCons() && T != E.car()) { 648 Any C = E.car(); 649 // flip 650 Any F = E; 651 E = E.cdr(); 652 F.cdr(Z); 653 Z = F; 654 // swap 655 Any K = C.car(); 656 if(member(K, L)) C.car(mkCons(K, NIL)); // (K . old) -> ((K) . old) 657 else { // (K . old) -> (K . cur) + set old 658 Any V = K.val(); 659 K.val(C.cdr()); 660 C.cdr(V); 661 } 662 } 663 if(T == E.car()) { 664 // flip 665 Any F = E; 666 E = E.cdr(); 667 F.cdr(Z); 668 Z = F; 669 } 670 } 671 Env.val(E); 672 return Z; 673 } 674 void redo(Any E) { 675 if(NIL != E) { 676 Any X = Env.val(); 677 while(NIL != E) { 678 Any C = E.car(); 679 if(C.isCons()) { 680 // swap 681 Any K = C.car(); 682 if(K.isCons()) C.car(K.car()); // ((K) . old) -> (E . old) 683 else { // (K . cur) -> (K . old) + set cur 684 Any V = K.val(); 685 K.val(C.cdr()); 686 C.cdr(V); 687 } 688 } 689 // flip 690 Any F = E; 691 E = E.cdr(); 692 F.cdr(X); 693 X = F; 694 } 695 Env.val(X); 696 } 697 } 698 boolean eq(Any X, Any Y) { 699 boolean z = true; 700 if(X.isCons()) z = Y.isCons() && eq(X.car(), Y.car()) && eq(X.cdr(), Y.cdr()); 701 else if(X.isSym()) z = Y.isSym() && X == Y; 702 else if(X.isObj()) z = Y.isObj() && X.obj().equals(Y.obj()); 703 else err("Don't know how to eq"); 704 return z; 705 } 706 boolean lt(Any X, Any Y) { // (NIL 123 DEF "abc" (d e f) T) 707 boolean z = true; 708 if(NIL == Y || T == X) z = false; 709 else if(NIL == X || T == Y) z = true; 710 else if(X.isOnum()) 711 z = !Y.isOnum() || 712 ((BigInteger) X.obj()).compareTo((BigInteger) Y.obj()) < 0; 713 else if(X.isSym()) z = Y.isSym() ? X.nm().compareTo(Y.nm()) < 0 : !Y.isOnum(); 714 else if(X.isOstr()) 715 z = Y.isOstr() ? ((String) X.obj()).compareTo((String) Y.obj()) < 0 716 : Y.isCons(); 717 else if(X.isCons()) 718 z = Y.isCons() && 719 (lt(X.car(), Y.car()) || eq(X.car(), Y.car()) && lt(X.cdr(), Y.cdr())); 720 else err("Don't know how to lt"); 721 return z; 722 } 723 724 final wl Wl = this; 725 final BlockingQueue<Any> Que = new LinkedBlockingQueue<Any>(); 726 727 public wl() { 728 Id.put("NIL", NIL); 729 Id.put("T", T); 730 Id.put("quote", Qte); 731 Id.put(".", Dot); 732 Id.put("@", At); 733 Id.put("*Args", Args); 734 Id.put("*In", In); 735 Id.put("*Out", Out); 736 Id.put("*Env", Env); 737 Id.put("*Stk", Stk); 738 Id.put("*Scl", Scl); 739 Id.put("java.lang.Class", mkNsym("java.lang.Class", mkObj(Class.class))); 740 741 fn("run", new Fn() {public Any fn(Any E) { 742 Any I = E.cdr(); 743 Any P = eval(I.car()); 744 int n = 0; 745 Any L = NIL; 746 if(I.cdr().isCons()) { 747 I = I.cdr(); 748 n = ((BigInteger) eval(I.car()).obj()).intValue(); 749 L = eval(I.cdr().car()); 750 } 751 return xrun(P, n, L); 752 }}); 753 fn("eval", new Fn() {public Any fn(Any E) { 754 Any I = E.cdr(); 755 Any X = eval(I.car()); 756 int n = 0; 757 Any L = NIL; 758 if(I.cdr().isCons()) { 759 I = I.cdr(); 760 n = ((BigInteger) eval(I.car()).obj()).intValue(); 761 L = eval(I.cdr().car()); 762 } 763 return eval(X, n, L); 764 }}); 765 fn("pass", new Fn() {public Any fn(Any E) { 766 Any A = mkCons(NIL, NIL); 767 Any B = A; 768 E = E.cdr(); 769 while(E.isCons()) { 770 B = B.cdr(mkCons(E.car(), NIL)); 771 E = E.cdr(); 772 } 773 Any C = Args.val().cdr(); 774 while(C.isCons()) { 775 B = B.cdr(mkCons(mkCons(Qte, C.car()), NIL)); 776 C = C.cdr(); 777 } 778 return eval(A.cdr()); 779 }}); 780 fn("quote", new Fn() {public Any fn(Any E) {return E.cdr();}}); 781 fn("car", new Fn() {public Any fn(Any E) {return eval(E.cdr().car()).car();}}); 782 fn("cdr", new Fn() {public Any fn(Any E) {return eval(E.cdr().car()).cdr();}}); 783 fn("loop", new Fn() {public Any fn(Any E) { 784 while(true) { 785 for(Any X = E.cdr(); X.isCons(); X = X.cdr()) { 786 Any Y = X.car(); 787 if(Y.isCons()) { 788 Any C = Y.car(); 789 if(NIL == C) { 790 Y = Y.cdr(); 791 Any Z = eval(Y.car()); 792 if(NIL == Z) return xrun(Y.cdr()); 793 At.val(Z); 794 } else if(T == C) { 795 Y = Y.cdr(); 796 Any Z = eval(Y.car()); 797 At.val(Z); 798 if(NIL != Z) return xrun(Y.cdr()); 799 } else eval(Y); 800 } else eval(Y); 801 } 802 } 803 }}); 804 fn("==", new Fn() {public Any fn(Any E) { 805 Any I = E.cdr(); 806 if(I.isCons()) { 807 Any X = eval(I.car()); 808 for(I = I.cdr(); I.isCons(); I = I.cdr()) 809 if(X != eval(I.car())) return NIL; 810 } 811 return T; 812 }}); 813 fn("=", new Fn() {public Any fn(Any E) { 814 Any I = E.cdr(); 815 if(I.isCons()) { 816 Any X = eval(I.car()); 817 for(I = I.cdr(); I.isCons(); I = I.cdr()) 818 if(!eq(X, eval(I.car()))) return NIL; 819 } 820 return T; 821 }}); 822 fn("<", new Fn() {public Any fn(Any E) { 823 Any I = E.cdr(); 824 if(I.isCons()) { 825 Any X = eval(I.car()); 826 for(I = I.cdr(); I.isCons(); I = I.cdr()) { 827 Any Y = eval(I.car()); 828 if(!lt(X, Y)) return NIL; 829 X = Y; 830 } 831 } 832 return T; 833 }}); 834 fn("peek", new Fn() {public Any fn(Any E) { 835 Character X = peek(); 836 return null == X ? NIL : mkObj(X.toString()); 837 }}); 838 fn("char", new Fn() {public Any fn(Any E) { 839 Character X = xchar(); 840 return null == X ? NIL : mkObj(X.toString()); 841 }}); 842 fn("print", new Fn() {public Any fn(Any E) { 843 PrintStream S = (PrintStream) Out.val().obj(); 844 Any Z = NIL; 845 int I = 0; 846 for(Any X = E.cdr(); NIL != X; X = X.cdr()) { 847 if(0 < I++) S.print(' '); 848 Z = eval(X.car()); 849 print(Z); 850 } 851 return Z; 852 }}); 853 fn("prin", new Fn() {public Any fn(Any E) { 854 PrintStream S = (PrintStream) Out.val().obj(); 855 Any Z = NIL; 856 int I = 0; 857 for(Any X = E.cdr(); NIL != X; X = X.cdr()) 858 prin(eval(X.car())); 859 return Z; 860 }}); 861 fn("pack", new Fn() {public Any fn(Any E) { 862 ByteArrayOutputStream B = new ByteArrayOutputStream(); 863 PrintStream S = new PrintStream(B); 864 Any O = Out.val(); 865 Out.val(mkObj(S)); 866 for(Any X = E.cdr(); NIL != X; X = X.cdr()) 867 prin(eval(X.car())); 868 Out.val(O); 869 String Z = null; 870 try { 871 Z = B.toString(Enc); 872 S.close(); 873 } catch(UnsupportedEncodingException e) { 874 err(E, "Unsupported encoding " + Enc); 875 } 876 return mkObj(Z); 877 }}); 878 fn("str", new Fn() {public Any fn(Any E) { // TODO 879 Any I = E.cdr(); 880 return mkObj(str(eval(I.car()))); 881 }}); 882 fn("def", new Fn() {public Any fn(Any E) { 883 Any X = E.cdr(); 884 Any A = eval(X.car()); 885 X = X.cdr(); 886 Any B = eval(X.car()); 887 A.val(B); 888 return A; 889 }}); 890 fn("val", new Fn() {public Any fn(Any E) { 891 Any Z = NIL; 892 Any X = eval(E.cdr().car()); 893 if(X.isCons()) Z = X.car(); 894 else if(X.isSym()) Z = X.val(); 895 //else if(X.isObj()) Z = X; 896 else err(E, "Don't know how to val"); 897 return Z; 898 }}); 899 fn("cons2", new Fn() {public Any fn(Any E) { 900 Any X = E.cdr(); 901 return mkCons(eval(X.car()), eval(X.cdr().car())); 902 }}); 903 fn("intern", new Fn() {public Any fn(Any E) { 904 return intern((String) eval(E.cdr().car()).obj()); 905 }}); 906 fn("pop", new Fn() {public Any fn(Any E) { 907 Any Z = NIL; 908 Any X = eval(E.cdr().car()); 909 if(X.isCons()) { 910 Any V = X.car(); 911 Z = V.car(); 912 X.car(V.cdr()); 913 } else if(X.isSym()) { 914 Any V = X.val(); 915 Z = V.car(); 916 X.val(V.cdr()); 917 } else err(E, "Don't know how to pop"); 918 return Z; 919 }}); 920 fn("push", new Fn() {public Any fn(Any E) { 921 Any Z = NIL; 922 Any I = E.cdr(); 923 Any K = eval(I.car()); 924 I = I.cdr(); 925 if(K.isCons()) { 926 Any V = K.car(); 927 while(I.isCons()) { 928 Z = eval(I.car()); 929 I = I.cdr(); 930 V = mkCons(Z, V); 931 } 932 K.car(V); 933 } else if(K.isSym()) { 934 Any V = K.val(); 935 while(I.isCons()) { 936 Z = eval(I.car()); 937 I = I.cdr(); 938 V = mkCons(Z, V); 939 } 940 K.val(V); 941 } else err(E, "Don't know how to push"); 942 return Z; 943 }}); 944 fn("con", new Fn() {public Any fn(Any E) { 945 Any I = E.cdr(); 946 Any L = eval(I.car()); 947 I = I.cdr(); 948 Any Z = eval(I.car()); 949 L.cdr(Z); 950 return Z; 951 }}); 952 fn("set", new Fn() {public Any fn(Any E) { 953 Any Z = NIL; 954 Any I = E.cdr(); 955 while(NIL != I) { 956 Any K = eval(I.car()); 957 I = I.cdr(); 958 Z = eval(I.car()); 959 I = I.cdr(); 960 if(K.isCons()) K.car(Z); 961 else K.val(Z); 962 } 963 return Z; 964 }}); 965 fn("pair", new Fn() {public Any fn(Any E) { 966 Any X = eval(E.cdr().car()); 967 return X.isCons() ? X : NIL; 968 }}); 969 fn("sym?", new Fn() {public Any fn(Any E) { 970 return eval(E.cdr().car()).isSym() ? T : NIL; 971 }}); 972 fn("str?", new Fn() {public Any fn(Any E) { 973 return eval(E.cdr().car()).isOstr() ? T : NIL; 974 }}); 975 fn("num?", new Fn() {public Any fn(Any E) { 976 return eval(E.cdr().car()).isOnum() ? T : NIL; 977 }}); 978 fn("obj?", new Fn() {public Any fn(Any E) { 979 return eval(E.cdr().car()).isObj() ? T : NIL; 980 }}); 981 fn("let", new Fn() {public Any fn(Any E) { 982 Any Z = NIL; 983 Any I = E.cdr(); 984 Any L = I.car(); 985 if(L.isCons()) { // (let (K 'V ...) . P) 986 int n = 0; 987 while(L.isCons()) { 988 Any K = L.car(); 989 L = L.cdr(); 990 Any V = eval(L.car()); 991 L = L.cdr(); 992 bind(K, V); 993 n++; 994 } 995 try {Z = xrun(I.cdr());} 996 finally {unbind(n);} 997 } else if(L.isNsym()) { // (let L 'V . P) 998 I = I.cdr(); 999 Any V = eval(I.car()); 1000 bind(L, V); 1001 try {Z = xrun(I.cdr());} 1002 finally {unbind();} 1003 } else err(E, "Don't know how to let"); 1004 return Z; 1005 }}); 1006 fn("let?", new Fn() {public Any fn(Any E) { 1007 Any Z = NIL; 1008 Any I = E.cdr(); 1009 Any L = I.car(); 1010 I = I.cdr(); 1011 Any V = eval(I.car()); 1012 if(NIL != V) { 1013 bind(L, V); 1014 try {Z = xrun(I.cdr());} 1015 finally {unbind();} 1016 } 1017 return Z; 1018 }}); 1019 fn("use", new Fn() {public Any fn(Any E) { 1020 Any Z = NIL; 1021 Any I = E.cdr(); 1022 Any L = I.car(); 1023 if(L.isCons()) { // (use (K ...) . P) 1024 int n = 0; 1025 while(L.isCons()) { 1026 bind(L.car()); 1027 n++; 1028 L = L.cdr(); 1029 } 1030 try {Z = xrun(I.cdr());} 1031 finally {unbind(n);} 1032 } else if(L.isNsym()) { // (use L . P) 1033 bind(L); 1034 try {Z = xrun(I.cdr());} 1035 finally {unbind();} 1036 } else err(E, "Don't know how to let"); 1037 return Z; 1038 }}); 1039 fn("job", new Fn() {public Any fn(Any E) { 1040 Any Z = NIL; 1041 Any I = E.cdr(); 1042 Any J = eval(I.car()); 1043 if(J.isCons()) { 1044 int n = 0; 1045 Any L = J; 1046 while(L.isCons()) { 1047 Any C = L.car(); 1048 L = L.cdr(); 1049 bind(C.car(), C.cdr()); 1050 n++; 1051 } 1052 try {Z = xrun(I.cdr());} 1053 finally { 1054 L = J; 1055 while(L.isCons()) { 1056 Any C = L.car(); 1057 L = L.cdr(); 1058 C.cdr(C.car().val()); 1059 } 1060 unbind(n); 1061 } 1062 } else err(E, "Don't know how to job"); 1063 return Z; 1064 }}); 1065 fn("bind", new Fn() {public Any fn(Any E) { 1066 Any Z = NIL; 1067 Any I = E.cdr(); 1068 Any L = eval(I.car()); 1069 if(L.isCons()) { // (let (K 'V ...) . P) 1070 int n = 0; 1071 while(L.isCons()) { 1072 Any C = L.car(); 1073 L = L.cdr(); 1074 if(C.isCons()) bind(C.car(), C.cdr()); 1075 else if(C.isSym()) bind(C); 1076 else err(E, "Don't know how to bind"); 1077 n++; 1078 } 1079 try {Z = xrun(I.cdr());} 1080 finally {unbind(n);} 1081 } else if(L.isNsym()) { // (bind L . P) 1082 bind(L); 1083 try {Z = xrun(I.cdr());} 1084 finally {unbind();} 1085 } else err(E, "Don't know how to bind"); 1086 return Z; 1087 }}); 1088 fn("up", new Fn() {public Any fn(Any E) { // (up [cnt] sym ['val]) 1089 Any Z; 1090 Any I = E.cdr(); 1091 Any K = I.car(); 1092 I = I.cdr(); 1093 int n = 1; 1094 if(K.isOnum()) { 1095 n = ((BigInteger) K.obj()).intValue(); 1096 K = I.car(); 1097 I = I.cdr(); 1098 } 1099 if(I.isCons()) { // set 1100 Z = eval(I.car()); 1101 boolean done = false; 1102 for(Any J = Env.val(); J.isCons(); J = J.cdr()) { 1103 Any C = J.car(); 1104 if(T == C) {n--; continue;} 1105 if(n < 1) break; 1106 if(K == C.car()) {if(n <= 1) {C.cdr(Z); done = true; break;}} 1107 } 1108 if(!done) Env.val(mkCons(mkCons(K, Z), Env.val())); 1109 } else { // get 1110 Z = K.val(); 1111 for(Any J = Env.val(); J.isCons(); J = J.cdr()) { 1112 Any C = J.car(); 1113 if(T == C) {n--; continue;} 1114 if(n < 1) break; 1115 if(K == C.car()) {Z = C.cdr(); if(n <= 1) break;} 1116 } 1117 } 1118 return Z; 1119 }}); 1120 fn("up.", new Fn() {public Any fn(Any E) { // (up ['cnt] 'sym ['val]) 1121 Any Z; 1122 Any I = E.cdr(); 1123 Any K = eval(I.car()); 1124 I = I.cdr(); 1125 int n = 1; 1126 if(K.isOnum()) { 1127 n = ((BigInteger) K.obj()).intValue(); 1128 K = eval(I.car()); 1129 I = I.cdr(); 1130 } 1131 if(I.isCons()) { // set 1132 Z = eval(I.car()); 1133 boolean done = false; 1134 for(Any J = Env.val(); J.isCons(); J = J.cdr()) { 1135 Any C = J.car(); 1136 if(T == C) {n--; continue;} 1137 if(n < 1) break; 1138 if(K == C.car()) {if(n <= 1) {C.cdr(Z); done = true; break;}} 1139 } 1140 if(!done) Env.val(mkCons(mkCons(K, Z), Env.val())); 1141 } else { // get 1142 Z = K.val(); 1143 for(Any J = Env.val(); J.isCons(); J = J.cdr()) { 1144 Any C = J.car(); 1145 if(T == C) {n--; continue;} 1146 if(n < 1) break; 1147 if(K == C.car()) {Z = C.cdr(); if(n <= 1) break;} 1148 } 1149 } 1150 return Z; 1151 }}); 1152 fn("box", new Fn() {public Any fn(Any E) { 1153 return mkAsym(eval(E.cdr().car()), NIL); 1154 }}); 1155 fn("box?", new Fn() {public Any fn(Any E) { 1156 return eval(E.cdr().car()).isAsym() ? T : NIL; 1157 }}); 1158 fn("jnew", new Fn() {public Any fn(Any E) { // jnew 'cls [arg ...] 1159 Any I = E.cdr(); 1160 Any C = eval(I.car()); 1161 Any A = I.cdr(); 1162 Any Z = NIL; 1163 ArrayList<Object> a = new ArrayList(); 1164 for(Any X = A; NIL != X; X = X.cdr()) 1165 a.add(eval(X.car())); 1166 Class c = (Class) C.obj(); 1167 Any[] aa = a.toArray(new Any[a.size()]); 1168 try { 1169 Constructor m = applicableConstructor(c, aa); 1170 if(null == m) err(E, "No applicable constructor"); 1171 Object r = m.newInstance(constructorArgs(m, aa)); 1172 Z = mkObj(r); 1173 } catch(InstantiationException e) { 1174 err(E, "InstantiationException"); 1175 } catch(IllegalAccessException e) { 1176 err(E, "IllegalAccessException"); 1177 } catch(InvocationTargetException e) { 1178 err(E, "InvocationTargetException"); 1179 } 1180 return Z; 1181 }}); 1182 fn("jfield", new Fn() {public Any fn(Any E) { // jfield 'obj 'fld ['val] 1183 Any I = E.cdr(); 1184 Any O = eval(I.car()); 1185 I = I.cdr(); 1186 Any F = eval(I.car()); 1187 Any Z = NIL; 1188 try { 1189 Object o = O.obj(); 1190 Class c = o instanceof Class ? (Class) o : o.getClass(); 1191 Field f = c.getField(F.nm()); 1192 if(NIL != I.cdr()) { 1193 Z = eval(I.cdr().car()); 1194 f.set(o, jarg(f.getType(), Z)); 1195 } else Z = mkObj(f.get(o)); 1196 } catch(NoSuchFieldException e) { 1197 err(E, "NoSuchFieldException"); 1198 } catch(IllegalAccessException e) { 1199 err(E, "IllegalAccessException"); 1200 } 1201 return Z; 1202 }}); 1203 fn("jproxy", new Fn() {public Any fn(Any E) { // jproxy 'flg 'fn ['jcls...] 1204 Any Z = NIL; 1205 Any I = E.cdr(); 1206 final Any A = eval(I.car()); 1207 I = I.cdr(); 1208 final Any F = eval(I.car()); 1209 I = I.cdr(); 1210 ArrayList<Class> a = new ArrayList(); 1211 while(NIL != I) { 1212 a.add((Class) eval(I.car()).obj()); 1213 I = I.cdr(); 1214 } 1215 ClassLoader l = this.getClass().getClassLoader(); 1216 Class[] c = a.toArray(new Class[a.size()]); 1217 InvocationHandler h = new InvocationHandler() { 1218 public Object invoke(Object p, Method m, Object[] a) 1219 throws Throwable { 1220 Any X = NIL; 1221 if(null != a) 1222 for(int i = a.length - 1; 0 <= i; i--) 1223 X = mkCons(mkObj(a[i]), X); 1224 //X = mkCons(mkObj(p), X); 1225 //System.out.println(p); 1226 X = mkCons(mkObj(m.getName()), X); 1227 X = mkCons(F, X); 1228 Any Z = NIL; 1229 if(NIL == A) Z = eval(X); 1230 else Que.offer(X); 1231 return Z.isObj() ? Z.obj() : null; 1232 } 1233 }; 1234 Object r = Proxy.newProxyInstance(l, c, h); 1235 Z = mkObj(r); 1236 return Z; 1237 }}); 1238 fn("jeq", new Fn() {public Any fn(Any E) { 1239 Any I = E.cdr(); 1240 if(I.isCons()) { 1241 Object A = eval(I.car()).obj(); 1242 for(I = I.cdr(); I.isCons(); I = I.cdr()) { 1243 Object B = eval(I.car()).obj(); 1244 if(Boolean.TRUE.equals(A)) { 1245 if(!Boolean.TRUE.equals(B)) return NIL; 1246 } else if(Boolean.FALSE.equals(A)) { 1247 if(!Boolean.FALSE.equals(B)) return NIL; 1248 } else if(A != B) return NIL; 1249 } 1250 } 1251 return T; 1252 }}); 1253 fn("jv2l", new Fn() {public Any fn(Any E) { // TODO in lisp! 1254 Object[] x = (Object[]) eval(E.cdr().car()).obj(); 1255 Any Z = NIL; 1256 if(null != x) 1257 for(int i = x.length - 1; 0 <= i; i--) 1258 Z = mkCons(mkObj(x[i]), Z); 1259 return Z; 1260 }}); 1261 fn("wait", new Fn() {public Any fn(Any E) { // wait ['cnt] . prg 1262 Any Z = NIL; 1263 // TODO poll from Que with timeout cnt unless run(prg) 1264 //Any I = E.cdr(); 1265 try { 1266 while(true) { 1267 Any X = Que.take(); 1268 Z = eval(X); 1269 } 1270 } catch(InterruptedException e) { 1271 dbg("InterruptedException"); 1272 } 1273 return Z; 1274 }}); 1275 fn("bye", new Fn() {public Any fn(Any E) { // bye ['cnt] 1276 Any I = E.cdr(); 1277 Any Z = eval(I.car()); 1278 System.exit(Z.isOnum() ? ((BigInteger) Z.obj()).intValue() : 0); 1279 return Z; 1280 }}); 1281 fn("chop", new Fn() {public Any fn(Any E) { 1282 Any V = eval(E.cdr().car()); 1283 String v = V.isNsym() ? V.nm() : V.obj().toString(); 1284 Any Z = NIL; 1285 for(int i = v.length() - 1; 0 <= i; i--) 1286 Z = mkCons(mkObj("" + v.charAt(i)), Z); 1287 return Z; 1288 }}); 1289 fn("flip", new Fn() {public Any fn(Any E) { 1290 Any L = eval(E.cdr().car()); 1291 Any Z = NIL; 1292 while(NIL != L) { 1293 Any F = L; 1294 L = L.cdr(); 1295 F.cdr(Z); 1296 Z = F; 1297 } 1298 return Z; 1299 }}); 1300 fn("finally", new Fn() {public Any fn(Any E) { 1301 Any I = E.cdr(); 1302 Any F = I.car(); 1303 Any P = I.cdr(); 1304 Any Z = NIL; 1305 try {Z = xrun(P);} 1306 finally {eval(F);} 1307 return Z; 1308 }}); 1309 fn("quit", new Fn() {public Any fn(Any E) { 1310 Any I = E.cdr(); 1311 Any C = eval(I.car()); 1312 Any M = eval(I.cdr().car()); 1313 throw new Exc(C, M); 1314 }}); 1315 fn("throw", new Fn() {public Any fn(Any E) { 1316 Any I = E.cdr(); 1317 Any C = eval(I.car()); 1318 Any M = eval(I.cdr().car()); 1319 throw new Exc(C, M); 1320 }}); 1321 fn("catch", new Fn() {public Any fn(Any E) { 1322 Any I = E.cdr(); 1323 Any C = eval(I.car()); 1324 Any P = I.cdr(); 1325 Any Z = NIL; 1326 try {Z = xrun(P);} 1327 catch(Exc e) { 1328 if(T == C || C == e.cnd()) Z = e.msg(); 1329 else throw e; 1330 } 1331 return Z; 1332 }}); 1333 fn("read", new Fn() {public Any fn(Any E) { // TODO 1334 Any Z = read1(true); 1335 return Z == null ? NIL : Z; 1336 }}); 1337 fn("eof", new Fn() {public Any fn(Any E) {return eof() ? T : NIL;}}); 1338 fn("getl", new Fn() {public Any fn(Any E) { // TODO !!! 1339 return eval(E.cdr().car()).prop(); 1340 }}); 1341 fn("putl", new Fn() {public Any fn(Any E) { // TODO !!! 1342 Any I = E.cdr(); 1343 Any X = eval(I.car()); 1344 Any L = eval(I.cdr().car()); 1345 return X.prop(L); 1346 }}); 1347 1348 // optimization by native code rewrite 1349 // 1350 // java wl ErsatzLisp Pil32 Pil64 1351 // +--------------------------------------- 1352 // (fibo 22) | 25 0.19 0.015 0.016 1353 // (fibo 23) | 45 0.25 0.026 0.024 1354 // (fibo 24) | 69 0.36 0.041 0.039 1355 // (fibo 25) | 122 0.52 0.060 0.063 1356 // 1357 // (de fibo (N) 1358 // (if (< N 2) 1359 // 1 1360 // (+ (fibo (dec N)) (fibo (- N 2))) ) ) 1361 // (fibo 25) 1362 // (bye) 1363 // 1364 // $ time cat x |java wl 1365 // $ time cat x |ersatz/picolisp 1366 // $ time cat x |bin/picolisp 1367 1368 fn("de", new Fn() {public Any fn(Any E) { 1369 Any X = E.cdr(); 1370 Any A = X.car(); 1371 A.val(X.cdr()); 1372 return A; 1373 }}); 1374 fn("if", new Fn() {public Any fn(Any E) { 1375 Any X = E.cdr(); 1376 Any Z = NIL; 1377 if(NIL == eval(X.car())) { 1378 Any L = X.cdr().cdr(); 1379 while(NIL != L) { 1380 Z = eval(L.car()); 1381 L = L.cdr(); 1382 } 1383 } else Z = eval(X.cdr().car()); 1384 return Z; 1385 }}); 1386 fn("+", new Fn() {public Any fn(Any E) { 1387 Any L = E.cdr(); 1388 if(NIL == L) return NIL; 1389 Any A = eval(L.car()); 1390 BigInteger z = (BigInteger) A.obj(); 1391 L = L.cdr(); 1392 while(NIL != L) { 1393 Any B = eval(L.car()); 1394 if(NIL == B) return NIL; 1395 z = z.add((BigInteger) B.obj()); 1396 L = L.cdr(); 1397 } 1398 return mkObj(z); 1399 }}); 1400 fn("-", new Fn() {public Any fn(Any E) { 1401 Any L = E.cdr(); 1402 if(NIL == L) return NIL; 1403 Any A = eval(L.car()); 1404 BigInteger z = (BigInteger) A.obj(); 1405 L = L.cdr(); 1406 while(NIL != L) { 1407 Any B = eval(L.car()); 1408 if(NIL == B) return NIL; 1409 z = z.subtract((BigInteger) B.obj()); 1410 L = L.cdr(); 1411 } 1412 return mkObj(z); 1413 }}); 1414 fn("dec", new Fn() {public Any fn(Any E) { 1415 Any X = E.cdr(); 1416 Any A = eval(X.car()); 1417 if(NIL == X.cdr()) { 1418 if(A.isOnum()) return mkObj(((BigInteger) A.obj()).subtract(one)); 1419 else return A.val(mkObj(((BigInteger) A.val().obj()).subtract(one))); 1420 } else { 1421 Any B = eval(X.cdr().car()); 1422 BigInteger n = (BigInteger) B.obj(); 1423 return A.val(mkObj(((BigInteger) A.val().obj()).subtract(n))); 1424 } 1425 }}); 1426 1427 fn("fibo.", new Fibo()); 1428 } 1429 1430 final static BigInteger zero = BigInteger.ZERO; 1431 final static Any Zero = mkObj(zero); 1432 final static BigInteger one = BigInteger.ONE; 1433 final static Any One = mkObj(one); 1434 final static BigInteger two = BigInteger.ONE.add(BigInteger.ONE); 1435 final static Any Two = mkObj(two); 1436 1437 class Fibo implements Fn { 1438 BigInteger fibo(BigInteger n) { 1439 if(-1 == n.compareTo(two)) return one; 1440 else return fibo(n.subtract(one)).add(fibo(n.subtract(two))); 1441 } 1442 public Any fn(Any E) { 1443 Any N = eval(E.cdr().car()); 1444 return mkObj(fibo((BigInteger) N.obj())); 1445 } 1446 } 1447 1448 class Exc extends RuntimeException { 1449 Any C, M; 1450 public Exc(Any c, Any m) {C = c; M = m;} 1451 public String toString() {return str(C) + " -- " + str(M);} 1452 public Any cnd() {return C;} 1453 public Any msg() {return M;} 1454 } 1455 1456 void print(Any E) { 1457 PrintStream S = (PrintStream) Out.val().obj(); 1458 if(E.isCons()) { 1459 Any X = E; 1460 if(Qte == X.car()) { 1461 S.print('\''); 1462 print(X.cdr()); 1463 } else { 1464 S.print('('); 1465 while(X.isCons()) { 1466 print(X.car()); 1467 X = X.cdr(); 1468 if(NIL != X) S.print(' '); 1469 if(E == X) { 1470 S.print('.'); 1471 break; 1472 } 1473 } 1474 if(NIL != X && E != X) { 1475 S.print(". "); 1476 print(X); 1477 } 1478 S.print(')'); 1479 } 1480 } else if(E.isNsym()) S.print(E.nm()); 1481 else if(E.isAsym()) { 1482 String n = E.toString(); 1483 S.print("$" + n.substring(1 + n.lastIndexOf("@"))); 1484 } else if(E.isOnum()) S.print(E.obj()); 1485 else if(E.isOstr()) { 1486 S.print('"'); 1487 String X = (String) E.obj(); 1488 for(int I = 0; I < X.length(); I++) { 1489 Character C = X.charAt(I); 1490 if('\\' == C) S.print("\\\\"); 1491 else if('"' == C) S.print("\\\""); 1492 else S.print(C); 1493 } 1494 S.print('"'); 1495 } else if(E.isObj()) { 1496 S.print('['); 1497 S.print(E.obj()); 1498 S.print(']'); 1499 } else err(E, "Don't know how to print"); 1500 } 1501 Any prin(Any E) { 1502 PrintStream S = (PrintStream) Out.val().obj(); 1503 if(NIL == E); 1504 else if(E.isCons()) { 1505 Any X = E; 1506 while(X.isCons()) { 1507 prin(X.car()); 1508 X = X.cdr(); 1509 } 1510 prin(X); 1511 } else if(E.isNsym()) S.print(E.nm()); 1512 else if(E.isAsym()) { 1513 String n = E.toString(); 1514 S.print("$" + n.substring(1 + n.lastIndexOf("@"))); 1515 } else if(E.isObj()) S.print(E.obj()); 1516 else err(E, "Don't know how to print"); 1517 return E; 1518 } 1519 1520 String str(Any E) { 1521 ByteArrayOutputStream B = new ByteArrayOutputStream(); 1522 PrintStream S = new PrintStream(B); 1523 Any O = Out.val(); 1524 Out.val(mkObj(S)); 1525 print(E); 1526 Out.val(O); 1527 String Z = null; 1528 try { 1529 Z = B.toString(Enc); 1530 S.close(); 1531 } catch(UnsupportedEncodingException e) { 1532 err(E, "Unsupported encoding " + Enc); 1533 } 1534 return Z; 1535 } 1536 1537 public void load(String F) { 1538 Any I = In.val(); 1539 try { 1540 In.val(mkObj(new In(new FileInputStream(F)))); 1541 Any Z; 1542 while(null != (Z = read1(true))) eval(Z); 1543 } catch(FileNotFoundException e) { 1544 err(F, "File not found"); 1545 } finally { 1546 In.val(I); 1547 } 1548 } 1549 1550 public static void main(String args[]) { 1551 wl X = new wl(); 1552 X.load("java.wl"); // TODO from args 1553 X.run(); 1554 //(new Thread(new wl())).start(); 1555 } 1556 }