public static Classification <TypedTerm> Normalized(this Classification <TypedTerm> expression, Environment <Classification <TypedTerm> > environment)
{
//return expression.TypeOf().ShiftDown(expression.Term);
return(expression.Fmap(term =>
{
uint count = 0;
return Normal(expression, environment.Fmap(_ => _.Term), ref count);
}));
}
public static TypedTerm Normal(Classification <TypedTerm> expression, Environment <TypedTerm> environment, ref uint count)
{
switch (expression.Term.Tag)
{
case TypedProductions.Universe:
{
return(expression.Term);
}
case TypedProductions.Type:
{
var type = (TypedTerm.Type)expression.Term;
switch (type.Content.Tag)
{
case TypeStructs.Quantified:
var arrow = (TypeStruct.Quantified)type.Content;
var from = arrow.Content.From.TypeOf();
from = new Classification <TypedTerm>(from.Universe, from.Type, Normal(from, environment, ref count));
var substitution = PushSubstitution(ref environment, ref count, arrow.Content.From.Term);
var to = Normal(expression.Fmap(_ => arrow.Content.To), environment, ref count);
return(new TypedTerm.Type(new TypeStruct.Quantified(new TypedQuantifier(arrow.Content.Polarity, from.Declared(substitution), to))));
case TypeStructs.Module:
var module = (TypeStruct.Module)type.Content;
var members = new Classification <string> [module.Content.Members.Length];
for (uint i = 0; i < members.Length; i++)
{
var member = module.Content.Members[i];
var normalMember = Normal(member.TypeOf(), environment, ref count);
members[i] = new Classification <string>(member.Universe, normalMember, member.Term);
}
return(new TypedTerm.Type(new TypeStruct.Module(new Signature(members))));
default:
throw new ArgumentOutOfRangeException();
}
}
case TypedProductions.Constructor:
{
var constructor = (TypedTerm.Constructor)expression.Term;
var type = (TypedTerm.Type)expression.Type;
switch (type.Content.Tag)
{
case TypeStructs.Quantified:
var arrow = (TypeStruct.Quantified)type.Content;
var lambda = (Constructors.Arrow)constructor.Content;
var substitution = PushSubstitution(ref environment, ref count, lambda.Content.Identifier);
var body = Normal(new Classification <TypedTerm>(expression.Universe, arrow.Content.To, lambda.Content.Body), environment, ref count);
return(new TypedTerm.Constructor(new Constructors.Arrow(new TypedLambda(substitution, body))));
case TypeStructs.Module:
var module = (TypeStruct.Module)type.Content;
var pack = (Constructors.Module)constructor.Content;
return(expression.Term); // TODO
default:
throw new ArgumentOutOfRangeException();
}
}
case TypedProductions.Destructor:
{
var destructor = (TypedTerm.Destructor)expression.Term;
var @operator = Normal(destructor.Operator, environment, ref count);
var type = (TypedTerm.Type)destructor.Operator.Type;
switch (type.Content.Tag)
{
case TypeStructs.Quantified:
var arrow = (TypeStruct.Quantified)type.Content;
var apply = (Destructors.Arrow)destructor.Content;
var operandClass = arrow.Content.From.Fmap(_ => apply.Content.Operand);
var operand = Normal(operandClass, environment, ref count);
if (@operator.Tag == TypedProductions.Constructor)
{
var constructor = (TypedTerm.Constructor)@operator;
var lambda = (Constructors.Arrow)constructor.Content;
environment = environment.Push(lambda.Content.Identifier, operand);
return(Normal(expression.Fmap(_ => lambda.Content.Body), environment, ref count));
}
return(new TypedTerm.Destructor(destructor.Operator.Fmap(_ => @operator), new Destructors.Arrow(new TypedApply(operand))));
case TypeStructs.Module:
var module = (TypeStruct.Module)type.Content;
var access = (Destructors.Module)destructor.Content;
return(new TypedTerm.Destructor(destructor.Operator.Fmap(_ => @operator), new Destructors.Module(new TypedMemberAccess(access.Content.Member))));
default:
throw new ArgumentOutOfRangeException();
}
}
case TypedProductions.Variable:
{
var variable = (TypedTerm.Variable)expression.Term;
return(environment.Lookup(variable.Identifier) ?? expression.Term);
}
case TypedProductions.Constant:
{
return(expression.Term);
}
default:
throw new ArgumentOutOfRangeException();
}
}
public static Classification <TypedTerm> InferType(Func <string, Classification <dynamic> > doImport, Environment <Classification <TypedTerm> > environment, Term term)
{
switch (term.Tag)
{
case Productions.Universe:
{
var universe = (Term.Universe)term;
return(new Classification <TypedTerm>(
universe: new Universes(universe.Content.Rank + 2),
type: new TypedTerm.Universe(new Universes(universe.Content.Rank + 1)),
term: new TypedTerm.Universe(universe.Content)));
}
case Productions.Quantified:
{
var type = (Term.Quantified)term;
return(EnsureQuantifiedType(doImport, environment, new Option <Classification <TypedTerm> > .None(), type));
}
case Productions.Lambda:
{
var constructor = (Term.Lambda)term;
var identifier = constructor.Content.Parameter.Identifier;
if (environment.Maps(identifier))
{
throw new ArgumentException("Shadowing identifier: " + identifier);
}
foreach (var type in constructor.Content.Parameter.Constraint.Each())
{
var annotation = InferType(doImport, environment, type).Normalized(environment);
var binding = annotation.ShiftDown(identifier);
environment = environment.Push(binding);
var body = InferType(doImport, environment, constructor.Content.Body);
if (FreeVariable(body.Type, identifier))
{
throw new ArgumentException("Return type should not depend on parameter.");
}
return(new Classification <TypedTerm>(
universe: body.Universe,
type: new TypedTerm.Type(new TypeStruct.Quantified(new TypedQuantifier(Polarity.Forall, annotation.Declared("*"), body.Type))),
term: new TypedTerm.Constructor(new Constructors.Arrow(new TypedLambda(identifier, body.Term)))));
}
throw new ArgumentException("Cannot infer type of unannotated parameter.");
}
case Productions.Apply:
{
var destructor = (Term.Apply)term;
var @operator = InferType(doImport, environment, destructor.Content.Operator);
var type = (TypedTerm.Type)@operator.Type;
var arrow = (TypeStruct.Quantified)type.Content;
if (arrow.Content.Polarity != Polarity.Forall)
{
throw new ArgumentException("Function application operator must have negative polarity.");
}
var operand = CheckType(doImport, environment, arrow.Content.From.TypeOf(), destructor.Content.Argument);
return(new Classification <TypedTerm>(
universe: @operator.Universe,
type: arrow.Content.To,
term: new TypedTerm.Destructor(@operator, new Destructors.Arrow(new TypedApply(operand)))));
}
case Productions.Module:
{
var module = (Term.Module)term;
var signature = InferSignature(doImport, environment, module.Content);
return(new Classification <TypedTerm>(
universe: new Universes(1),
type: new TypedTerm.Universe(new Universes(0)),
term: new TypedTerm.Type(new TypeStruct.Module(signature))));
}
case Productions.New:
{
var @new = (Term.New)term;
var untyped = @new.Content.Members;
var members = new Classification <KeyValuePair <string, TypedTerm> > [untyped.Length];
foreach (var index in ArrayOperations.CountUp(untyped.Length))
{
var member = InferLet(doImport, environment, untyped[index]);
var quantifier = member.Fmap(_ => _.Key);
members[index] = member;
//environment = environment.Push(quantifier);
}
return(new Classification <TypedTerm>(
universe: new Universes(0),
type: new TypedTerm.Type(new TypeStruct.Module(new Signature(members.Fmap(member => member.Fmap(binding => binding.Key))))),
term: new TypedTerm.Constructor(new Constructors.Module(new TypedModule(members.Fmap(member => member.Term.Value))))));
}
case Productions.Access:
{
var access = (Term.Access)term;
return(InferMemberAccess(doImport, environment, access.Content));
}
case Productions.Variable:
{
var variable = (Term.Variable)term;
var type = environment.Lookup(variable.Content).TypeOf();
return(type.ShiftDown <TypedTerm>(new TypedTerm.Variable(variable.Content)));
}
case Productions.Annotation:
{
var annotation = (Term.Annotation)term;
var expected = InferType(doImport, environment, annotation.Content.Type).Normalized(environment);
var body = CheckType(doImport, environment, expected, annotation.Content.Term);
return(expected.ShiftDown(body));
}
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 = InferType(doImport, environment, letBinding.Continuation);
return(new Classification <TypedTerm>(
universe: continuation.Universe,
type: continuation.Type,
term: new TypedTerm.Destructor(
@operator: new Classification <TypedTerm>(
universe: continuation.Universe,
type: new TypedTerm.Type(new TypeStruct.Quantified(new TypedQuantifier(Polarity.Forall, defined.TypeOf().Declared("*"), continuation.Type))),
term: new TypedTerm.Constructor(new Constructors.Arrow(new TypedLambda(identifier, continuation.Term)))),
content: new Destructors.Arrow(new TypedApply(operand: defined.Term.Value)))));
}
case Productions.Constant:
{
var constant = (Term.Constant)term;
return(constant.Content.Fmap(value => (TypedTerm) new TypedTerm.Constant(value)));
}
case Productions.TypeOf:
{
var typeOf = (Term.TypeOf)term;
return(InferType(doImport, environment, typeOf.Content).TypeOf());
}
case Productions.Import:
{
var import = (Term.Import)term;
return(doImport(import.Filename).Fmap(value => (TypedTerm) new TypedTerm.Constant(value)));
}
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 static Environment <Classification <TypedTerm> > Push(this Environment <Classification <TypedTerm> > environment, Classification <string> binding)
{
return(environment.Push(binding.Term, binding.Fmap <string, TypedTerm>(_ => new TypedTerm.Variable(_))));
}