wl

commit b79439d2caac12c98368af6949eb5387234c1351
parent eeb39b653146973b7f7acf27d859c31ca9233ad1
Author: tomas <tomas@logand.com>
Date:   Sat, 24 Oct 2009 23:33:41 +0200

applyC fixed (eval then bind), undo N, fmap o oq fix

Diffstat:
M
java.wl
 | 
11
+++++------
M
wl.java
 | 
72
+++++++++++++++++++++++++++++++++++++++++++-----------------------------

2 files changed, 48 insertions(+), 35 deletions(-)
diff --git a/java.wl b/java.wl
@@ -161,17 +161,16 @@
          (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 foldr (F E L) (ifn (pair L) E (F (car L) (foldr F E (cdr L))))) # TODO loop
 (de foldl1 (F L) (foldl F (pop 'L) L))
 (de foldr1 (F L) (foldr F (pop 'L) L))
 (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 unfoldr (P F G X E) (if (P X) E (cons2 (F X) (unfoldr P F G (G X))))) # TODO loop
 (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)))
+(de fmap (F L) (foldlx '((X Y) (cons2 ((eval 'F 2) (car Y)))) NIL L)) # TODO use up
+(de o @ (list (list 'X) (foldr '((F X) (list F X)) 'X (rest))))
+(de oq L (list (list 'X) (foldr '((F X) (list F X)) 'X L)))
 
 (def 'atom (oq not pair))
 
diff --git a/wl.java b/wl.java
@@ -347,7 +347,7 @@ class wl implements Runnable {
 
     Any xrun(Any P, int n, Any L) {
         Any Z = NIL;
-        Any E = 0 < n ? undo(n, L) : NIL;
+        Any E = undo(n, L);
         try {
             if(P.isCons())
                 while(NIL != P) {
@@ -361,7 +361,7 @@ class wl implements Runnable {
     Any xrun(Any P) {return xrun(P, 0, NIL);}
     Any eval(Any X, int n, Any L) {
         Any Z = NIL;
-        Any E = 0 < n ? undo(n, L) : NIL;
+        Any E = undo(n, L);
         try {
             if(X.isCons()) Z = apply(X);
             else if(X.isIsym()) Z = X.val();
@@ -376,7 +376,6 @@ class wl implements Runnable {
         Any F = eval(E.car());
         Stk.val(mkCons(E.car(), Stk.val()));
         if(F.isCons()) Z = applyC(E, F);
-        //else if(F.isSym()) Z = applyS(E, F); // TODO ?
         else if(F.isOfn()) Z = ((Fn) F.obj()).fn(E);
         else if(F.isObj()) Z = applyO(E, F);
         else err(E, "Don't know how to apply");
@@ -388,23 +387,28 @@ class wl implements Runnable {
         Any A = E.cdr();
         Any Fa = F.car();
         Any Fb = F.cdr();
-        frame();
+        Any B = NIL;
         if(Fa.isIsym()) { // (@ . P) | (L . P) | (NIL . P)
             if(NIL != Fa) {
-                if(At == Fa) bind(Args, mkCons(NIL, mapcarEval(A)));
-                else bind(Fa, A);
+                if(At == Fa) B = mkCons(mkCons(Args, mkCons(NIL, mapcarEval(A))), B);
+                else B = mkCons(mkCons(Fa, A), B);
             }
         } else if(Fa.isCons()) { // ((L ...) . P)
             while(Fa.isCons()) {
-                bind(Fa.car(), eval(A.car()));
+                B = mkCons(mkCons(Fa.car(), eval(A.car())), B);
                 Fa = Fa.cdr();
                 A = A.cdr();
             }
             if(NIL != Fa) {
-                if(At == Fa) bind(Args, mkCons(NIL, mapcarEval(A)));
-                else bind(Fa, A);
+                if(At == Fa) B = mkCons(mkCons(Args, mkCons(NIL, mapcarEval(A))), B);
+                else B = mkCons(mkCons(Fa, A), B);
             }
         } else err(Fa, "Don't know how to bind");
+        frame();
+        while(NIL != B) {
+            bind(B.car().car(), B.car().cdr());
+            B = B.cdr();
+        }
         try {Z = xrun(Fb);}
         finally {unframe();}
         return Z;
@@ -543,29 +547,39 @@ class wl implements Runnable {
         else Sd.put(Nm, mkIsym(Nm, mkObj(F)));
     }
     Any undo(int n, Any L) {
-        if(n != 1) err("TODO undo n!=1");
         Any Z = NIL;
         Any E = Env.val();
-        while(E.isCons() && T != E.car()) {
-            Any C = E.car();
-            // flip
-            Any F = E;
-            E = E.cdr();
-            F.cdr(Z);
-            Z = F;
-            // swap
-            Any K = C.car();
-            Any V = K.val();
-            K.val(C.cdr());
-            C.cdr(V);
-        }
-        if(T == E.car()) {
-            // flip
-            Any F = E;
-            E = E.cdr();
-            F.cdr(Z);
-            Z = F;
+        // if(0 < n) {
+        //     System.out.println(n);
+        //     dbg("E+", E);
+        //     dbg("*Stk", Stk.val());
+        // }
+        for(int i = 0; i < n; i++) {
+            // System.out.println(i);
+            // dbg("Z", Z);
+            while(E.isCons() && T != E.car()) {
+                Any C = E.car();
+                // flip
+                Any F = E;
+                E = E.cdr();
+                F.cdr(Z);
+                Z = F;
+                // swap
+                Any K = C.car();
+                Any V = K.val();
+                K.val(C.cdr());
+                C.cdr(V);
+            }
+            if(T == E.car()) {
+                // flip
+                Any F = E;
+                E = E.cdr();
+                F.cdr(Z);
+                Z = F;
+            }
         }
+        // if(0 < n) dbg("E-", E);
+        //dbg("Z", Z);
         Env.val(E);
         return Z;
     }