wl

Unnamed repository; edit this file 'description' to name the repository.
git clone https://logand.com/git/wl.git/
Log | Files | Refs | LICENSE

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:
Mjava.wl | 121+++++++++++++++++++++++++++++++++++++++++++++++++------------------------------
Mwl.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) {