wl

commit 1700a61b8d7201b8a47447913115852e40f29eeb
parent 01b71465d522197dcb2f1bb16535786b4e058a71
Author: tomas <tomas@logand.com>
Date:   Sat, 17 Oct 2009 01:41:47 +0200

mkOfix, chop, flip, on, off, onOff, zero, one, default, mapping

Diffstat:
M
java.wl
 | 
119
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
M
wl.java
 | 
33
++++++++++++++++++++++++++++++++-

2 files changed, 151 insertions(+), 1 deletion(-)
diff --git a/java.wl b/java.wl
@@ -132,6 +132,35 @@
          (up. K V) )
       V ) )
 
+(de on L
+   (while L
+      (up. (pop 'L) T) ) )
+      
+(de off L
+   (while L
+      (up. (pop 'L) NIL) ) )
+
+(de onOff L
+   (use X
+      (while L
+         (setq X (pop 'L))
+         (up. X (not (val X))) ) ) )
+
+(de zero L
+   (while L
+      (up. (pop 'L) 0) ) )
+
+(de one L
+   (while L
+      (up. (pop 'L) 1) ) )
+
+(de default L # L collide
+   (use (X Y)
+      (while L
+         (setq X (pop 'L) Y (eval (pop 'L) 1))
+         (unless (val X)
+            (up. X Y) ) ) ) )
+
 (de and L
    (loop
       (NIL (eval (pop 'L) 1))
@@ -286,3 +315,93 @@
 (def 'true (jfield (jclass 'java.lang.Boolean) 'TRUE))
 (def 'false (jfield (jclass 'java.lang.Boolean) 'FALSE))
 (def 'null (gc))
+
+# mapping
+#
+# |          | last |  link   | chain  |
+# |----------+------+---------+--------|
+# | car      | mapc | mapcar  | mapcan |
+# | cdr      | map  | maplist | mapcon |
+# | car prop | maps |    -    |   -    |
+
+(de map (F . @)
+   (let (L (rest) M NIL A (need (length L)) B NIL E)
+      (loop
+         (setq M L B A E T)
+         (while M
+            (setq E (and E (atom (car M))))
+            (set B (car M))
+            (pop M)
+            (pop 'M)
+            (pop 'B) )
+         (T E)
+         (apply F A) ) ) )
+
+(de mapc (F . @)
+   (let (L (rest) M NIL A (need (length L)) B NIL E)
+      (loop
+         (setq M L B A E T)
+         (while M
+            (setq E (and E (atom (car M))))
+            (set B (pop M))
+            (pop 'M)
+            (pop 'B) )
+         (T E)
+         (apply F A) ) ) )
+
+(de mapcan (F . @)
+   (let (L (rest) M NIL A (need (length L)) B NIL E)
+      (make
+         (loop
+            (setq M L B A E T)
+            (while M
+               (setq E (and E (atom (car M))))
+               (set B (pop M))
+               (pop 'M)
+               (pop 'B) )
+            (T E)
+            (chain (apply F A)) ) ) ) )
+
+(de mapcar (F . @)
+   (let (L (rest) M NIL A (need (length L)) B NIL E)
+      (make
+         (loop
+            (setq M L B A E T)
+            (while M
+               (setq E (and E (atom (car M))))
+               (set B (pop M))
+               (pop 'M)
+               (pop 'B) )
+            (T E)
+            (link (apply F A)) ) ) ) )
+
+(de mapcon (F . @)
+   (let (L (rest) M NIL A (need (length L)) B NIL E)
+      (make
+         (loop
+            (setq M L B A E T)
+            (while M
+               (setq E (and E (atom (car M))))
+               (set B (car M))
+               (pop M)
+               (pop 'M)
+               (pop 'B) )
+            (T E)
+            (chain (apply F A)) ) ) ) )
+
+(de maplist (F . @)
+   (let (L (rest) M NIL A (need (length L)) B NIL E)
+      (make
+         (loop
+            (setq M L B A E T)
+            (while M
+               (setq E (and E (atom (car M))))
+               (set B (car M))
+               (pop M)
+               (pop 'M)
+               (pop 'B) )
+            (T E)
+            (link (apply F A)) ) ) ) )
+
+(de maps (F S . @)
+   (apply mapc (cons (getl S) (rest)) F) )
diff --git a/wl.java b/wl.java
@@ -164,7 +164,19 @@ class wl implements Runnable {
     static Any mkIsym(String n, Any v) {return new Isym(n, v, NIL);}
     static Any mkObj(Object x) {return new Obj(x);}
     static Any mkOint(String x) {return mkObj(new BigInteger(x));}
-    static Any mkOfix(String x) {err("TODO mkOfix"); return null;}
+    Any mkOfix(String x) {
+        int i = x.indexOf('.');
+        int l = x.length();
+        int n = ((BigInteger) Scl.val().obj()).intValue();
+        n = n < 0 ? -n : n;
+        StringBuffer b = new StringBuffer();
+        b.append(x.substring(0, i));
+        int j;
+        for(j = i + 1; j < i + 1 + n; j++) b.append(j < l ? x.charAt(j) : "0");
+        BigInteger m = new BigInteger(b.toString());
+        if(j < l && charIn(x.charAt(j), "56789")) m = BigInteger.ONE.add(m);
+        return mkObj(m);
+    }
 
     final static Any NIL = mkIsym("NIL", null);
     final static Any T = mkIsym("T", null);
@@ -985,6 +997,25 @@ class wl implements Runnable {
             System.exit(Z.isOnum() ? ((BigInteger) Z.obj()).intValue() : 0);
             return Z;
         }});
+        fn("chop", new Fn() {public Any fn(Any E) {
+            Any V = eval(E.cdr().car());
+            String v = V.isIsym() ? V.nm() : (String) V.obj();
+            Any Z = NIL;
+            for(int i = v.length() - 1; 0 <= i; i--)
+                Z = mkCons(mkObj("" + v.charAt(i)), Z);
+            return Z;
+        }});
+        fn("flip", new Fn() {public Any fn(Any E) {
+            Any L = eval(E.cdr().car());
+            Any Z = NIL;
+            while(NIL != L) {
+                Any F = L;
+                L = L.cdr();
+                F.cdr(Z);
+                Z = F;
+            }
+            return Z;
+        }});
     }
 
     void print(Any E) {