public void Parse(Environment outer, Environment env, Type result, Substitution subst) { try { var fullType = Arguments.Select(arg => arg.Parse(env, subst)).Reverse().Aggregate( result, (res, cur) => new FunctionType(cur, res) ).Perform(subst).Generalize(outer); var constructor = new DataConstructor(fullType, Name, result, Arguments.Count); Func <ImmutableList <LazyValue>, LazyValue> function = arguments => new DataValue(constructor, arguments.ToList()); for (var i = 0; i < Arguments.Count; ++i) { var backup = function; function = arguments => new FunctionValue(arg => backup(arguments.Add(arg))); } outer.Bind(Name, constructor); outer.Bind(Name, fullType); outer.Bind(Name, function(ImmutableList.Create(new LazyValue[] {}))); } catch (StackedException ex) { ex.Push("In a data type constructor declaration: " + ex); throw; } }
public void AddImpure() { Evaluate("data Ref a case Ref of a"); Evaluate("def get (Ref x) as x"); Evaluate("def set (Ref x) y as if x == y then ()"); // Force the correct type _env.Bind("set", new FunctionValue(rf => new FunctionValue(val => { ((DataValue)rf.WHNFValue).Arguments[0] = val; return(Defaults.Unit); }))); Evaluate("def modify f x as set x (f (get x))"); Evaluate("def print a as ()"); _env.Bind("print", new FunctionValue(val => { Write(val.NormalFormValue.ToString()); return(Defaults.Unit); })); Evaluate("def putStr x as if head x == 'a' then ()"); // Force the correct type _env.Bind("putStr", new FunctionValue(val => { var sb = new StringBuilder(); for (var evaluated = (DataValue)val.NormalFormValue; evaluated.Constructor.Name != "Nil"; evaluated = (DataValue)evaluated.Arguments[1].NormalFormValue) { sb.Append(((CharacterValue)evaluated.Arguments[0].NormalFormValue).Value); } Write(sb.ToString()); return(Defaults.Unit); })); Evaluate("def operator ; x y as y"); _env.Bind(";", new FunctionValue(x => new FunctionValue(y => { x.Value = x.WHNFValue; return(y); }))); Evaluate("def operator ;; x y as y"); _env.Bind(";;", new FunctionValue(x => new FunctionValue(y => { x.Value = x.NormalFormValue; return(y); }))); Evaluate(@"def putStrLn x as putStr x; putStr ""\n"""); }