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)); } }