public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 3, "guard-continuation");
if (res != null)
{
return(CPS.Error(res, cont));
}
KContinuation c = Second(args) as KContinuation;
KObject entry = First(args);
KObject exit = Third(args);
try
{
if (null == c)
{
throw new RuntimeException("guard-continuation: not a continution");
}
c.Value.EntryGuard = assignGuards(entry);
c.Value.ExitGuard = assignGuards(exit);
return(CPS.Return(c, cont));
}
catch (Exception e)
{
return(CPS.Error(e.Message, cont));
}
}
public virtual RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
object result = null;
try {
result = Do(args, env, cont);
} catch (RuntimeException e) {
return(CPS.Error <KObject>(getName() + ": " + e.Message, cont));
}
if (result is KObject)
{
return(CPS.Return(result as KObject, cont));
}
else if (result is bool)
{
return(CPS.Return(new KBoolean((bool)result), cont));
}
else if (result is RecursionResult <KObject> )
{
return(result as RecursionResult <KObject>);
}
else
{
return(CPS.Return(new KInert(), cont));
}
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 1, "load");
if (res != null)
{
return(CPS.Error(res, cont));
}
KObject val = First(args) as KString;
if (!(val is KString))
{
return(CPS.Error("load: not a string", cont));
}
string path = (val as KString).Value;
try
{
List <KObject> tokens = Parser.ParseAll(File.ReadAllText(path));
foreach (var token in tokens)
{
Evaluator.Eval(token, env);
}
return(CPS.Return(new KInert(), cont));
}
catch (Exception e)
{
return(CPS.Error("Failed to load file: " + e.Message, cont));
}
}
public override object Do(KObject args, KEnvironment env, Continuation <KObject> cont)
{
CPara(args, 2);
KObject expr = First(args);
KEnvironment envir = Second(args) as KEnvironment;
Check(envir, "not an enviroment");
return(CPS.PassTo <KObject>(() => Evaluator.rceval(expr, envir, cont)));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 1, "copy-es-immutable");
if (res != null)
{
return(CPS.Error(res, cont));
}
return(Return(KPair.CopyEs(First(args)), cont));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 1, "number?");
if (res != null)
{
return(CPS.Error(res, cont));
}
return(ReturnBool(First(args) is KDouble || First(args) is KInteger, cont));
}
public override object Do(KObject args, KEnvironment env, Continuation <KObject> cont)
{
CPara(args, 1);
Continuation <KObject> result = myc.Value;
if (result.Context == null)
{
return(CPS.Return(First(args), CPS.RootContinuation <KObject>()));
}
return(result.Call(First(args)));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 1, "encapsulate");
if (res != null)
{
return(CPS.Error(res, cont));
}
KObject datum = First(args);
return(Return(new KEncapsulation(id, datum), cont));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 1, "display");
if (res != null)
{
return(CPS.Error(res, cont));
}
KObject datum = First(args);
Console.WriteLine(datum.Display());
return(Return(new KInert(), cont));
}
public override object Do(KObject args, KEnvironment env, Continuation <KObject> cont)
{
CPara(args, 2);
KPair p = args as KPair;
Continuation <KObject> c = null;
c = new Continuation <KObject>((x) => {
return(CPS.PassTo(() => Evaluator.rceval(
new KPair(p.Car, new KPair(new KString(c.Context.ToString()), new KNil())), env, cont)));
}, cont, "error-handler");
c.isHandler = true;
return(CPS.PassTo(() => Evaluator.rceval(Second(p), env, c)));
}
public override object Do(KObject args, KEnvironment env, Continuation <KObject> cont)
{
CPara(args, 2);
KObject definand = First(args), expr = Second(args);
var cc = new Continuation <KObject>((e) => {
try {
Evaluator.BindFormalTree(definand, e, env);
} catch (Exception ex) {
return(CPS.Error <KObject>(ex.Message, cont));
}
return(CPS.Return <KObject>(new KInert(), cont));
}, cont, "define");
return(CPS.PassTo(() => Evaluator.rceval(expr, env, cc)));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 1, "continuation->applicative");
if (res != null)
{
return(CPS.Error(res, cont));
}
KObject c = First(args);
if (c is KContinuation)
{
return(CPS.Return(new KApplicative(new PPassCont(c as KContinuation)), cont));
}
return(CPS.Error("continuation->applicative: not a continuation given", cont));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 2, "*");
if (res != null)
{
return(CPS.Error(res, cont));
}
KObject a = First(args), b = Second(args);
var result = KNumber.DoMath(a, b, (x, y) => x * y, (x, y) => x * y);
if (result == null)
{
return(CPS.Error("*: wrong types", cont));
}
return(Return(result, cont));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 0, "make-encapsulation-type");
if (res != null)
{
return(CPS.Error(res, cont));
}
this.id = counter++;
KApplicative e = new KApplicative(new PEncapE(id));
KApplicative p = new KApplicative(new PEncapP(id));
KApplicative d = new KApplicative(new PEncapD(id));
KPair p3 = new KPair(d, new KNil(), true);
KPair p2 = new KPair(p, p3, true);
KPair p1 = new KPair(e, p2, true);
return(Return(p1, cont));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 1, "unwrap");
if (res != null)
{
return(CPS.Error(res, cont));
}
KObject ap = First(args);
if (!(ap is KApplicative))
{
return(CPS.Error("unwrap: not an applicative", cont));
}
else
{
return(Return((ap as KApplicative).Combiner, cont));
}
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 1, "wrap");
if (res != null)
{
return(CPS.Error(res, cont));
}
KObject op = First(args);
if (!(op is KOperative || op is KApplicative))
{
return(CPS.Error("wrap: not a operative", cont));
}
else
{
return(Return(new KApplicative(op as KCombiner), cont));
}
}
private static RecursionResult <KObject> combineOp(KOperative op, KObject operands, KEnvironment env, Continuation <KObject> cont)
{
if (null == op.Expr)
{
if (op is ICombinable)
{
return((op as ICombinable).Combine(operands, env, cont));
}
return(CPS.Error <KObject>("Primitive without implementation!" + op.Write(), cont));
}
KEnvironment local = new KEnvironment(op.staticenv);
if (!(op.EFormal is KIgnore))
{
local.Bind(((KSymbol)op.EFormal).Value, env);
}
BindFormalTree(op.Formals, operands, local);
return(CPS.PassTo <KObject>(() => Evaluator.rceval(op.Expr, local, cont)));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
KEnvironment envir = new KEnvironment();
try
{
KPair.Foreach(x => {
if (!(x is KEnvironment))
{
throw new RuntimeException("make-environment: not an environment");
}
envir.AddParent((KEnvironment)x);
}, args);
}
catch (Exception e)
{
return(CPS.Error(e.Message, cont));
}
return(Return(envir, cont));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 2, "set-car!");
if (res != null)
{
return(CPS.Error(res, cont));
}
KObject p = First(args), v = Second(args);
if (p is KPair)
{
KPair pair = p as KPair;
if (pair.Mutable)
{
pair.SetCar(v);
return(Return(new KInert(), cont));
}
}
return(CPS.Error("set-car: pair not mutable", cont));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
int len = KPair.Length(args);
if (len == -1)
{
return(CPS.Error("encapsulation?: parameter is not a list", cont));
}
else
{
bool result = true;
KPair.Foreach(x =>
{
if (!(x is KEncapsulation) || (x as KEncapsulation).Id != id)
{
result = false;
}
}, args);
return(ReturnBool(result, cont));
}
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 2, "-");
if (res != null)
{
return(CPS.Error(res, cont));
}
KObject a = First(args), b = Second(args);
if (KNumber.IsNumber(b) && KNumber.GetDouble(b) == 0.0)
{
return(CPS.Error("Division by zero", cont));
}
var result = KNumber.DoMath(a, b, (x, y) => x / y, (x, y) => x / y);
if (result == null)
{
return(CPS.Error("/: wrong types", cont));
}
return(Return(result, cont));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 1, "decapsle");
if (res != null)
{
return(CPS.Error(res, cont));
}
KObject datum = First(args);
if (!(datum is KEncapsulation))
{
return(CPS.Error("decaplse: not an encap", cont));
}
KEncapsulation enc = datum as KEncapsulation;
if (enc.Id != id)
{
return(CPS.Error("decaplse: wrong", cont));
}
return(Return(enc.Value, cont));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 1, "call/cc");
if (res != null)
{
return(CPS.Error(res, cont));
}
KObject comb = First(args);
try
{
if (comb is KCombiner)
{
return((comb as KCombiner).Combine(new KPair(new KContinuation(cont), new KNil(), true), env, cont));
}
}
catch (Exception e)
{
return(CPS.Error(e.Message, cont));
}
return(CPS.Error("call/cc: not a combiner", cont));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
var res = CheckParameter(args, 2, ">?");
if (res != null)
{
return(CPS.Error(res, cont));
}
KObject a = First(args), b = Second(args);
if (!(KNumber.IsNumber(a) && KNumber.IsNumber(b)))
{
return(CPS.Error("wrong types", cont));
}
if (a is KDouble || b is KDouble)
{
return(ReturnBool(KNumber.GetDouble(a) > KNumber.GetDouble(b), cont));
}
else
{
return(ReturnBool((a as KInteger).Value > (b as KInteger).Value, cont));
}
}
public override object Do(KObject args, KEnvironment env, Continuation <KObject> cont)
{
CPara(args, 3);
KObject pred = First(args), tr = Second(args), fl = Third(args);
var cc = new Continuation <KObject>((p) => {
if (!(p is KBoolean))
{
return(CPS.Error <KObject>("$if: predicate not boolean", cont));
}
else
{
if (((KBoolean)p).Value)
{
return(CPS.PassTo <KObject>(() => Evaluator.rceval(tr, env, cont)));
}
else
{
return(CPS.PassTo <KObject>(() => Evaluator.rceval(fl, env, cont)));
}
}
}, cont, "if");
return(CPS.PassTo(() => Evaluator.rceval(pred, env, cc)));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
int len = KPair.Length(args);
if (len < 2 || len > 3)
{
return(CPS.Error("extend-continuation: argument mismatch", cont));
}
KContinuation argC = First(args) as KContinuation;
KApplicative argA = Second(args) as KApplicative;
KEnvironment argE = len == 3 ? Third(args) as KEnvironment : new KEnvironment();
if (argC == null || argA == null || argE == null)
{
return(CPS.Error("extend-continuation: mismatching arguments", cont));
}
var nc = new Continuation <KObject>((val, ctxt) =>
{
return(CPS.Next(() => Evaluator.rceval(new KPair(argA.Combiner, val, true), argE, argC.Value), argC.Value));
}, argC.Value, argA);
return(Return(new KContinuation(nc), cont));
}
public override RecursionResult <KObject> Combine(KObject args, KEnvironment env, Continuation <KObject> cont)
{
// first of all I wanna check for exit guards
//Continuation<KObject> loop = cont;
Continuation <KObject> result = myc.Value;
/*var conts = new LinkedList<Continuation<KObject>>();
* while (loop != null)
* {
* conts.AddFirst(loop);
* loop = loop.Parent;
* }
* loop = cont;
* Continuation<KObject> innerloop = myc.Value;
* while(true)
* {
* if (innerloop == null)
* break;
* if (continuationEqual(innerloop, cont))
* {
* loop = null;
* break;
* }
* innerloop = innerloop.Parent;
* }
* while (loop != null)
* {
* if (loop.ExitGuard != null && loop.ExitGuard.Count > 0)
* {
* // ok, found something, now check
* foreach (KGuard guard in loop.ExitGuard)
* {
* foreach (Continuation<KObject> c in conts)
* {
* // from the last to the first
* if (continuationEqual(c, guard.Selector.Value))
* {
* var child = new Continuation<KObject>((x, ctxt) =>
* {
* return Evaluator.rceval(new KPair(guard.Interceptor, new KPair(x, new KPair(new KNil(), new KNil(), true), true), true), KEnvironment.GetGroundEnv(), ctxt._RemainingGuards);
* }, result, new KString("guard"));
* child._RemainingGuards = result;
* result = child;
* }
* }
* }
* }
* loop = loop.Parent;
* }*/
if (result.isError)
{
Continuation <KObject> cc = new Continuation <KObject>(null, cont, null);
cc.isError = true;
return(CPS.Return(args, cc));
}
if (result.Context == null)
{
//well, top level reached hm hm
return(CPS.Return(args, result));
}
return(result.NextStep(args, result));
}
public static RecursionResult <KObject> rceval(KObject datum, KEnvironment env, Continuation <KObject> cont)
{
// useful for debugging
//Console.WriteLine(datum.Display());
if (datum is KPair)
{
KPair p = datum as KPair;
// this function get called when the operator is evaluated to f
var childCont = new Continuation <KObject>((f) =>
{
if (f is KOperative)
{
return(combineOp(f as KOperative, p.Cdr, env, cont));
}
else if (f is KApplicative && (p.Cdr is KPair || p.Cdr is KNil))
{
if (p.Cdr is KNil)
{
return(combineApp(f as KApplicative, p.Cdr, env, cont));
}
KPair ops = p.Cdr as KPair;
LinkedList <KObject> input = new LinkedList <KObject>();
KPair.Foreach(x =>
{
input.AddLast(x);
}, ops);
LinkedList <KObject> pairs = new LinkedList <KObject>();
Func <KObject, RecursionResult <KObject> > recursion = null;
bool firstRun = true;
// this continuation is called with the next argument evaled to x. Place next value
recursion = (x) =>
{
if (CPS.getContext() is int && !firstRun)
{
// restore elements when reentering continuation
int oldInputCount = (int)CPS.getContext() + 1;
input = new LinkedList <KObject>();
KPair.Foreach(e =>
{
input.AddLast(e);
}, ops);
int leaveOutputs = input.Count - oldInputCount;
while (input.Count > oldInputCount)
{
input.RemoveFirst();
}
while (pairs.Count >= leaveOutputs)
{
pairs.RemoveFirst();
}
firstRun = true;
}
pairs.AddFirst(x);
if (input.Count == 0)
{
// we are finished
KObject output = new KNil();
foreach (var el in pairs)
{
output = new KPair(el, output);
}
firstRun = false;
return(combineApp(f as KApplicative, output, env, cont));
}
else
{
// do something with the next Head argument
KObject next = input.First.Value;
input.RemoveFirst();
var cc2 = new Continuation <KObject>(recursion, cont, input.Count);
return(CPS.PassTo(() => rceval(next, env, cc2)));
}
};
KObject next2 = input.First.Value;
input.RemoveFirst();
var cc = new Continuation <KObject>(recursion, cont, input.Count);
return(CPS.PassTo(() => rceval(next2, env, cc)));
}
return(CPS.Error <KObject>("Unsuitable operation of " + f.Write(), cont));
}, cont, "eval op/app");
return(CPS.PassTo(() => rceval(p.Car, env, childCont)));
}
else if (datum is KSymbol)
{
KObject val = env.Lookup(((KSymbol)datum).Value);
if (null == val)
{
return(CPS.Error <KObject>("Unbound variable " + ((KSymbol)datum).Value, cont));
}
return(CPS.Return(val, cont));
}
else
{
return(CPS.Return(datum, cont));
}
}
public static KObject Eval(KObject datum, KEnvironment env)
{
return(CPS.Execute <KObject>(() => rceval(datum, env, CPS.RootContinuation <KObject>())));
}
public override object Do(KObject args, KEnvironment env, Continuation <KObject> cont)
{
CPara(args, 1);
Check(First(args), "message not a string");
return(CPS.Error <KObject>((First(args) as KString).Value, cont));
}
