commit 2ecf1c5b82c89185f2ac2970eac5b178090be322
parent 1700a61b8d7201b8a47447913115852e40f29eeb
Author: tomas <tomas@logand.com>
Date: Sat, 17 Oct 2009 19:27:24 +0200
mkOfix reader fixed "-." "+.", cons., finally, fold stuff, in/out/load
Diffstat:
| M | java.wl | | | 121 | +++++++++++++++++++++++++++++++++++++++++++++++++------------------------------ |
| M | wl.java | | | 22 | ++++++++++++++++++---- |
2 files changed, 93 insertions(+), 50 deletions(-)
diff --git a/java.wl b/java.wl
@@ -161,6 +161,43 @@
(unless (val X)
(up. X Y) ) ) ) )
+(de identity (X) X)
+(de foldl (F A L) (ifn (pair L) A (foldl F (F A (car L)) (cdr L))))
+(de foldr (F E L) (ifn (pair L) E (F (car L) (foldr F E (cdr L)))))
+(de foldl1 (F L) (foldl F (pop 'L) L))
+(de foldr1 (F L) (foldr F (pop 'L) L))
+#(de unfold (P F G X) (if (P X) NIL (cons. (F X) (unfold P F G (G X)))))
+(de unfold (P F G X A) (if (P X) A (unfold P F G (G X) (cons. (F X) A))))
+(de hylo (P F G E H X) (if (P X) E (hylo P F G (H (F X) E) H (G X))))
+(de constantly (X) (list NIL (cons. 'quote X)))
+
+(de filter (P L) (foldr '((X Y) (if (P X) (cons. X Y) Y)) NIL L)) # TODO use foldl
+
+(de need (N L S) (unfold =0 (constantly S) 1- N)) # TODO L, -N
+
+# TODO fix cons (cons '(1 2) 3 '(4 5 6))
+(de cons @
+ (cdr
+ (foldl '((X Y)
+ (ifn X
+ (let Z (cons. NIL Y) (set Z Z))
+ (con (car X) (cons. (cdar X) Y))
+ (set X (cdar X))
+ X ) )
+ NIL (rest) ) ) )
+
+# (de foldlx (FF L)
+# (cdr
+# (foldl '((X Y)
+# (ifn X
+# (let Z (cons. NIL Y) (set Z Z))
+# (con (car X) (FF (cdar X) Y))
+# (set X (cdar X))
+# X ) )
+# NIL (rest) ) ) )
+
+# (de cons @ (foldlx '((X Y) (if (atom Y) (cons. X Y) (cons. X (cons. Y)))) (rest)))
+
(de and L
(loop
(NIL (eval (pop 'L) 1))
@@ -196,11 +233,12 @@
# (def 'K V)
# (run L 1 '(K)) ) ) ) # TODO
-(de reverse (L)
- (let Z NIL
- (while L
- (push 'Z (pop 'L)) )
- Z ) )
+(de 1+ (X) (+ 1 X))
+(de 1- (X) (- X 1))
+
+(de length (L) (foldl 1+ 0 L)) # TODO other cases
+
+(de reverse (L) (foldl '((X Y) (cons Y X)) NIL L))
(de member (I L)
(let X L
@@ -236,13 +274,8 @@
(NIL (pair X) X)
(pop 'X) ) )
-(de last (L)
- (ifn (pair L)
- L
- (while (pair (cdr L))
- (pop 'L) )
- (car L) ) )
-
+(de last (L) (foldl1 '((X Y) Y) L))
+
(de println @
(pass print)
(prin "^J") )
@@ -251,41 +284,19 @@
(pass prin)
(prin "^J") )
-(de - L
- (let? Z (eval (pop 'L) 1)
- (ifn L
- (0 'subtract Z)
- (loop
- (NIL L Z)
- (setq Y (eval (pop 'L) 1))
- (NIL Y)
- (setq Z (Z 'subtract Y)) ) ) ) )
-
-(de * L
- (let? Z (eval (pop 'L) 1)
- (loop
- (NIL L Z)
- (setq Y (eval (pop 'L) 1))
- (NIL Y)
- (setq Z (Z 'multiply Y)) ) ) )
+(de * @ (when (args) (foldl '((X Y) (X 'multiply Y)) 1 (rest))))
+(de / @ (when (args) (foldl '((X Y) (X 'divide Y)) 1 (rest))))
+(de % @ (when (args) (foldl '((X Y) (X 'remainder Y)) 1 (rest))))
+(de - @
+ (when (args)
+ (let A (rest)
+ (if (pair (cdr A))
+ (foldl1 '((X Y) (X 'subtract Y)) (rest))
+ (0 'subtract (car A)) ) ) ) )
+(de + @ (when (args) (- (pass - 0))))
-(de / L
- (let? Z (eval (pop 'L) 1)
- (loop
- (NIL L Z)
- (setq Y (eval (pop 'L) 1))
- (NIL Y)
- (setq Z (Z 'divide Y)) ) ) )
-
-(de % L
- (let? Z (eval (pop 'L) 1)
- (loop
- (NIL L Z)
- (setq Y (eval (pop 'L) 1))
- (NIL Y)
- (setq Z (Z 'remainder Y)) ) ) )
-
-(de + @ (- (pass - 0)))
+(de max @ (foldl1 '((X Y) (if (> X Y) X Y)) (rest))) # TODO >
+(de min @ (foldl1 '((X Y) (if (< X Y) X Y)) (rest))) # TODO <
(de =0 (N) (when (= 0 N) N))
(de n0 (N) (not (=0 N)))
@@ -405,3 +416,21 @@
(de maps (F S . @)
(apply mapc (cons (getl S) (rest)) F) )
+
+(de in (F . P)
+ (let *In (jnew `(jclass 'wl$In) (jnew `(jclass 'java.io.FileInputStream) F))
+ (finally (*In 'close)
+ (run P 1) ) ) )
+
+(de out (F . P)
+ (let *Out (jnew `(jclass 'java.io.PrintStream)
+ (jnew `(jclass 'java.io.FileOutputStream) F) )
+ (finally (*Out 'close)
+ (run P 1) ) ) )
+
+(de load @
+ (for F (rest)
+ (in F
+ (finally ()
+ (while (read)
+ (eval @ 1) ) ) ) ) )
diff --git a/wl.java b/wl.java
@@ -195,7 +195,7 @@ class wl implements Runnable {
final Any At = mkIsym("@", NIL);
final Any Args = mkIsym("*Args", NIL);
- class In {
+ public class In {
InputStream s;
int b; // -2 ~ unbound, -1 ~ eof, otherwise 0--255
Character c; // null ~ NIL
@@ -261,7 +261,9 @@ class wl implements Runnable {
}
}
String M = b.toString();
- if(1 == M.length() && charIn(M.charAt(0), "+-.")) N = false;
+ if(1 == M.length() && charIn(M.charAt(0), "+-.")
+ || 2 == M.length() && ("+.".equals(M) || "-.".equals(M)))
+ N = false;
return N ? (F ? mkOfix(M) : mkOint(M)) : intern(M);
}
Any text() {
@@ -710,7 +712,7 @@ class wl implements Runnable {
else err(E, "Don't know how to val");
return Z;
}});
- fn("cons", new Fn() {public Any fn(Any E) {
+ fn("cons.", new Fn() {public Any fn(Any E) {
Any X = E.cdr();
return mkCons(eval(X.car()), eval(X.cdr().car()));
}});
@@ -999,7 +1001,7 @@ class wl implements Runnable {
}});
fn("chop", new Fn() {public Any fn(Any E) {
Any V = eval(E.cdr().car());
- String v = V.isIsym() ? V.nm() : (String) V.obj();
+ String v = V.isIsym() ? V.nm() : V.obj().toString();
Any Z = NIL;
for(int i = v.length() - 1; 0 <= i; i--)
Z = mkCons(mkObj("" + v.charAt(i)), Z);
@@ -1016,6 +1018,18 @@ class wl implements Runnable {
}
return Z;
}});
+ fn("finally", new Fn() {public Any fn(Any E) { // TODO
+ Any I = E.cdr();
+ Any F = I.car();
+ Any P = I.cdr();
+ Any Z = NIL;
+ try {
+ Z = xrun(P);
+ } finally {
+ eval(F);
+ }
+ return Z;
+ }});
}
void print(Any E) {
