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 object Do(KObject args, KEnvironment env, Continuation <KObject> cont)
{
int length = KPair.Length(args);
if (length == -1)
{
throw new RuntimeException("improper list");
}
if (length == 0)
{
throw new RuntimeException("at least one arg expected");
}
else if (length == 1)
{
KObject a = NumbersModule.Check(First(args));
if (a is KFraction)
{
return(new KFraction((a as KFraction).Numerator * -1, (a as KFraction).Denominator));
}
else
{
return(new KDouble((a as KDouble).Value * -1));
}
}
else
{
KObject dif = NumbersModule.Check(First(args));
KObject head = (args as KPair).Cdr;
while (head is KPair)
{
KObject nextNumber = NumbersModule.Check(First(head));
if (dif is KFraction && nextNumber is KFraction)
{
dif = (dif as KFraction).Subtract(nextNumber as KFraction);
}
else
{
KDouble a = NumbersModule.ToInexact(dif);
KDouble b = NumbersModule.ToInexact(nextNumber);
dif = new KDouble(a.Value - b.Value);
}
head = (head as KPair).Cdr;
}
return(dif);
}
}
public override object Do(KObject args, KEnvironment env, Continuation <KObject> cont)
{
CPara(args, 1);
KString path = First(args) as KString;
Check(path);
try
{
List <KObject> tokens = Parser.ParseAll(File.ReadAllText(path.Value));
foreach (var token in tokens)
{
Evaluator.Eval(token, env);
}
return(new KInert());
}
catch (Exception e)
{
throw new RuntimeException("Failed to load file: " + e.Message);
}
}
private Continuation <KObject> fixStructure(Continuation <KObject> c)
{
if (c.Parent == null)
{
return(c); // base continuation without state
}
else
{
var thatsnew = new Continuation <KObject>(c.NextStep, fixStructure(c.Parent), c.Context);
thatsnew.isError = c.isError;
if (c._Placeholder != null)
{
var remaing = new LinkedList <KObject>(c._RemainingObjs);
var pars = new LinkedList <KObject>(c._Pairs);
thatsnew._Pairs = pars;
thatsnew._RemainingObjs = remaing;
thatsnew._Placeholder = c._Placeholder;
}
return(thatsnew);
}
}
public override object Do(KObject args, KEnvironment env, Continuation <KObject> cont)
{
int len = KPair.Length(args);
if (len == -1)
{
throw new RuntimeException("parameter is not a list");
}
else
{
bool result = true;
KPair.Foreach(x =>
{
if (!(x is KEncapsulation) || (x as KEncapsulation).Id != id)
{
result = false;
}
}, args);
return(result);
}
}
public override object Do(KObject args, KEnvironment env, Continuation <KObject> cont)
{
int length = KPair.Length(args);
if (length == -1)
{
throw new RuntimeException("improper list");
}
if (length == 0)
{
return(new KFraction(BigInteger.One, BigInteger.One));
}
else
{
// we have a list of at least one elements
// we must fold it to something useful
KObject product = NumbersModule.Check(First(args));
KObject head = (args as KPair).Cdr;
while (head is KPair)
{
KObject nextNumber = NumbersModule.Check(First(head));
if (product is KFraction && nextNumber is KFraction)
{
product = (product as KFraction).Multiply(nextNumber as KFraction);
}
else
{
KDouble a = NumbersModule.ToInexact(product);
KDouble b = NumbersModule.ToInexact(nextNumber);
product = new KDouble(a.Value * b.Value);
}
head = (head as KPair).Cdr;
}
return(product);
}
}
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)
{
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 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 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));
}
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));
}
}
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, 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, 1, "encapsulate");
if (res != null)
{
return(CPS.Error(res, cont));
}
KObject datum = First(args);
return(Return(new KEncapsulation(id, datum), cont));
}
public override object Do(KObject args, KEnvironment env, Continuation <KObject> cont)
{
CPara(args, 1);
Console.Write(First(args).Display());
return(new KInert());
}
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 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, 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, 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)
{
return(Predicate(args, "inexcat?", typeof(KDouble), 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 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, 2);
return(new KPair(First(args), Second(args)));
}
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 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 object Do(KObject args, KEnvironment env, Continuation <KObject> cont)
{
return(NumbersModule.Numberp(args, (a, b) => {
return a.LessThan(b);
}));
}
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, 1);
return(First(args) is KBoolean);
}
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));
}