commit f52a20b38a71df5f713542e6a8ad47ac6dab7bd8
parent 1fd98e0abcb9c888d5a013561cce5e99aecffa8b
Author: tomas <tomas@logand.com>
Date: Sun, 11 Oct 2009 11:22:23 +0200
*Stk, comment reader, run|eval 1 up (undo/redo), loop fix, 'set', 'sym?', 'up.' and more
Diffstat:
| M | java.wl | | | 77 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------- |
| M | wl.java | | | 122 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-------- |
2 files changed, 177 insertions(+), 22 deletions(-)
diff --git a/java.wl b/java.wl
@@ -30,21 +30,30 @@
(de rest () (cdr *Args))
(de args () (bool (cdr *Args)))
+(de next ()
+ (set *Args (cadr *Args))
+ (con *Args (cddr *Args))
+ (car *Args) )
(de list @ (rest))
(de nil P (run P 1) NIL)
(de t P (run P 1) T)
-(de prog P (run P 1))
-(de prog1 (E . P) (up @ E) (run P 1) E)
-(de prog2 (E F . P) (up @ F) (run P 1) F)
-
(de if (C . L)
(loop
- (T C (up @ @) (eval (car L) 1))
+ (T C (up. '@ @) (eval (car L) 1))
(T T (run (cdr L) 1)) ) )
+# (de up L
+# (let C (pop 'L)
+# (print C L *Stk *Env)
+# (if (sym? C)
+# (up. 2 C (eval (car L) 1))
+# (up. (+ 1 (eval C 1)) (pop 'L) (eval (car L) 1)) )
+# (print C L *Stk *Env)
+# ) )
+
(de ifn (C . L)
(loop
(NIL C (eval (pop 'L) 1))
@@ -60,6 +69,10 @@
(pop 'L)
(T T (run L 1)) ) )
+(de prog P (run P 1))
+(de prog1 (E . P) (up @ E) (run P 1) E)
+(de prog2 (E F . P) (up @ F) (run P 1) F)
+
(de when (C . P)
(loop
(T C (up @ @) (run P 1))
@@ -85,13 +98,13 @@
(T (eval C 1) Z)
(def 'Z (run L 1)) ) ) )
-(de set L
- (while L
- (def (eval (pop 'L) 1) (eval (pop 'L) 1)) ) )
-
(de setq L
- (while L
- (def (pop 'L) (eval (pop 'L) 1)) ) )
+ (let (V NIL K)
+ (while L
+ (def 'K (pop 'L))
+ (def 'V (eval (pop 'L) 1))
+ (up. K V) )
+ V ) )
(de and L
(loop
@@ -122,6 +135,12 @@
(and (not Y) T)
(and Y T) ) )
+(de let? L
+ (let (K (pop 'L) V (eval (pop 'L) 1))
+ (when V
+ (def 'K V)
+ (run L 1 '(K)) ) ) ) # TODO
+
(de println @
(pass print)
(prin "^J") )
@@ -141,3 +160,39 @@
(while L
(setq C (pop 'L))
(def C (jclass (pack P "." C))) ) ) )
+
+(setq *Int (jclass 'java.math.BigInteger))
+
+(de - L
+ (let? Z (eval (pop 'L) 1)
+ (ifn L
+ ((jfield *Int 'ZERO) '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 / 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 'reminder Y)) ) ) )
diff --git a/wl.java b/wl.java
@@ -204,6 +204,7 @@ class wl implements Runnable {
final Any In = mkIsym("*In", mkObj(new In(System.in)));
final Any Out = mkIsym("*Out", mkObj(System.out));
final Any Env = mkIsym("*Env", NIL);
+ final Any Stk = mkIsym("*Stk", NIL);
Character peek() {return ((In) In.val().cxr()).peek();}
Character xchar() {return ((In) In.val().cxr()).xchar();}
@@ -211,17 +212,24 @@ class wl implements Runnable {
void eof(Any X) {((In) In.val().cxr()).eof(X);}
boolean charIn(Character C, String L) {return 0 <= L.indexOf(C);}
+ void skip1() {
+ Character Z;
+ while(null != (Z = peek()) && charIn(Z, " \t\n\r")) xchar();
+ }
void skip() {
+ skip1();
Character Z;
- while(null != (Z = peek()) && charIn(Z, " \t\n\r"))
- xchar();
+ while(null != (Z = peek()) && '#' == Z) {
+ while(null != (Z = peek()) && '\n' != Z) xchar();
+ skip1();
+ }
}
Any symbol() {
Character C = xchar();
- if(charIn(C, "()\" \t\n\r")) err(C, "Symbol expected");
+ if(charIn(C, "#()\" \t\n\r")) err(C, "Symbol expected");
StringBuffer L = new StringBuffer();
L.append(C);
- while((null != (C = peek())) && !charIn(C, "()\" \t\n\r"))
+ while((null != (C = peek())) && !charIn(C, "#()\" \t\n\r"))
L.append(xchar());
String M = L.toString();
return intern(M);
@@ -251,6 +259,7 @@ class wl implements Runnable {
Character X = peek();
if(null != X) {
switch(X) {
+ // case "#": return comment();
case '(': xchar(); Z = readL(); break;
case ')': xchar(); if(Top) err("Reader overflow"); Z = Rp; break;
case '"': xchar(); Z = text(); break;
@@ -299,32 +308,38 @@ class wl implements Runnable {
Any xrun(Any P, int n, Any L) {
Any Z = NIL;
+ Any E = 0 < n ? undo(n, L) : NIL;
if(P.isCons())
while(NIL != P) {
Z = eval(P.car());
P = P.cdr();
}
else eval(P);
+ if(NIL != E) redo(E);
return Z;
}
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;
if(X.isCons()) Z = apply(X);
else if(X.isIsym()) Z = X.val();
else if(X.isObj()) Z = X;
else err(X, "Don't know how to eval");
+ if(NIL != E) redo(E);
return Z;
}
Any eval(Any X) {return eval(X, 0, NIL);}
Any apply(Any E) {
Any Z = NIL;
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.cxr()).fn(E);
else if(F.isObj()) Z = applyO(E, F);
else err(E, "Don't know how to apply");
+ Stk.val(Stk.val().cdr());
return Z;
}
Any applyC(Any E, Any F) {
@@ -411,6 +426,51 @@ class wl implements Runnable {
if(null != Z) Z.val(mkObj(F));
else Sd.put(Nm, mkIsym(Nm, mkObj(F)));
}
+ Any undo(int n, Any L) {
+ 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;
+ }
+ Env.val(E);
+ return Z;
+ }
+ void redo(Any E) {
+ Any X = Env.val();
+ while(NIL != E) {
+ Any C = E.car();
+ if(C.isCons()) {
+ // swap
+ Any K = C.car();
+ Any V = K.val();
+ K.val(C.cdr());
+ C.cdr(V);
+ }
+ // flip
+ Any F = E;
+ E = E.cdr();
+ F.cdr(X);
+ X = F;
+ }
+ Env.val(X);
+ }
public wl() {
Sd.put("NIL", NIL);
@@ -422,6 +482,7 @@ class wl implements Runnable {
Sd.put("*In", In);
Sd.put("*Out", Out);
Sd.put("*Env", Env);
+ Sd.put("*Stk", Stk);
Sd.put("java.lang.Class", mkIsym("java.lang.Class", mkObj(Class.class)));
fn("run", new Fn() {public Any fn(Any E) {
@@ -431,7 +492,7 @@ class wl implements Runnable {
Any L = NIL;
if(I.cdr().isCons()) {
I = I.cdr();
- n = ((BigInteger) I.car().val()).intValue();
+ n = 1; // TODO ((BigInteger) I.car().val()).intValue();
if(I.cdr().isCons()) L = I.cdr();
}
return xrun(P, n, L);
@@ -443,7 +504,7 @@ class wl implements Runnable {
Any L = NIL;
if(I.cdr().isCons()) {
I = I.cdr();
- n = ((BigInteger) I.car().val()).intValue();
+ n = 1; // TODO ((BigInteger) I.car().val()).intValue();
if(I.cdr().isCons()) L = I.cdr();
}
return eval(X, n, L);
@@ -509,14 +570,14 @@ class wl implements Runnable {
Any C = Y.car();
if(NIL == C) {
Y = Y.cdr();
- if(NIL == eval(Y.car())) return xrun(Y.cdr());
+ Any Z = eval(Y.car());
+ if(NIL == Z) return xrun(Y.cdr());
+ At.val(Z);
} else if(T == C) {
Y = Y.cdr();
Any Z = eval(Y.car());
- if(NIL != Z) {
- At.val(Z);
- return xrun(Y.cdr());
- }
+ At.val(Z);
+ if(NIL != Z) return xrun(Y.cdr());
} else eval(Y);
} else eval(Y);
}
@@ -680,10 +741,27 @@ class wl implements Runnable {
L.cdr(Z);
return Z;
}});
+ fn("set", new Fn() {public Any fn(Any E) {
+ Any Z = NIL;
+ Any I = E.cdr();
+ while(NIL != I) {
+ Any K = eval(I.car());
+ I = I.cdr();
+ Z = eval(I.car());
+ I = I.cdr();
+ if(K.isCons()) K.car(Z);
+ else K.val(Z);
+ }
+ return Z;
+ }});
fn("pair", new Fn() {public Any fn(Any E) {
Any X = eval(E.cdr().car());
return X.isCons() ? X : NIL;
}});
+ fn("sym?", new Fn() {public Any fn(Any E) {
+ Any X = eval(E.cdr().car());
+ return X.isSym() ? T : NIL;
+ }});
fn("let", new Fn() {public Any fn(Any E) {
Any Z = NIL;
Any I = E.cdr();
@@ -751,6 +829,28 @@ class wl implements Runnable {
}
return Z;
}});
+ fn("up.", new Fn() {public Any fn(Any E) { // TODO cnt frame up
+ Any Z;
+ Any I = E.cdr();
+ Any K = eval(I.car());
+ I = I.cdr();
+ if(I.isCons()) { // (up 'K 'Z)
+ Z = eval(I.car());
+ boolean done = false;
+ for(Any J = Env.val(); J.isCons() && T != J.car(); J = J.cdr()) {
+ Any C = J.car();
+ if(K == C.car()) {C.cdr(Z); done = true; break;}
+ }
+ if(!done) Env.val(mkCons(mkCons(K, Z), Env.val()));
+ } else { // (up 'K)
+ Z = K.val();
+ for(Any J = Env.val(); J.isCons() && T != J.car(); J = J.cdr()) {
+ Any C = J.car();
+ if(K == C.car()) {Z = C.cdr(); break;}
+ }
+ }
+ return Z;
+ }});
fn("jnew", new Fn() {public Any fn(Any E) { // jnew 'cls [arg ...]
Any I = E.cdr();
