public static void BindFormalTree(KObject formal, KObject vals, KEnvironment env, KObject ctxt = null)
{
if (ctxt == null)
{
ctxt = formal;
}
if (formal is KSymbol)
{
env.Bind(((KSymbol)formal).Value, vals);
}
else if (formal is KIgnore)
{
return;
}
else if (formal is KNil && vals is KNil)
{
return;
}
else if (formal is KPair && vals is KPair)
{
KPair f = formal as KPair;
KPair v = vals as KPair;
BindFormalTree(f.Car, v.Car, env, ctxt);
BindFormalTree(f.Cdr, v.Cdr, env, ctxt);
}
else
{
throw new RuntimeException("Can't bind formal tree of " + ctxt.Write());
}
}
public override string Print(bool quoteStrings)
{
StringBuilder sb = new StringBuilder();
sb.Append("(");
KPair cur = this;
while (true)
{
sb.Append(cur.Car.Print(quoteStrings));
if (cur.Cdr is KNil)
{
sb.Append(")");
break;
}
else
{
if (cur.Cdr is KPair)
{
cur = (KPair)cur.Cdr;
sb.Append(" ");
}
else
{
sb.Append(" . ");
sb.Append(cur.Cdr.Print(quoteStrings));
sb.Append(")");
break;
}
}
}
return(sb.ToString());
}
public static int Length(KObject lst)
{
if (lst is KNil)
{
return(0);
}
int length = 0;
if (lst is KPair)
{
KPair cur = lst as KPair;
length++;
while (true)
{
if (cur.Cdr is KNil)
{
return(length);
}
else if (cur.Cdr is KPair)
{
cur = cur.Cdr as KPair;
length++;
}
else
{
return(-1);
}
}
}
else
{
return(-1);
}
}
public static void REPL()
{
init();
while (true)
{
Console.Write(">> ");
KObject datum = readDatum();
if (datum == null)
{
continue;
}
if (datum is KPair)
{
KPair p = datum as KPair;
if (p.Car is KSymbol && ((KSymbol)p.Car).Value.Equals("exit") && p.Cdr is KNil)
{
break;
}
}
try {
datum = Evaluator.Eval(datum, env);
Console.WriteLine("\n" + datum.Write() + "\n");
} catch (RuntimeException e) {
Console.WriteLine("\nRuntimeException: " + e.Message);
}
/*catch (Exception e)
* {
* Console.WriteLine("Something went really wrong: " + e.Message);
* }*/
}
}
public static bool Numberp(KObject args, Func <KFraction, KFraction, bool> cmp)
{
int length = KPair.Length(args);
if (length < 2)
{
throw new RuntimeException("at least two arguments");
}
else
{
KFraction first = ToExact(Check((args as KPair).Car));
KObject head = (args as KPair).Cdr;
while (head is KPair)
{
KFraction next = NumbersModule.ToExact(NumbersModule.Check((head as KPair).Car));
if (!cmp(first, next))
{
return(false);
}
first = next;
head = (head as KPair).Cdr;
}
return(true);
}
}
protected List <string> CheckFormalTree(KObject formaltree)
{
var lst = new List <string>();
if (formaltree is KNil || formaltree is KIgnore)
{
return(lst);
}
else if (formaltree is KSymbol)
{
lst.Add(((KSymbol)formaltree).Value);
return(lst);
}
else if (formaltree is KPair)
{
KPair p = formaltree as KPair;
lst.AddRange(CheckFormalTree(p.Car));
lst.AddRange(CheckFormalTree(p.Cdr));
return(lst);
}
else
{
throw new RuntimeException("Invalid formal tree");
}
}
private List <KGuard> assignGuards(KObject clauses)
{
List <KGuard> result = new List <KGuard>();
if (clauses is KPair)
{
KPair.Foreach(x =>
{
int length = KPair.Length(x);
if (length == 2)
{
KContinuation selector = First(x) as KContinuation;
KApplicative interceptor = Second(x) as KApplicative;
if (selector == null || interceptor == null)
{
throw new RuntimeException("guard-continuation: invalid clause, wrong types");
}
result.Add(new KGuard {
Selector = selector, Interceptor = interceptor
});
}
else
{
throw new RuntimeException("guard-continuation: invalid clause");
}
}, clauses);
}
return(result);
}
protected void CPara(KObject p, int len)
{
int actLen = KPair.Length(p);
if (actLen != len)
{
throw new RuntimeException("mismatching number of ops, expected " + len + ", got " + actLen);
}
}
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 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, 0);
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());
KPair p2 = new KPair(p, p3);
KPair p1 = new KPair(e, p2);
return(p1);
}
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 static void Foreach(Action <KObject> f, KObject lst)
{
while (!(lst is KNil))
{
if (lst is KPair)
{
KPair cur = lst as KPair;
f(cur.Car);
lst = cur.Cdr;
}
else
{
throw new RuntimeException("Improper list passed to foreach");
}
}
return;
}
public static bool CompareEqual(KObject a, KObject b)
{
if (a.CompareTo(b))
{
return(true);
}
else
{
if (a is KPair && b is KPair)
{
KPair ap = a as KPair;
KPair bp = b as KPair;
return(CompareEqual(ap.Car, bp.Car) && CompareEqual(ap.Cdr, bp.Cdr));
}
}
return(false);
}
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)
{
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 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 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 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 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 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));
}
}
private static object read(TokenStream s)
{
Token cur = s.Next();
if (null == cur)
{
return(null);
}
if ("clospa" == cur.Label)
{
return(')');
}
if ("dot" == cur.Label)
{
return('.');
}
if ("openpa" != cur.Label)
{
if (handlers.ContainsKey(cur.Label))
{
return(handlers[cur.Label](cur));
}
else if ("text" == cur.Label)
{
foreach (TextHandler f in textHandlers)
{
object ret = f.Handler(cur);
if (ret as KObject != null)
{
return(ret);
}
}
throw new ParseException("unhandled text");
}
else
{
throw new ParseException("unknown token");
}
}
else
{
// list stuff
List <object> content = new List <object>();
object v = read(s);
bool dotted = false;
while (true)
{
if ((v is char) && ((char)v) == '.')
{
v = read(s);
if (((char)read(s)) != ')')
{
throw new ParseException("Illegal use of dot");
}
if (v is KObject)
{
content.Add(v);
}
else
{
throw new ParseException("Illegal use of dot");
}
dotted = true;
break;
}
else if ((v is char) && ((char)v) == ')')
{
break;
}
else if (v is KObject)
{
content.Add(v);
v = read(s);
}
else
{
throw new ParseException("Parse error");
}
}
int index = content.Count - 1;
KPair tail;
if (dotted)
{
tail = new KPair(content[index - 1] as KObject, content[index] as KObject);
index -= 2;
}
else
{
tail = new KPair(content[index--] as KObject, new KNil());
}
for (int i = index; i >= 0; i--)
{
tail = new KPair(content[i] as KObject, tail);
}
return(tail);
}
}