commit 51119810287735eed44e00862f44abd87912d718
parent b79426aa1f3e66e7124a25bb63c7c25d8a81a66c
Author: tomas <tomas@logand.com>
Date: Sat, 10 Oct 2009 22:13:37 +0200
added bind, unbind, frame, unframe and linear *Env with T marking frame
Diffstat:
| M | wl.java | | | 204 | ++++++++++++++++++++++++++++++++++++++----------------------------------------- |
1 file changed, 98 insertions(+), 106 deletions(-)
diff --git a/wl.java b/wl.java
@@ -203,6 +203,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);
Character peek() {return ((In) In.val().cxr()).peek();}
Character xchar() {return ((In) In.val().cxr()).xchar();}
@@ -326,75 +327,51 @@ class wl implements Runnable {
Any A = E.cdr();
Any Fa = F.car();
Any Fb = F.cdr();
- Any O = saveV(Fa, A);
- Z = xrun(Fb);
- restoreV(Fa, O);
- return Z;
- }
- Any mapcarEval(Any E) {
- Any A = mkCons(NIL, NIL);
- Any Z = A;
- while(E.isCons()) {
- Z.cdr(mkCons(eval(E.car()), NIL));
- Z = Z.cdr();
- E = E.cdr();
- }
- return A.cdr();
- }
- Any saveV(Any Fa, Any A) {
- Any O = NIL;
- if(Fa.isIsym()) {
+ frame();
+ int n = 0;
+ if(Fa.isIsym()) { // (@ . P) | (L . P) | (NIL . P)
if(NIL != Fa) {
if(At == Fa) {
- O = mkCons(Args.val(), NIL);
- Args.val(mkCons(NIL, mapcarEval(A)));
+ bind(Args, mkCons(NIL, mapcarEval(A)));
+ n++;
} else {
- O = mkCons(Fa.val(), NIL);
- Fa.val(A);
+ bind(Fa, A);
+ n++;
}
- }
- } else if(Fa.isCons()) {
- Any B = mkCons(NIL, NIL);
- Any Z = B;
+ }
+ } else if(Fa.isCons()) { // ((L ...) . P)
while(Fa.isCons()) {
Any X = Fa.car();
Fa = Fa.cdr();
- Z.cdr(mkCons(X.val(), NIL));
- Z = Z.cdr();
- X.val(eval(A.car()));
+ bind(X, eval(A.car()));
+ n++;
A = A.cdr();
}
if(NIL != Fa) {
- if(At == Fa) {
- Z.cdr(mkCons(Args.val(), NIL));
- Args.val(mkCons(NIL, mapcarEval(A)));
- } else {
- Z.cdr(mkCons(Fa.val(), NIL));
- Fa.val(A);
+ if(At == Fa) { // ((L . @) . P)
+ bind(Args, mkCons(NIL, mapcarEval(A)));
+ n++;
+ } else { // ((L . M) . P)
+ bind(Fa, A);
+ n++;
}
}
- O = B.cdr();
- } else err(Fa, "Don't know how to saveV");
- return O;
+ } else err(Fa, "Don't know how to bind");
+
+ Z = xrun(Fb);
+ unbind(n);
+ unframe();
+ return Z;
}
- void restoreV(Any Fa, Any O) {
- if(Fa.isIsym()) {
- if(NIL != Fa) {
- if(At == Fa) Args.val(O.car());
- else Fa.val(O.car());
- }
- } else if(Fa.isCons()) {
- while(Fa.isCons()) {
- Any X = Fa.car();
- Fa = Fa.cdr();
- X.val(O.car());
- O = O.cdr();
- }
- if(NIL != Fa) {
- if(At == Fa) Args.val(O.car());
- else Fa.val(O.car());
- }
- } else err(Fa, "Don't know how to restoreV");
+ Any mapcarEval(Any E) {
+ Any A = mkCons(NIL, NIL);
+ Any Z = A;
+ while(E.isCons()) {
+ Z.cdr(mkCons(eval(E.car()), NIL));
+ Z = Z.cdr();
+ E = E.cdr();
+ }
+ return A.cdr();
}
Any applyO(Any E, Any O) { // 'obj 'meth [arg ...]
Any I = E.cdr();
@@ -427,6 +404,36 @@ class wl implements Runnable {
}
return Z;
}
+ void bind(Any S, Any V) {
+ dbg(" 1", Env.val());
+ Env.val(mkCons(mkCons(S, S.val()), Env.val()));
+ S.val(V);
+ dbg(" 2", Env.val());
+ }
+ void bind(Any S) {
+ dbg(" 1", Env.val());
+ Env.val(mkCons(mkCons(S, S.val()), Env.val()));
+ dbg(" 2", Env.val());
+ }
+ void unbind() {
+ dbg(" 3", Env.val());
+ Any E = Env.val();
+ Any X = E.car();
+ X.car().val(X.cdr());
+ Env.val(E.cdr());
+ dbg(" 4", Env.val());
+ }
+ void unbind(int n) {for(int i = 0; i < n; i++) unbind();}
+ void frame() {
+ dbg("1", Env.val());
+ Env.val(mkCons(T, Env.val()));
+ dbg("2", Env.val());
+ }
+ void unframe() {
+ dbg("3", Env.val());
+ Env.val(Env.val().cdr());
+ dbg("4", Env.val());
+ }
void fn(String Nm, Fn F) {
Any Z = Sd.get(Nm);
@@ -443,10 +450,15 @@ class wl implements Runnable {
Sd.put("*Args", Args);
Sd.put("*In", In);
Sd.put("*Out", Out);
+ Sd.put("*Env", Env);
Sd.put("java.lang.Class", mkIsym("java.lang.Class", mkObj(Class.class)));
- fn("run", new Fn() {public Any fn(Any E) {return xrun(eval(E.cdr().car()));}});
- fn("eval", new Fn() {public Any fn(Any E) {return eval(eval(E.cdr().car()));}});
+ fn("run", new Fn() {public Any fn(Any E) {
+ return xrun(eval(E.cdr().car()));
+ }});
+ fn("eval", new Fn() {public Any fn(Any E) {
+ return eval(eval(E.cdr().car()));
+ }});
fn("quote", new Fn() {public Any fn(Any E) {return E.cdr();}});
fn("car", new Fn() {public Any fn(Any E) {return eval(E.cdr().car()).car();}});
fn("cdr", new Fn() {public Any fn(Any E) {return eval(E.cdr().car()).cdr();}});
@@ -521,10 +533,6 @@ class wl implements Runnable {
}
}
}});
- fn("up", new Fn() {public Any fn(Any E) {
- // TODO
- return NIL;
- }});
fn("==", new Fn() {public Any fn(Any E) {
Any X = E.cdr();
return eval(X.car()) == eval(X.cdr().car()) ? T : NIL;
@@ -691,35 +699,24 @@ class wl implements Runnable {
Any Z = NIL;
Any I = E.cdr();
Any L = I.car();
- if(L.isCons()) {
- Any A = L;
- Any B = mkCons(NIL, NIL);
- Any C = B;
- while(A.isCons()) {
- Any K = A.car();
- A = A.cdr();
- Any V = eval(A.car());
- A = A.cdr();
- C.cdr(mkCons(K.val(), NIL));
- C = C.cdr();
- K.val(V);
+ if(L.isCons()) { // (let (K 'V ...) . P)
+ int n = 0;
+ while(L.isCons()) {
+ Any K = L.car();
+ L = L.cdr();
+ Any V = eval(L.car());
+ L = L.cdr();
+ bind(K, V);
+ n++;
}
Z = xrun(I.cdr());
- A = L;
- C = B.cdr();
- while(A.isCons()) {
- Any K = A.car();
- A = A.cdr().cdr();
- K.val(C.car());
- C = C.cdr();
- }
- } else if(L.isIsym()) {
+ unbind(n);
+ } else if(L.isIsym()) { // (let L 'V . P)
I = I.cdr();
Any V = eval(I.car());
- Any O = L.val();
- L.val(V);
+ bind(L, V);
Z = xrun(I.cdr());
- L.val(O);
+ unbind();
} else err(E, "Don't know how to let");
return Z;
}});
@@ -727,32 +724,27 @@ class wl implements Runnable {
Any Z = NIL;
Any I = E.cdr();
Any L = I.car();
- if(L.isCons()) {
- Any A = L;
- Any B = mkCons(NIL, NIL);
- Any C = B;
- while(A.isCons()) {
- Any K = A.car();
- A = A.cdr();
- C.cdr(mkCons(K.val(), NIL));
- C = C.cdr();
+ if(L.isCons()) { // (use (K ...) . P)
+ int n = 0;
+ while(L.isCons()) {
+ Any K = L.car();
+ L = L.cdr();
+ bind(K);
+ n++;
}
Z = xrun(I.cdr());
- A = L;
- C = B.cdr();
- while(A.isCons()) {
- Any K = A.car();
- A = A.cdr();
- K.val(C.car());
- C = C.cdr();
- }
- } else if(L.isIsym()) {
- Any O = L.val();
+ unbind(n);
+ } else if(L.isIsym()) { // (use L . P)
+ bind(L);
Z = xrun(I.cdr());
- L.val(O);
+ unbind();
} else err(E, "Don't know how to let");
return Z;
}});
+ fn("up", new Fn() {public Any fn(Any E) {
+ // TODO
+ return NIL;
+ }});
fn("jnew", new Fn() {public Any fn(Any E) { // jnew 'cls [arg ...]
Any I = E.cdr();
