private TiState StepPrim(TiState state, TiNode.Primitive primitive)
{
return(primitive.Type switch
{
PrimitiveType.Constructor constr => PrimConstr(state, constr),
PrimitiveType.Neg _ => PrimUnary(state, a => - a),
PrimitiveType.Add _ => PrimBinaryArith(state, (a, b) => a + b),
PrimitiveType.Sub _ => PrimBinaryArith(state, (a, b) => a - b),
PrimitiveType.Mul _ => PrimBinaryArith(state, (a, b) => a * b),
PrimitiveType.Div _ => PrimBinaryArith(state, (a, b) => a / b),
PrimitiveType.Greater _ => PrimBinaryComp(state, (a, b) => a > b),
PrimitiveType.GreaterEqual _ => PrimBinaryComp(state, (a, b) => a >= b),
PrimitiveType.Less _ => PrimBinaryComp(state, (a, b) => a < b),
PrimitiveType.LessEqual _ => PrimBinaryComp(state, (a, b) => a <= b),
PrimitiveType.Equal _ => PrimBinaryComp(state, (a, b) => a == b),
PrimitiveType.NotEqual _ => PrimBinaryComp(state, (a, b) => a != b),
PrimitiveType.Abort _ => throw new Exception("aborting"),
PrimitiveType.If _ => PrimIf(state),
PrimitiveType.CasePair _ => PrimCasePair(state),
PrimitiveType.CaseList _ => PrimCaseList(state),
PrimitiveType.Stop _ => PrimStop(state),
PrimitiveType.Print _ => PrimPrint(state),
_ => throw new ArgumentOutOfRangeException(nameof(primitive))
});
private TiState Step(TiState state)
{
var headAddr = state.Stack.Peek();
var headNode = state.Heap[headAddr];
return(headNode switch
{
TiNode.Number number => StepNum(state, number),
TiNode.Application application => StepAp(state, application),
TiNode.Supercombinator supercombinator => StepSc(state, supercombinator),
TiNode.Indirection indirection => StepInd(state, indirection),
TiNode.Primitive primitive => StepPrim(state, primitive),
TiNode.Data data => StepData(state, data),
_ => throw new ArgumentOutOfRangeException(nameof(headNode))
});
private (IReadOnlyDictionary <int, TiNode> Heap, IReadOnlyDictionary <Name, int> Globals) BuildInitialHeap(IEnumerable <SupercombinatorDefinition <Name> > supercombinatorDefs)
{
var heap = new Dictionary <int, TiNode>();
var globals = new Dictionary <Name, int>();
foreach (var def in supercombinatorDefs)
{
var addr = heap.Count;
heap[addr] = new TiNode.Supercombinator(def.Name, def.Parameters, def.Body);
globals[def.Name] = addr;
}
foreach (var(name, type) in _primitives)
{
var addr = heap.Count;
heap[addr] = new TiNode.Primitive(name, type);
globals[name] = addr;
}
return(heap, globals);
}
private static (ImmutableDictionary <int, TiNode>, int) Instantiate(Expression <Name> expr, ImmutableDictionary <int, TiNode> heap, ImmutableDictionary <Name, int> env, int?target)
{
switch (expr)
{
case Expression <Name> .Number num:
return(AssignOrAllocate(target, heap, new TiNode.Number(num.Value)));
case Expression <Name> .Application ap:
var(heap1, a1) = Instantiate(ap.Function, heap, env, null);
var(heap2, a2) = Instantiate(ap.Parameter, heap1, env, null);
return(AssignOrAllocate(target, heap2, new TiNode.Application(a1, a2)));
case Expression <Name> .Variable variable:
if (target.HasValue)
{
return(Assign(target.Value, heap, new TiNode.Indirection(env[variable.Name])), target.Value);
}
if (!env.TryGetValue(variable.Name, out var variableAddr))
{
throw new KeyNotFoundException(variable.Name.Value);
}
return(heap, variableAddr);
case Expression <Name> .Let let when !let.IsRecursive:
{
var defns = new Dictionary <Name, int>();
foreach (var definition in let.Definitions)
{
var(newHeap, newAddr) = Instantiate(definition.Item2, heap, env, null);
defns.Add(definition.Item1, newAddr);
heap = newHeap;
}
var newEnv = env.SetItems(defns);
return(Instantiate(let.Body, heap, newEnv, null));
}
case Expression <Name> .Let let when let.IsRecursive:
{
foreach (var(name, _) in let.Definitions)
{
var(newHeap, placeholder) = Allocate(heap, new TiNode.Indirection(-1));
heap = newHeap;
env = env.SetItem(name, placeholder);
}
foreach (var(name, defExpr) in let.Definitions)
{
var targetAddr = env[name];
(heap, _) = Instantiate(defExpr, heap, env, targetAddr);
}
return(Instantiate(let.Body, heap, env, null));
}
case Expression <Name> .Constructor constr:
var node = new TiNode.Primitive(new Name("Pack"), new PrimitiveType.Constructor(constr.Tag, constr.Arity));
return(AssignOrAllocate(target, heap, node));
default: throw new ArgumentOutOfRangeException(nameof(expr));
}
}
