wl

commit 3d41ab29bd5f483d8f46aa7254327ef6e77cf85b
parent 204feba4ab5e7c78f5b67c490ba25930cdee9759
Author: tomas <tomas@logand.com>
Date:   Sun, 11 Oct 2009 22:07:19 +0200

pass, prin fix, more in lisp

Diffstat:
M
java.wl
 | 
67
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----
M
wl.java
 | 
23
++++++++++++++++++-----

2 files changed, 81 insertions(+), 9 deletions(-)
diff --git a/java.wl b/java.wl
@@ -84,6 +84,17 @@
          (NIL (eval (car X) 1) (run (cdr X) 1))
          (up @ @) ) ) )
 
+(de case (C . L)
+   (up @ C)
+   (use X
+      (loop
+         (NIL L)
+         (setq X (pop 'L))
+         (T (if (atom (car X))
+               (or (=T (car X)) (= C (car X)))
+               (member C (car X)) )
+            (run (cdr X) 1)) ) ) )
+
 (de prog P (run P 1))
 (de prog1 (E . P) (up @ E) (run P 1) E)
 (de prog2 (E F . P) (up @ F) (run P 1) F)
@@ -156,6 +167,53 @@
 #          (def 'K V)
 #          (run L 1 '(K)) ) ) ) # TODO
 
+(de reverse (L)
+   (let Z NIL
+      (while L
+         (push 'Z (pop 'L)) )
+      Z ) )
+
+(de member (I L)
+   (let X L
+      (loop
+         (T (atom L) (and (= I L) L))
+         (T (= I (car L)) L)
+         (T (== X (setq L (cdr L)))) ) ) )
+
+(de memq (I L)
+   (let X L
+      (loop
+         (T (atom L) (and (== I L) L))
+         (T (== I (car L)) L)
+         (T (== X (setq L (cdr L)))) ) ) )
+
+(de full (L)
+   (not (memq NIL L)) )
+
+(de assoc (I L)
+   (loop
+      (NIL L)
+      (T (= I (caar L)) (car L))
+      (pop 'L) ) )
+
+(de asoq (I L)
+   (loop
+      (NIL L)
+      (T (== I (caar L)) (car L))
+      (pop 'L) ) )
+
+(de fin (X)
+   (loop
+      (NIL (pair X) X)
+      (pop 'X) ) )
+
+(de last (L)
+   (ifn (pair L)
+      L
+      (while (pair (cdr L))
+         (pop 'L) )
+      (car L) ) )
+      
 (de println @
    (pass print)
    (prin "^J") )
@@ -164,8 +222,6 @@
    (pass prin)
    (prin "^J") )
 
-# java
-
 (de jclass (N) (java.lang.Class 'forName N))
 
 (de gc () (`((jclass 'java.lang.Runtime) 'getRuntime) 'gc))
@@ -208,12 +264,15 @@
          (NIL L Z)
          (setq Y (eval (pop 'L) 1))
          (NIL Y)
-         (setq Z (Z 'reminder Y)) ) ) )
+         (setq Z (Z 'remainder Y)) ) ) )
 
 (de + @ (- (pass - 0)))
 
+(de =0 (N) (when (= 0 N) N))
+(de n0 (N) (not(=0 N)))
+
 (de jnum (X)
-   (jnew `(jclass 'java.math.BigInteger) (X ' toString)) )
+   (jnew `(jclass 'java.math.BigInteger) (X 'toString)) )
 
 (de heap @
    (let R `((jclass 'java.lang.Runtime) 'getRuntime)
diff --git a/wl.java b/wl.java
@@ -526,6 +526,21 @@ class wl implements Runnable {
             }
             return eval(X, n, L);
         }});
+        fn("pass", new Fn() {public Any fn(Any E) {
+            Any A = mkCons(NIL, NIL);
+            Any B = A;
+            E = E.cdr();
+            while(E.isCons()) {
+                B = B.cdr(mkCons(E.car(), NIL));
+                E = E.cdr();
+            }
+            Any C = Args.val().cdr();
+            while(C.isCons()) {
+                B = B.cdr(mkCons(mkCons(Qte, C.car()), NIL));
+                C = C.cdr();
+            }
+            return eval(A.cdr());
+        }});
         fn("quote", new Fn() {public Any fn(Any E) {return E.cdr();}});
         fn("car", new Fn() {public Any fn(Any E) {return eval(E.cdr().car()).car();}});
         fn("cdr", new Fn() {public Any fn(Any E) {return eval(E.cdr().car()).cdr();}});
@@ -591,11 +606,8 @@ class wl implements Runnable {
             PrintStream S = (PrintStream) Out.val().obj();
             Any Z = NIL;
             int I = 0;
-            for(Any X = E.cdr(); NIL != X; X = X.cdr()) {
-                if(0 < I++) S.print(' ');
-                Z = eval(X.car());
-                prin(Z);
-            }
+            for(Any X = E.cdr(); NIL != X; X = X.cdr())
+                prin(eval(X.car()));
             return Z;
         }});
         fn("pack", new Fn() {public Any fn(Any E) {
@@ -932,6 +944,7 @@ class wl implements Runnable {
         wl X = new wl();
         X.load("java.wl"); // TODO from args
         X.run();
+        //(new Thread(new wl())).start();
     }
 }