static object ListToString(object list)
{
string outStr = "";
while (list != null)
{
outStr += (char)Cons.Car(list);
list = Cons.Cdr(list);
}
return(outStr);
}
object RunClosure(Closure closure, params object[] args)
{
var prevCONT = _cont;
var prevENVT = _envt;
var prevEvalStack = _evalStack;
var prevTEMPLATE = _template;
var prevPC = _pc;
_cont = null;
_envt = closure.Envt;
_evalStack = Cons.Reverse(Cons.ConsFromArray(args));
_template = closure.Template;
_pc = 0;
_value = Void.TheVoidValue;
try {
while (true)
{
var i = _template.Code[_pc];
switch (i.OpCode)
{
case Instruction.OpCodes.Push:
_evalStack = new Cons(_value, _evalStack);
_pc++;
break;
case Instruction.OpCodes.Bind: {
var numOfBindings = (int)i.AX;
_envt = new LexicalEnvironment(_envt, numOfBindings);
for (var x = 0; x < numOfBindings; x++)
{
_envt.Bindings[numOfBindings - 1 - x] = Cons.Car(_evalStack);
_evalStack = Cons.Cdr(_evalStack);
}
if (_evalStack != null)
{
throw new InvalidOperationException("Too many parameters given to function");
}
_pc++;
}
break;
case Instruction.OpCodes.ToplevelGet:
_value = ToplevelLookup(_value as Symbol);
_pc++;
break;
case Instruction.OpCodes.SaveContinuation:
_cont = new Continuation(_cont, _envt, _evalStack, _template, i.AX);
_evalStack = null;
_pc++;
break;
case Instruction.OpCodes.FetchLiteral:
_value = _template.Literals[i.AX];
_pc++;
break;
case Instruction.OpCodes.LocalGet: {
LexicalEnvironment envt = _envt;
for (int x = 0; x < i.A; x++)
{
envt = envt.Parent;
}
_value = envt.Bindings[i.B];
_pc++;
}
break;
case Instruction.OpCodes.JumpIfFalse: {
if (_value is bool && ((bool)_value == false))
{
_pc = i.AX;
}
else
{
_pc++;
}
}
break;
case Instruction.OpCodes.BindVarArgs: {
var numOfBindings = (int)i.AX;
_envt = new LexicalEnvironment(_envt, numOfBindings);
// parameters are reversed on EVAL stack
_evalStack = Cons.Reverse(_evalStack);
for (var x = 0; x < numOfBindings; x++)
{
// if it is the last binding, take the rest of the EVAL_STACK
if (x == numOfBindings - 1)
{
_envt.Bindings[x] = _evalStack;
_evalStack = null;
}
else
{
_envt.Bindings[x] = Cons.Car(_evalStack);
_evalStack = Cons.Cdr(_evalStack);
}
}
_pc++;
}
break;
case Instruction.OpCodes.MakeClosure:
_value = new Closure(_envt, _value as Template);
_pc++;
break;
case Instruction.OpCodes.Return:
Return();
break;
case Instruction.OpCodes.ToplevelSet:
_toplevelEnv[_value as Symbol] = Cons.Car(_evalStack);
_evalStack = Cons.Cdr(_evalStack);
_pc++;
break;
case Instruction.OpCodes.Apply: {
if (_value is Closure)
{
var clos = _value as Closure;
_envt = clos.Envt;
_template = clos.Template;
_value = Void.TheVoidValue;
_pc = 0;
}
else if (_value is Func <object> )
{
var func = _value as Func <object>;
_value = func();
Return();
}
else if (_value is Func <object, object> )
{
var func = _value as Func <object, object>;
_value = func(Cons.Car(_evalStack));
Return();
}
else if (_value is Func <object, object, object> )
{
var func = _value as Func <object, object, object>;
_value = func(Cons.Car(Cons.Cdr(_evalStack)), Cons.Car(_evalStack));
Return();
}
else if (_value is Func <object, object, object, object> )
{
var func = _value as Func <object, object, object, object>;
_value = func(Cons.Car(Cons.Cdr(Cons.Cdr(_evalStack))), Cons.Car(Cons.Cdr(_evalStack)), Cons.Car(_evalStack));
Return();
}
else if (_value is Func <object, object, object, object, object> )
{
var func = _value as Func <object, object, object, object, object>;
_value = func(Cons.Car(Cons.Cdr(Cons.Cdr(Cons.Cdr(_evalStack)))), Cons.Car(Cons.Cdr(Cons.Cdr(_evalStack))), Cons.Car(Cons.Cdr(_evalStack)), Cons.Car(_evalStack));
Return();
}
else if (_value is Func <object[], object> )
{
var func = _value as Func <object[], object>;
_value = func(Cons.ToReverseObjectArray(_evalStack));
Return();
}
else
{
throw new LunulaException("VALUE register does not contain a callable object: " + _value);
}
}
break;
case Instruction.OpCodes.LocalSet: {
var envt = _envt;
for (var x = 0; x < i.A; x++)
{
envt = envt.Parent;
}
envt.Bindings[i.B] = _value;
_pc++;
}
break;
case Instruction.OpCodes.Jump:
_pc = i.AX;
break;
case Instruction.OpCodes.End:
_finished = true;
break;
default:
throw new InvalidOperationException("Invalid instruction");
}
if (_finished)
{
_finished = false;
return(_value);
}
}
} finally {
_cont = prevCONT;
_envt = prevENVT;
_evalStack = prevEvalStack;
_template = prevTEMPLATE;
_pc = prevPC;
}
}
static object Cdr(object cons)
{
return(Cons.Cdr(cons));
}