public KeyValuePair <object, Continue> Eval(Env e, Continue k)
{
return(RightNode.Eval(e, v => {
GlobalEnv.Instance()[Index] = v;
return k(null);
}));
}
public object Interpret(object exp)
{
IASTNode node = ASTCompiler.Compile(null, ListProcess.TransformLibraryForms(exp));
GlobalEnv.Instance().ReserveVariables(SymbolTable.GetGlobalSymbolCount());
var lambda = new ASTNode_Lambda {
bodyNode = node, localVarCount = 0, freeAddresses = new List <FreeAddress>(),
};
return(mStack.CallScriptProcedure(new ScriptProcedure(null, CompileToByteCode(lambda)), new List <object> {
}));
}
//=================================================================
static object ForceEval(Env env, object exp)
{
IASTNode node = Compile(null, TransformLibraryForm(exp));
GlobalEnv.Instance().ExtendTo(GlobalSymbolTable.Instance().GetSymbolCount());
KeyValuePair <object, Continue> p = node.Eval(env, (v => new KeyValuePair <object, Continue>(v, null)));;
while (p.Value != null)
{
p = p.Value(p.Key);
}
return(p.Key);
}
private ByteCodeInterpreter()
{
Utils.QueryPerformanceCounter(out mTimerStart);
Utils.QueryPerformanceFrequency(out mTimerFreq);
Dictionary <string, object> builtinVars = new Dictionary <string, object>()
{
{ "true", true },
{ "false", false },
{ "else", true },
{ "null", null },
};
Dictionary <string, HostProcedure> builtinProcedures = new Dictionary <string, HostProcedure>()
{
{ "not", (stack, ret) => stack[ret] = !(bool)stack[ret + 1] },
{ "identity", (stack, ret) => stack[ret] = stack[ret + 1] },
{ "sqr", (stack, ret) => { var a = (INumber)stack[ret + 1]; stack[ret] = a.Mul(a); } },
{ "+", (stack, ret) => stack[ret] = ((INumber)stack[ret + 1]).Add((INumber)stack[ret + 2]) },
{ "-", (stack, ret) => stack[ret] = ((INumber)stack[ret + 1]).Sub((INumber)stack[ret + 2]) },
{ "*", (stack, ret) => stack[ret] = ((INumber)stack[ret + 1]).Mul((INumber)stack[ret + 2]) },
{ "/", (stack, ret) => stack[ret] = ((INumber)stack[ret + 1]).Div((INumber)stack[ret + 2]) },
{ "quotient", (stack, ret) => stack[ret] = ((INumber)stack[ret + 1]).Div((INumber)stack[ret + 2]).CastToInteger() },
{ "remainder", (stack, ret) => stack[ret] = ((INumber)stack[ret + 1]).Mod((INumber)stack[ret + 2]) },
{ "=", (stack, ret) => stack[ret] = stack[ret + 1].Equals(stack[ret + 2]) },
{ "<", (stack, ret) => stack[ret] = (stack[ret + 1] as IComparable).CompareTo(stack[ret + 2]) < 0 },
{ "<=", (stack, ret) => stack[ret] = (stack[ret + 1] as IComparable).CompareTo(stack[ret + 2]) <= 0 },
{ ">", (stack, ret) => stack[ret] = (stack[ret + 1] as IComparable).CompareTo(stack[ret + 2]) > 0 },
{ ">=", (stack, ret) => stack[ret] = (stack[ret + 1] as IComparable).CompareTo(stack[ret + 2]) >= 0 },
{ "eq?", (stack, ret) => stack[ret] = object.ReferenceEquals(stack[ret + 1], stack[ret + 2]) },
{ "cons", (stack, ret) => stack[ret] = new Pair()
{
Car = stack[ret + 1], Cdr = stack[ret + 2]
} },
{ "car", (stack, ret) => stack[ret] = ((Pair)stack[ret + 1]).Car },
{ "cdr", (stack, ret) => stack[ret] = ((Pair)stack[ret + 1]).Cdr },
{ "drop", (stack, ret) => {
Pair l = (Pair)stack[ret + 1]; int n = ((NumberInteger)stack[ret + 2]).value;
for (; n > 0; --n)
{
l = (Pair)l.Cdr;
}
stack[ret] = l;
} },
{ "length", (stack, ret) => {
int n = 0;
for (Pair l = (Pair)stack[ret + 1]; l != null; ++n, l = (Pair)l.Cdr)
{
;
}
stack[ret] = Number.Create(n);
} },
{ "append", (stack, ret) => {
var l = ListProcess.PairToList((Pair)stack[ret + 1]);
l.InsertRange(l.Count, ListProcess.PairToList((Pair)stack[ret + 2]));
stack[ret] = ListProcess.ListToPair(l);
} },
{ "empty?", (stack, ret) => stack[ret] = stack[ret + 1] == null },
{ "pretty-print", (stack, ret) => {
ListProcess.PrintPairExp(stack[ret + 1]);
stack[ret] = null;
} },
{ "display", (stack, ret) => {
ListProcess.PrintListExp(ListProcess.PairExpToListExp(stack[ret + 1]));
stack[ret] = null;
} },
{ "current-inexact-milliseconds", (stack, ret) => {
long now;
Utils.QueryPerformanceCounter(out now);
stack[ret] = Number.Create((decimal)(now - mTimerStart) * 1000 / mTimerFreq);
} },
{ "exit", (stack, ret) => {
Environment.Exit(0);
stack[ret] = null;
} },
{ "random", (stack, ret) => stack[ret] = Number.Create(mRandom.Next(((NumberInteger)stack[ret + 1]).value)) },
{ "eval", (stack, ret) => stack[ret] = Interpret(ListProcess.PairExpToListExp(stack[ret + 1])) },
};
GlobalEnv.Instance().ReserveVariables(builtinVars.Count + builtinProcedures.Count);
foreach (KeyValuePair <string, object> kv in builtinVars)
{
GlobalEnv.Instance().variables[SymbolTable.DefineOrGetGlobalSymbol(kv.Key).index] = kv.Value;
}
foreach (KeyValuePair <string, HostProcedure> kv in builtinProcedures)
{
GlobalEnv.Instance().variables[SymbolTable.DefineOrGetGlobalSymbol(kv.Key).index] = kv.Value;
}
}
public object CallScriptProcedure(ScriptProcedure procedure, List <object> actuals)
{
int startFrame = frames.Count;
int startEvalStack = evalStack.Count;
{
Env localEnv = new Env {
prevEnv = null, variables = new object[procedure.meta.localVarCount],
};
for (int i = 0; i < actuals.Count; ++i)
{
localEnv.variables[i] = actuals[i];
}
frames.Push(new StackFrame {
procedure = procedure, localEnv = localEnv, pc = 0,
});
}
Label_PeekFrame:
while (frames.Count > startFrame)
{
if (frames.Count > MaxStackFrameCount)
{
throw new Exception("Stack frame overflow: " + MaxStackFrameCount);
}
if (evalStack.Count > MaxEvalStackDepth)
{
throw new Exception("Eval stack overflow: " + MaxEvalStackDepth);
}
StackFrame frame = frames.Peek();
object[] localVaraibles = frame.localEnv.variables;
object[][] freeVariables = frame.procedure.freeVariables;
List <object> globalVariables = GlobalEnv.Instance().variables;
object[] literals = frame.procedure.meta.literals;
int[] byteCodes = frame.procedure.meta.byteCodes;
int pc = frame.pc;
while (pc < byteCodes.Length)
{
switch (byteCodes[pc])
{
case ByteCodeEnum.PUSH_LITERAL: {
evalStack.Add(literals[byteCodes[pc + 1]]);
pc += 2;
}
break;
case ByteCodeEnum.PUSH_LOCAL: {
evalStack.Add(localVaraibles[byteCodes[pc + 1]]);
pc += 2;
}
break;
case ByteCodeEnum.POP_LOCAL: {
localVaraibles[byteCodes[pc + 1]] = evalStack.Last();
evalStack.RemoveAt(evalStack.Count - 1);
pc += 2;
}
break;
case ByteCodeEnum.PUSH_GLOBAL: {
evalStack.Add(globalVariables[byteCodes[pc + 1]]);
pc += 2;
}
break;
case ByteCodeEnum.POP_GLOBAL: {
globalVariables[byteCodes[pc + 1]] = evalStack.Last();
evalStack.RemoveAt(evalStack.Count - 1);
pc += 2;
}
break;
case ByteCodeEnum.PUSH_FREE: {
evalStack.Add(freeVariables[byteCodes[pc + 1]][byteCodes[pc + 2]]);
pc += 3;
}
break;
case ByteCodeEnum.POP_FREE: {
freeVariables[byteCodes[pc + 1]][byteCodes[pc + 2]] = evalStack.Last();
evalStack.RemoveAt(evalStack.Count - 1);
pc += 3;
}
break;
case ByteCodeEnum.POP1: {
evalStack.RemoveAt(evalStack.Count - 1);
pc += 1;
}
break;
case ByteCodeEnum.CJMP: {
var b = (bool)evalStack.Last();
evalStack.RemoveAt(evalStack.Count - 1);
if (b)
{
pc = byteCodes[pc + 1];
}
else
{
pc += 2;
}
}
break;
case ByteCodeEnum.JMP: {
pc = byteCodes[pc + 1];
}
break;
case ByteCodeEnum.PUSH_SCRIPT_PROCEDURE: {
evalStack.Add(new ScriptProcedure(frame.localEnv, (ScriptProcedureMeta)literals[byteCodes[pc + 1]]));
pc += 2;
}
break;
case ByteCodeEnum.TAIL_CALL:
case ByteCodeEnum.CALL: {
int actualCount = byteCodes[pc + 1];
object p = evalStack[evalStack.Count - actualCount - 1];
var hostProcuedure = p as HostProcedure;
if (hostProcuedure != null)
{
hostProcuedure(evalStack, evalStack.Count - actualCount - 1);
evalStack.RemoveRange(evalStack.Count - actualCount, actualCount);
pc += 2;
}
else
{
if (byteCodes[pc] == ByteCodeEnum.TAIL_CALL)
{
frames.Pop();
}
else
{
frame.pc = pc + 2;
}
var scriptProcedure = (ScriptProcedure)p;
Env localEnv = new Env {
prevEnv = scriptProcedure.freeEnv, variables = new object[scriptProcedure.meta.localVarCount]
};
for (int i = 0; i < actualCount; ++i)
{
localEnv.variables[i] = evalStack[evalStack.Count - actualCount + i];
}
evalStack.RemoveRange(evalStack.Count - actualCount - 1, actualCount + 1);
frames.Push(new StackFrame {
procedure = scriptProcedure, localEnv = localEnv, pc = 0
});
goto Label_PeekFrame;
}
}
break;
default:
throw new Exception("Unkown bytecode :" + byteCodes[pc]);
}
}
frames.Pop();
}
object r = evalStack[startEvalStack];
evalStack.RemoveAt(startEvalStack);
return(r);
}
static void SetupGlobalEnv()
{
Dictionary <string, object> builtinVars = new Dictionary <string, object>()
{
{ "true", true },
{ "false", false },
{ "else", true },
{ "null", null },
};
Dictionary <string, Procedure> builtinProcedures = new Dictionary <string, Procedure>()
{
{ "not", (args, k) => k(!(bool)args[0]) },
{ "identity", (args, k) => k(args[0]) },
{ "sqr", (args, k) => {
if (args[0] is BigInteger)
{
var a = (BigInteger)args[0]; return(k(a * a));
}
else
{
var a = (decimal)args[0]; return(k(a * a));
}
} },
{ "+", (args, k) => {
if (args[0] is decimal || args[1] is decimal)
{
return(k(CastToDecimal(args[0]) + CastToDecimal(args[1])));
}
return(k((BigInteger)args[0] + (BigInteger)args[1]));
} },
{ "-", (args, k) => {
if (args[0] is decimal || args[1] is decimal)
{
return(k(CastToDecimal(args[0]) - CastToDecimal(args[1])));
}
return(k((BigInteger)args[0] - (BigInteger)args[1]));
} },
{ "*", (args, k) => {
if (args[0] is decimal || args[1] is decimal)
{
return(k(CastToDecimal(args[0]) * CastToDecimal(args[1])));
}
return(k((BigInteger)args[0] * (BigInteger)args[1]));
} },
{ "/", (args, k) => {
if (args[0] is decimal || args[1] is decimal)
{
return(k(CastToDecimal(args[0]) / CastToDecimal(args[1])));
}
return(k((BigInteger)args[0] / (BigInteger)args[1]));
} },
{ "quotient", (args, k) => {
if (args[0] is decimal || args[1] is decimal)
{
return(k((BigInteger)(CastToDecimal(args[0]) / CastToDecimal(args[1]))));
}
return(k((BigInteger)args[0] / (BigInteger)args[1]));
} },
{ "remainder", (args, k) => {
if (args[0] is decimal || args[1] is decimal)
{
return(k(CastToDecimal(args[0]) % CastToDecimal(args[1])));
}
return(k((BigInteger)args[0] % (BigInteger)args[1]));
} },
{ "=", (args, k) => k(args[0].Equals(args[1])) },
{ "<", (args, k) => k((args[0] as IComparable).CompareTo(args[1]) < 0) },
{ "<=", (args, k) => k((args[0] as IComparable).CompareTo(args[1]) <= 0) },
{ ">", (args, k) => k((args[0] as IComparable).CompareTo(args[1]) > 0) },
{ ">=", (args, k) => k((args[0] as IComparable).CompareTo(args[1]) >= 0) },
{ "eq?", (args, k) => k(object.ReferenceEquals(args[0], args[1])) },
{ "cons", (args, k) => k(new Pair()
{
Car = args[0], Cdr = args[1]
}) },
{ "car", (args, k) => k(((Pair)args[0]).Car) },
{ "cdr", (args, k) => k(((Pair)args[0]).Cdr) },
{ "drop", (args, k) => {
Pair l = (Pair)args[0]; int n = (int)(BigInteger)args[1];
for (; n > 0; --n)
{
l = (Pair)l.Cdr;
}
return(k(l));
} },
{ "length", (args, k) => {
int n = 0;
for (Pair l = (Pair)args[0]; l != null; ++n, l = (Pair)l.Cdr)
{
;
}
return(k(n));
} },
{ "append", (args, k) => {
var l = PairToList((Pair)args[0]);
l.InsertRange(l.Count, PairToList((Pair)args[1]));
return(k(ListToPair(l)));
} },
{ "empty?", (args, k) => k(args[0] == null) },
{ "pretty-print", (args, k) => {
PrintPairExp(args[0]);
return(k(null));
} },
{ "display", (args, k) => {
PrintListExp(PairExpToListExp(args[0]));
return(k(null));
} },
{ "current-inexact-milliseconds", (args, k) => {
long now;
QueryPerformanceCounter(out now);
return(k((decimal)(now - sTimerStart) * 1000 / sTimerFreq));
} },
{ "exit", (args, k) => {
Environment.Exit(0);
return(k(null));
} },
{ "random", (args, k) => k((BigInteger)sRandom.Next((int)(BigInteger)args[0])) },
{ "eval", (args, k) => k(ForceEval(null, PairExpToListExp(args[0]))) },
{ "call/cc", (args, k) => {
return(((Procedure)args[0])(new List <object>()
{
(Procedure)((args2, k2) => new KeyValuePair <object, Continue>(args2[0], k)),
}, k));
} },
};
GlobalEnv.Instance().ExtendTo(builtinVars.Count + builtinProcedures.Count);
foreach (var nameValue in builtinVars)
{
int index = GlobalSymbolTable.Instance().LookupOrDefine(nameValue.Key);
GlobalEnv.Instance()[index] = nameValue.Value;
}
foreach (var nameValue in builtinProcedures)
{
int index = GlobalSymbolTable.Instance().LookupOrDefine(nameValue.Key);
GlobalEnv.Instance()[index] = nameValue.Value;
}
}
public KeyValuePair <object, Continue> Eval(Env e, Continue k)
{
return(k(GlobalEnv.Instance()[Index]));
}