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