public override bool EvalStep(out object answer, ref Control expression, ref Environment environment)
{
#if DEBUG
Warm("-");
Primitive.hotPrimitives.Note(this.procedure);
SCode.location = this.procedure.Name.ToString();
#endif
if (this.method(out answer))
{
TailCallInterpreter tci = answer as TailCallInterpreter;
if (tci != null)
{
answer = null; // dispose of the evidence
// set up the interpreter for a tail call
expression = tci.Expression;
environment = tci.Environment;
return(true);
}
else
{
throw new NotImplementedException();
}
}
else
{
return(false);
}
}
public static bool Exit(out object answer, object arg)
{
UnwinderState env = new UnwinderState(null);
env.ExitValue = arg;
// Return from the primitive with instructions to unwind the stack.
answer = new TailCallInterpreter(Interpreter.UnwindStackExpression, env);
return(true);
}
public static bool Add(out object answer, object left, object right)
{
if (left is int && right is int)
{
answer = (int)left + (int)right;
return(false);
}
answer = new TailCallInterpreter(CallFromPrimitive.Make((IApplicable)FixedObjectsVector.GenericAdd, left, right), null);
return(true);
}
public static bool WithStackMarker(out object answer, object thunk, object mark1, object mark2)
{
IApplicable athunk = thunk as IApplicable;
if (athunk == null)
{
throw new NotImplementedException("Thunk is not applicable.");
}
answer = new TailCallInterpreter(new StackMarker(athunk, mark1, mark2), null);
return(true);
}
public static bool WithHistoryDisabled(out object answer, object arg0)
{
IApplicable thunk = arg0 as IApplicable;
if (thunk == null)
{
throw new NotImplementedException("Thunk is not applicable.");
}
answer = new TailCallInterpreter(new HistoryDisabled(thunk), null);
return(true);
}
public static bool WithInterruptMask(out object answer, object arg0, object arg1)
{
IApplicable receiver = arg1 as IApplicable;
if (receiver == null)
{
throw new NotImplementedException("Receiver is not applicable.");
}
answer = new TailCallInterpreter(new InterruptMask(arg0, receiver), null);
return(true);
}
public static bool ScodeEval(out object answer, object arg0, object arg1)
{
Environment env = Environment.ToEnvironment(arg1);
//CompileTimeEnvironment ctenv = (env is StandardEnvironment)
// ? new CompileTimeEnvironment (((StandardEnvironment) env).Closure.Lambda.Formals)
// : new CompileTimeEnvironment (null);
SCode sarg0 = SCode.EnsureSCode(arg0);
answer = new TailCallInterpreter(sarg0.PartialEval(PartialEnvironment.Make((ITopLevelEnvironment)env)).Residual, env);
return(true);
}
public override bool EvalStep(out object answer, ref Control expression, ref Environment environment)
{
#if DEBUG
Warm("-");
procedureHistogram.Note(this.procedure);
SCode.location = "POr1S";
#endif
object ev0;
if (environment.StaticValue(out ev0, this.arg0Name, this.arg0Offset))
{
throw new NotImplementedException();
}
#if DEBUG
SCode.location = this.procedure.Name.ToString();
Primitive.hotPrimitives.Note(this.procedure);
#endif
// It is expensive to bounce down to invoke the procedure
// we invoke it directly and pass along the ref args.
if (this.method(out answer, ev0))
{
TailCallInterpreter tci = answer as TailCallInterpreter;
if (tci != null)
{
answer = null; // dispose of the evidence
// set up the interpreter for a tail call
Control cExpression = tci.Expression;
Environment cEnvironment = tci.Environment;
while (cExpression.EvalStep(out answer, ref cExpression, ref cEnvironment))
{
}
;
}
}
#if DEBUG
SCode.location = "POr1S";
#endif
if ((answer is bool) && (bool)answer == false)
{
#if DEBUG
NoteCalls(this.alternative);
alternativeTypeHistogram.Note(this.alternativeType);
#endif
expression = this.alternative;
return(true);
}
else
{
return(false);
}
}
public static bool IsLess(out object answer, object left, object right)
{
// Shortcut for fixnums
if (left is int && right is int)
{
answer = ((int)left < (int)right) ? Constant.sharpT : Constant.sharpF;
return(false);
}
else
{
answer = new TailCallInterpreter(CallFromPrimitive.Make((IApplicable)FixedObjectsVector.GenericLessP, left, right), null);
}
return(true);
}
public static bool UserApply(out object answer, object arg0, object arg1)
{
////Primitive.Noisy = true;
IApplicable op = arg0 as IApplicable;
Cons rands = arg1 as Cons;
if (op == null)
{
throw new NotImplementedException("Apply non applicable.");
}
if (arg1 != null && rands == null)
{
throw new NotImplementedException("Bad list to apply.");
}
answer = new TailCallInterpreter(new ApplyFromPrimitive(op, rands), null);
return(true); // special return
}
public static bool WithinControlPoint(out object answer, object arg0, object arg1)
{
// extreme hair ahead
IApplicable thunk = arg1 as IApplicable;
if (thunk == null)
{
throw new NotImplementedException("Thunk is not applicable.");
}
// Create an initial unwinder state. After reload, we resume at
// WithinControlPointFrame.
UnwinderState env = new UnwinderState((ControlPoint)arg0, new WithinControlPointFrame(thunk));
// Return from the primitive with instructions to unwind the stack.
answer = new TailCallInterpreter(Interpreter.UnwindStackExpression, env);
return(true);
}
public static bool CallWithCurrentContinuation(out object answer, object arg)
{
//if (cwccTroubleCount++ > 7) Debugger.Break ();
// extreme hair ahead
IApplicable receiver = arg as IApplicable;
if (receiver == null)
{
throw new NotImplementedException("Receiver cannot be applied.");
}
// Create an initial unwinder state. After reload, we resume at
// CWCCFrame0.
UnwinderState env = new UnwinderState(new CWCCFrame0(receiver));
// Return from the primitive with instructions to unwind the stack.
answer = new TailCallInterpreter(Interpreter.UnwindStackExpression, env);
return(true);
}
public bool Call(out object answer, ref Control expression, ref Environment environment, object arg0, object arg1, object arg2)
{
#if DEBUG
hotPrimitives.Note(this);
SCode.location = this.Name.ToString();
#endif
if (this.method(out answer, arg0, arg1, arg2))
{
TailCallInterpreter tci = answer as TailCallInterpreter;
if (tci == null)
{
throw new NotImplementedException();
}
answer = null;
expression = tci.Expression;
environment = tci.Environment;
return(true);
}
return(false);
}
public static bool WithStackMarker(out object answer, object thunk, object mark1, object mark2)
{
IApplicable athunk = thunk as IApplicable;
if (athunk == null) throw new NotImplementedException ("Thunk is not applicable.");
answer = new TailCallInterpreter (new StackMarker (athunk, mark1, mark2), null);
return true;
}
public static bool CallWithCurrentContinuation(out object answer, object arg)
{
//if (cwccTroubleCount++ > 7) Debugger.Break ();
// extreme hair ahead
IApplicable receiver = arg as IApplicable;
if (receiver == null) throw new NotImplementedException ("Receiver cannot be applied.");
// Create an initial unwinder state. After reload, we resume at
// CWCCFrame0.
UnwinderState env = new UnwinderState (new CWCCFrame0 (receiver));
// Return from the primitive with instructions to unwind the stack.
answer = new TailCallInterpreter (Interpreter.UnwindStackExpression, env);
return true;
}
public static bool WithinControlPoint(out object answer, object arg0, object arg1)
{
// extreme hair ahead
IApplicable thunk = arg1 as IApplicable;
if (thunk == null) throw new NotImplementedException ("Thunk is not applicable.");
// Create an initial unwinder state. After reload, we resume at
// WithinControlPointFrame.
UnwinderState env = new UnwinderState ((ControlPoint) arg0, new WithinControlPointFrame (thunk));
// Return from the primitive with instructions to unwind the stack.
answer = new TailCallInterpreter (Interpreter.UnwindStackExpression, env);
return true;
}
public static bool WithInterruptMask(out object answer, object arg0, object arg1)
{
IApplicable receiver = arg1 as IApplicable;
if (receiver == null) throw new NotImplementedException ("Receiver is not applicable.");
answer = new TailCallInterpreter (new InterruptMask (arg0, receiver), null);
return true;
}
public static bool UserApply(out object answer, object arg0, object arg1)
{
////Primitive.Noisy = true;
IApplicable op = arg0 as IApplicable;
Cons rands = arg1 as Cons;
if (op == null) throw new NotImplementedException ("Apply non applicable.");
if (arg1 != null && rands == null) throw new NotImplementedException ("Bad list to apply.");
answer = new TailCallInterpreter (new ApplyFromPrimitive (op, rands), null);
return true; // special return
}
public static bool WithHistoryDisabled(out object answer, object arg0)
{
IApplicable thunk = arg0 as IApplicable;
if (thunk == null) throw new NotImplementedException ("Thunk is not applicable.");
answer = new TailCallInterpreter (new HistoryDisabled (thunk), null);
return true;
}
public static bool ScodeEval(out object answer, object arg0, object arg1)
{
Environment env = Environment.ToEnvironment (arg1);
//CompileTimeEnvironment ctenv = (env is StandardEnvironment)
// ? new CompileTimeEnvironment (((StandardEnvironment) env).Closure.Lambda.Formals)
// : new CompileTimeEnvironment (null);
SCode sarg0 = SCode.EnsureSCode (arg0);
answer = new TailCallInterpreter (sarg0.PartialEval(PartialEnvironment.Make((ITopLevelEnvironment) env)).Residual, env);
return true;
}
public static bool Exit(out object answer, object arg)
{
UnwinderState env = new UnwinderState (null);
env.ExitValue = arg;
// Return from the primitive with instructions to unwind the stack.
answer = new TailCallInterpreter (Interpreter.UnwindStackExpression, env);
return true;
}
public static bool Remainder(out object answer, object left, object right)
{
answer = new TailCallInterpreter(CallFromPrimitive.Make((IApplicable)FixedObjectsVector.GenericRemainder, left, right), null);
return(true);
}
public override bool EvalStep(out object answer, ref Control expression, ref Environment environment)
{
#if DEBUG
Warm("POr1.EvalStep");
NoteCalls(this.arg0);
procedureHistogram.Note(this.procedure);
arg0TypeHistogram.Note(this.arg0Type);
#endif
Control unev0 = this.arg0;
Environment env = environment;
object ev0;
while (unev0.EvalStep(out ev0, ref unev0, ref env))
{
}
;
if (ev0 == Interpreter.UnwindStack)
{
throw new NotImplementedException();
//((UnwinderState) env).AddFrame (new PrimitiveCombination1Frame0 (this, closureEnvironment));
//answer = Interpreter.Unwind;
//closureEnvironment = env;
//return false;
}
#if DEBUG
SCode.location = this.procedure.Name.ToString();
Primitive.hotPrimitives.Note(this.procedure);
#endif
//Console.WriteLine ("Procedure: {2} Method: {0}, Arg: {1}", this.method.Method.Name, ev0, this.procedure);
// It is expensive to bounce down to invoke the procedure
// we invoke it directly and pass along the ref args.
if (this.method(out answer, ev0))
{
TailCallInterpreter tci = answer as TailCallInterpreter;
if (tci != null)
{
answer = null; // dispose of the evidence
// set up the interpreter for a tail call
Control cExpression = tci.Expression;
Environment cEnvironment = tci.Environment;
while (cExpression.EvalStep(out answer, ref cExpression, ref cEnvironment))
{
}
;
}
}
if ((answer is bool) && (bool)answer == false)
{
#if DEBUG
NoteCalls(this.alternative);
alternativeTypeHistogram.Note(this.alternativeType);
#endif
expression = this.alternative;
return(true);
}
else
{
return(false);
}
}
public override bool EvalStep(out object answer, ref Control expression, ref Environment environment)
{
#if DEBUG
Warm("-");
NoteCalls(this.rand0);
rand0TypeHistogram.Note(this.rand0Type);
NoteCalls(this.rand1);
rand1TypeHistogram.Note(this.rand1Type);
SCode.location = "PrimitiveLessThan";
#endif
// Eval argument1
object ev1;
Control unev = this.rand1;
Environment env = environment;
while (unev.EvalStep(out ev1, ref unev, ref env))
{
}
;
#if DEBUG
SCode.location = "PrimitiveLessThan";
#endif
if (ev1 == Interpreter.UnwindStack)
{
throw new NotImplementedException();
//((UnwinderState) env).AddFrame (new PrimitiveCombination2Frame0 (this, environment));
//answer = Interpreter.UnwindStack;
//environment = env;
//return false;
}
// Eval argument0
object ev0;
unev = this.rand0;
env = environment;
while (unev.EvalStep(out ev0, ref unev, ref env))
{
}
;
#if DEBUG
SCode.location = "PrimitiveLessThan";
#endif
if (ev0 == Interpreter.UnwindStack)
{
throw new NotImplementedException();
//((UnwinderState) env).AddFrame (new PrimitiveCombination2Frame0 (this, environment));
//answer = Interpreter.UnwindStack;
//environment = env;
//return false;
}
// less-than-fixnum?
// Shortcut for fixnums
if (ev0 is int && ev1 is int)
{
answer = ((int)ev0 < (int)ev1) ? Constant.sharpT : Constant.sharpF;
return(false);
}
else
{
answer = new TailCallInterpreter(CallFromPrimitive.Make((IApplicable)FixedObjectsVector.GenericLessP, ev0, ev1), null);
}
return(true);
}
public override bool EvalStep(out object answer, ref Control expression, ref Environment environment)
{
#if DEBUG
Warm ("-");
NoteCalls (this.rand0);
rand0TypeHistogram.Note (this.rand0Type);
NoteCalls (this.rand1);
rand1TypeHistogram.Note (this.rand1Type);
SCode.location = "PrimitiveLessThan";
#endif
// Eval argument1
object ev1;
Control unev = this.rand1;
Environment env = environment;
while (unev.EvalStep (out ev1, ref unev, ref env)) { };
#if DEBUG
SCode.location = "PrimitiveLessThan";
#endif
if (ev1 == Interpreter.UnwindStack) {
throw new NotImplementedException ();
//((UnwinderState) env).AddFrame (new PrimitiveCombination2Frame0 (this, environment));
//answer = Interpreter.UnwindStack;
//environment = env;
//return false;
}
// Eval argument0
object ev0;
unev = this.rand0;
env = environment;
while (unev.EvalStep (out ev0, ref unev, ref env)) { };
#if DEBUG
SCode.location = "PrimitiveLessThan";
#endif
if (ev0 == Interpreter.UnwindStack) {
throw new NotImplementedException ();
//((UnwinderState) env).AddFrame (new PrimitiveCombination2Frame0 (this, environment));
//answer = Interpreter.UnwindStack;
//environment = env;
//return false;
}
// less-than-fixnum?
// Shortcut for fixnums
if (ev0 is int && ev1 is int) {
answer = ((int) ev0 < (int) ev1) ? Constant.sharpT : Constant.sharpF;
return false;
}
else
answer = new TailCallInterpreter (CallFromPrimitive.Make ((IApplicable) FixedObjectsVector.GenericLessP, ev0, ev1), null);
return true;
}
public static bool IsPositive(out object answer, object arg)
{
answer = new TailCallInterpreter(CallFromPrimitive.Make((IApplicable)FixedObjectsVector.GenericPositiveP, arg), null);
return(true);
}
