public static bool IsEqualTo(this TypedTerm first, TypedTerm second)
{
if (first.Tag != second.Tag)
{
return(false);
}
switch (first.Tag)
{
case TypedProductions.Universe:
{
var universe1 = (TypedTerm.Universe)first;
var universe2 = (TypedTerm.Universe)second;
return(universe1.Content.IsEqualTo(universe2.Content));
}
case TypedProductions.Type:
{
var type1 = (TypedTerm.Type)first;
var type2 = (TypedTerm.Type)second;
return(type1.Content.IsEqualTo(type2.Content));
}
case TypedProductions.Constructor:
{
return(false);
}
case TypedProductions.Destructor:
{
var destructor1 = (TypedTerm.Destructor)first;
var destructor2 = (TypedTerm.Destructor)second;
return(destructor1.Operator.IsEqualTo(destructor2.Operator) &&
destructor1.Content.IsEqualTo(destructor2.Content));
}
case TypedProductions.Variable:
{
var variable1 = (TypedTerm.Variable)first;
var variable2 = (TypedTerm.Variable)second;
return(variable1.Identifier == variable2.Identifier);
}
case TypedProductions.Constant:
{
return(false);
}
default:
throw new InvalidProgramException("Should never happen.");
}
}
public static bool FreeVariable(TypedTerm term, string identifier)
{
switch (term.Tag)
{
case TypedProductions.Universe:
{
return(false);
}
case TypedProductions.Type:
{
var type = (TypedTerm.Type)term;
switch (type.Content.Tag)
{
case TypeStructs.Quantified:
var arrow = (TypeStruct.Quantified)type.Content;
return(FreeVariable(arrow.Content.From.Type, identifier) || FreeVariable(arrow.Content.To, identifier));
case TypeStructs.Module:
var module = (TypeStruct.Module)type.Content;
foreach (var entry in module.Content.Members)
{
if (FreeVariable(entry.Type, identifier))
{
return(true);
}
if (entry.Term == identifier)
{
break;
}
}
return(false);
default:
throw new ArgumentOutOfRangeException();
}
}
case TypedProductions.Constructor:
{
var constructor = (TypedTerm.Constructor)term;
switch (constructor.Content.Type)
{
case TypeStructs.Quantified:
var lambda = (Constructors.Arrow)constructor.Content;
if (lambda.Content.Identifier == identifier)
{
return(false);
}
return(FreeVariable(lambda.Content.Body, identifier));
case TypeStructs.Module:
var module = (Constructors.Module)constructor.Content;
return(module.Content.Members.Any(member => FreeVariable(member, identifier)));
default:
throw new ArgumentOutOfRangeException();
}
}
case TypedProductions.Destructor:
{
var destructor = (TypedTerm.Destructor)term;
if (FreeVariable(destructor.Operator.Term, identifier))
{
return(true);
}
switch (destructor.Content.Type)
{
case TypeStructs.Quantified:
var apply = (Destructors.Arrow)destructor.Content;
return(FreeVariable(apply.Content.Operand, identifier));
case TypeStructs.Module:
var access = (Destructors.Module)destructor.Content;
return(false);
default:
throw new ArgumentOutOfRangeException();
}
}
case TypedProductions.Variable:
{
var variable = (TypedTerm.Variable)term;
return(variable.Identifier == identifier);
}
case TypedProductions.Constant:
{
return(false);
}
default:
throw new InvalidProgramException("Should never happen.");
}
}
public static TypedTerm CheckType(Func <string, Classification <dynamic> > doImport, Environment <Classification <TypedTerm> > environment, Classification <TypedTerm> expected, Term term)
{
switch (term.Tag)
{
case Productions.Universe:
{
var universe = (Term.Universe)term;
var higher = (TypedTerm.Universe)expected.Term;
if (higher.Content.Rank == universe.Content.Rank + 1)
{
var @checked = new TypedTerm.Universe(universe.Content);
return(@checked);
}
throw new ArgumentException("Universe must be within a higher universe.");
}
case Productions.Quantified:
{
var type = (Term.Quantified)term;
return(EnsureQuantifiedType(doImport, environment, expected.Some(), type).Term);
}
case Productions.Lambda:
{
var constructor = (Term.Lambda)term;
var type = (TypedTerm.Type)expected.Term;
var arrow = (TypeStruct.Quantified)type.Content;
if (arrow.Content.Polarity != Polarity.Forall)
{
throw new ArgumentException("Type constraint on lambda is of the wrong polarity.");
}
var identifier = constructor.Content.Parameter.Identifier;
if (environment.Maps(identifier))
{
throw new ArgumentException("Shadowing identifier: " + identifier);
}
foreach (var declared in constructor.Content.Parameter.Constraint.Each())
{
var annotation = InferType(doImport, environment, declared).Normalized(environment);
if (!annotation.IsEqualTo(arrow.Content.From.TypeOf()))
{
throw new ArgumentException("Unexpected domain in lambda term.");
}
}
var binding = arrow.Content.From.TypeOf().ShiftDown(identifier);
environment = environment.Push(binding);
var domain = expected.TypeOf().ShiftDown(arrow.Content.To);
var body = CheckType(doImport, environment, domain, constructor.Content.Body);
return(new TypedTerm.Constructor(new Constructors.Arrow(new TypedLambda(identifier, body))));
}
case Productions.Apply:
{
var destructor = (Term.Apply)term;
var argument = InferType(doImport, environment, destructor.Content.Argument);
var arrow = expected.Fmap <TypedTerm, TypedTerm>(@return => new TypedTerm.Type(new TypeStruct.Quantified(new TypedQuantifier(Polarity.Forall, argument.TypeOf().Declared("*"), @return))));
var @operator = CheckType(doImport, environment, arrow, destructor.Content.Operator);
return(new TypedTerm.Destructor(arrow.ShiftDown(@operator), new Destructors.Arrow(new TypedApply(argument.Term))));
}
case Productions.Module:
{
var module = (Term.Module)term;
var universe = (TypedTerm.Universe)expected.Term;
var signature = InferSignature(doImport, environment, module.Content);
return(new TypedTerm.Type(new TypeStruct.Module(signature)));
}
case Productions.New:
{
var @new = (Term.New)term;
var type = (TypedTerm.Type)expected.Term;
var module = (TypeStruct.Module)type.Content;
var length = @new.Content.Members.Length;
if (length != module.Content.Members.Length)
{
throw new ArgumentException("Mismatch between size of signature and module.");
}
TypedTerm[] newStruct = new TypedTerm[length];
foreach (var index in ArrayOperations.CountUp(length))
{
var quantifier = module.Content.Members[index];
var definition = @new.Content.Members[index];
if (quantifier.Term != definition.Identifier)
{
throw new ArgumentException("Mismatch between signature and module member name: " + quantifier.Term);
}
var memberType = quantifier.TypeOf().Normalized(environment);
var body = newStruct[index] = CheckType(doImport, environment, memberType, definition.Body);
var bodySubstitution = memberType.ShiftDown(body);
if (quantifier.Universe.Rank != 0)
{
bodySubstitution = bodySubstitution.Normalized(environment);
}
environment = environment.Push(quantifier.Term, bodySubstitution.Normalized(environment));
}
return(new TypedTerm.Constructor(new Constructors.Module(new TypedModule(newStruct))));
}
case Productions.Access:
{
var access = (Term.Access)term;
var typed = InferMemberAccess(doImport, environment, access.Content);
if (!typed.TypeOf().IsEqualTo(expected))
{
throw new ArgumentException("Mismatch between member type and type constraints: " + access.Content.Name);
}
return(typed.Term);
}
case Productions.Variable:
{
var variable = (Term.Variable)term;
var type = environment.Lookup(variable.Content).TypeOf();
if (!type.IsEqualTo(expected))
{
throw new ArgumentException("Mismatch between type declaration and type constraints: " + variable.Content);
}
return(new TypedTerm.Variable(variable.Content));
}
case Productions.Annotation:
{
var annotation = (Term.Annotation)term;
var type = InferType(doImport, environment, annotation.Content.Type).Normalized(environment);
if (!type.IsEqualTo(expected))
{
throw new ArgumentException("Mismatch between type annotation and type constraints.");
}
return(CheckType(doImport, environment, expected, annotation.Content.Term));
}
case Productions.LetBinding:
{
var letBinding = (Term.LetBinding)term;
if (environment.Maps(letBinding.Content.Identifier))
{
throw new ArgumentException("Shadowing identifier: " + letBinding.Content.Identifier);
}
var defined = InferLet(doImport, environment, letBinding.Content);
var identifier = defined.Term.Key;
environment = environment.Push(identifier, defined.Fmap(_ => _.Value));
var continuation = CheckType(doImport, environment, expected, letBinding.Continuation);
return(new TypedTerm.Destructor(
@operator: new Classification <TypedTerm>(
universe: expected.Declared("*").Universe,
type: new TypedTerm.Type(new TypeStruct.Quantified(new TypedQuantifier(Polarity.Forall, defined.TypeOf().Declared("*"), expected.Term))),
term: new TypedTerm.Constructor(new Constructors.Arrow(new TypedLambda(identifier, continuation)))),
content: new Destructors.Arrow(new TypedApply(@operand: defined.Term.Value))));
}
case Productions.Constant:
{
var constant = (Term.Constant)term;
if (!constant.Content.TypeOf().IsEqualTo(expected))
{
throw new ArgumentException("Mismatch between constant expression and type constraint.");
}
return(new TypedTerm.Constant(constant.Content.Term));
}
case Productions.TypeOf:
{
var typeOf = (Term.TypeOf)term;
var content = InferType(doImport, environment, typeOf.Content).TypeOf();
if (!content.TypeOf().IsEqualTo(expected))
{
throw new ArgumentException("Mismatch between type of expression and type constraint.");
}
return(content.Term);
}
case Productions.Import:
{
var import = (Term.Import)term;
var content = doImport(import.Filename);
if (!content.TypeOf().IsEqualTo(expected))
{
throw new ArgumentException("Mismatch between type of import and type constraint.");
}
return(new TypedTerm.Constant(content.Term));
}
default:
throw new InvalidProgramException("Should never happen.");
}
}
public TypedApply(TypedTerm operand)
{
Operand = operand;
}
public TypedLambda(string identifier, TypedTerm body)
{
Identifier = identifier;
Body = body;
}
public TypedQuantifier(Polarity polarity, Classification <string> @from, TypedTerm to)
{
Polarity = polarity;
From = @from;
To = to;
}
public static dynamic Evaluate(Environment <dynamic> environment, TypedTerm term)
{
switch (term.Tag)
{
case TypedProductions.Constructor:
{
var constructor = (TypedTerm.Constructor)term;
switch (constructor.Content.Type)
{
case TypeStructs.Quantified:
var lambda = (Constructors.Arrow)constructor.Content;
return(new Func <dynamic, dynamic>(x => Evaluate(Push <dynamic>(environment, lambda.Content.Identifier, x), lambda.Content.Body)));
case TypeStructs.Module:
var module = (Constructors.Module)constructor.Content;
return(module.Content.Members.Fmap(member => Evaluate(environment, member)));
default:
throw new ArgumentOutOfRangeException();
}
}
case TypedProductions.Destructor:
{
var destructor = (TypedTerm.Destructor)term;
var type = (TypedTerm.Type)destructor.Operator.Type;
var @operator = Evaluate(environment, destructor.Operator.Term);
switch (destructor.Content.Type)
{
case TypeStructs.Quantified:
var apply = (Destructors.Arrow)destructor.Content;
var arrow = (TypeStruct.Quantified)type.Content;
var operand = Evaluate(environment, apply.Content.Operand);
return(@operator(operand));
case TypeStructs.Module:
var access = (Destructors.Module)destructor.Content;
return(@operator[access.Content.Member]);
default:
throw new ArgumentOutOfRangeException();
}
}
case TypedProductions.Variable:
{
var variable = (TypedTerm.Variable)term;
return(environment.Lookup(variable.Identifier));
}
case TypedProductions.Constant:
{
var constant = (TypedTerm.Constant)term;
return(constant.Value);
}
case TypedProductions.Universe:
case TypedProductions.Type:
{
return(null);
}
default:
throw new InvalidProgramException("Should never happen.");
}
}
