public object CallWithCurrentContinuation(object fun)
{
var cont = new Continuation(_cont, _envt, _evalStack, _template, _pc);
object retval = null;
retval = Apply(fun, new Func<object, object>(r => {
_cont = cont.CONT;
_envt = cont.ENVT;
_evalStack = cont.EVAL_STACK;
_template = cont.TEMPLATE;
_pc = cont.PC;
retval = r;
return r;
}));
return retval;
}
public LexicalEnvironment(LexicalEnvironment parent, int size)
{
Parent = parent;
Bindings = new object[size];
}
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;
}
}
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;
}
}
void Return()
{
if (_cont != null) {
_envt = _cont.ENVT;
_pc = _cont.PC;
_template = _cont.TEMPLATE;
_evalStack = _cont.EVAL_STACK;
_cont = _cont.CONT;
} else {
_finished = true;
}
}