wl

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

commit 4daa94954d15e88d1dc9db0a639cca1b47676cd0
parent 2ca9f6ae98d8895cebd078f4440078dd434d6a33
Author: tomas <tomas@logand.com>
Date:   Sun, 18 Oct 2009 12:11:23 +0200

cons2 instead of cons., misc fold fns

Diffstat:
Mjava.wl | 101+++++++++++++++++++++++++++++++++++++++++--------------------------------------
Mwl.java | 2+-
2 files changed, 53 insertions(+), 50 deletions(-)

diff --git a/java.wl b/java.wl @@ -9,25 +9,11 @@ (de cdar (L) (cdr (car L))) (de cddr (L) (cdr (cdr L))) -(de caaar (L) (car (car (car L)))) -(de caadr (L) (car (car (cdr L)))) -(de cadar (L) (car (cdr (car L)))) -(de caddr (L) (car (cdr (cdr L)))) -(de cdaar (L) (cdr (car (car L)))) -(de cdadr (L) (cdr (car (cdr L)))) -(de cddar (L) (cdr (cdr (car L)))) -(de cdddr (L) (cdr (cdr (cdr L)))) - -(de cadddr (L) (car (cdr (cdr (cdr L))))) -(de cddddr (L) (cdr (cdr (cdr (cdr L))))) - (de not (X) (== NIL X)) (de bool (X) (not (not X))) (de =T (X) (== T X)) (de nT (X) (not (== T X))) -(de atom (X) (not (pair X))) - (de rest () (cdr *Args)) (de args () (bool (cdr *Args))) (de next () @@ -162,41 +148,40 @@ (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 foldl (F A L) (ifn (pair L) A (foldl F (F A (car L)) (cdr L)))) +(de foldl (F A L) + (loop + (NIL (pair L) A) + (setq A (F A (car L)) L (cdr L)) ) ) +(de foldlx (F A L) + (let (M (cons2 NIL A) N M) + (loop + (NIL (pair L) (cdr M)) + (con N (F N L)) + (when (pair (cdr N)) + (setq N (cdr N)) ) # TODO @ + (setq 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 unfoldl (P F G X A) (if (P X) A (unfoldl P F G (G X) (cons2 (F X) A)))) # TODO loop +(de unfoldr (P F G X E) (if (P X) E (cons2 (F X) (unfoldr P F G (G X))))) +(de hylo (P F G E H X) (if (P X) E (hylo P F G (H (F X) E) H (G X)))) # TODO loop +(de constantly (X) (list NIL (cons2 'quote X))) +#(de fmap (FF L) (foldr '((X Y) (cons2 (FF X) Y)) NIL L)) +(de fmap (FF L) (foldlx '((X Y) (cons2 (FF (car Y)))) NIL L)) +(de o @ (list (list 'X) (foldr '((FFF X) (list FFF X)) 'X (rest)))) +(de oq L (list (list 'X) (foldr '((FFF X) (list FFF X)) 'X L))) + +(def 'atom (oq not pair)) -(de filter (P L) (foldr '((X Y) (if (P X) (cons. X Y) Y)) NIL L)) # TODO use foldl +#(de filter (P L) (foldr '((X Y) (if (P X) (cons2 X Y) Y)) NIL L)) +(de filter (P L) (foldlx '((X Y) (when (P (car Y)) (cons2 (car Y)))) NIL L)) -(de need (N L S) (unfold =0 (constantly S) 1- N)) # TODO L, -N +(de need (N L S) (unfoldl =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))) + (foldlx '((X Y) (if (pair (cdr Y)) (cons2 (car Y) (cdr Y)) (car Y))) NIL (rest)) ) (de and L (loop @@ -238,7 +223,7 @@ (de length (L) (foldl 1+ 0 L)) # TODO other cases -(de reverse (L) (foldl '((X Y) (cons Y X)) NIL L)) +(de reverse (L) (foldl '((X Y) (cons2 Y X)) NIL L)) (de member (I L) (let X L @@ -284,9 +269,9 @@ (pass prin) (prin "^J") ) -(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) (foldl1 '((X Y) (X 'multiply Y)) (rest)))) +(de / @ (when (args) (foldl1 '((X Y) (X 'divide Y)) (rest)))) +(de % @ (when (args) (foldl1 '((X Y) (X 'remainder Y)) (rest)))) (de - @ (when (args) (let A (rest) @@ -323,8 +308,9 @@ (- (jnum (R 'totalMemory)) (jnum (R 'freeMemory))) ) `(* 1024 1024) ) ) ) -(def 'true (jfield (jclass 'java.lang.Boolean) 'TRUE)) -(def 'false (jfield (jclass 'java.lang.Boolean) 'FALSE)) +(let C (jclass 'java.lang.Boolean) + (def 'true (jfield C 'TRUE)) + (def 'false (jfield C 'FALSE)) ) (def 'null (gc)) # mapping @@ -415,7 +401,7 @@ (link (apply F A)) ) ) ) ) (de maps (F S . @) - (apply mapc (cons (getl S) (rest)) F) ) + (apply mapc (cons2 (getl S) (rest)) F) ) (de in (F . P) (let *In (jnew `(jclass 'wl$In) (jnew `(jclass 'java.io.FileInputStream) F)) @@ -434,3 +420,20 @@ (finally () (while (read) (eval @ 1) ) ) ) ) ) + +(de recur recurse (run (cdr recurse))) + +(def 'caaar (oq car car car)) +(def 'caadr (oq car car cdr)) +(def 'cadar (oq car cdr car)) +(def 'caddr (oq car cdr cdr)) +(def 'cdaar (oq cdr car car)) +(def 'cdadr (oq cdr car cdr)) +(def 'cddar (oq cdr cdr car)) +(def 'cdddr (oq cdr cdr cdr)) + +(def 'cadddr (oq car cdr cdr cdr)) +(def 'cddddr (oq cdr cdr cdr cdr)) + +(de even (N) (= (% N 2) 0)) +(def 'odd (oq not even)) diff --git a/wl.java b/wl.java @@ -712,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("cons2", new Fn() {public Any fn(Any E) { Any X = E.cdr(); return mkCons(eval(X.car()), eval(X.cdr().car())); }});