public static bool IsEqualTo(this TypeStruct first, TypeStruct second)
{
if (first.Tag != second.Tag)
{
return(false);
}
switch (first.Tag)
{
case TypeStructs.Quantified:
var arrow1 = (TypeStruct.Quantified)first;
var arrow2 = (TypeStruct.Quantified)second;
return(arrow1.Content.Polarity == arrow2.Content.Polarity &&
arrow1.Content.From.IsEqualTo(arrow2.Content.From) &&
arrow1.Content.To.IsEqualTo(arrow2.Content.To));
case TypeStructs.Module:
var module1 = (TypeStruct.Module)first;
var module2 = (TypeStruct.Module)second;
var members1 = module1.Content.Members;
var members2 = module2.Content.Members;
if (members1.Length != members2.Length)
{
return(false);
}
foreach (var index in ArrayOperations.CountUp(members1.Length))
{
if (!members1[index].IsEqualTo(members2[index]))
{
return(false);
}
}
return(true);
default:
throw new ArgumentOutOfRangeException();
}
}
private static Signature InferSignature(Func <string, Classification <dynamic> > doImport, Environment <Classification <TypedTerm> > environment, ModuleType moduleType)
{
var untyped = moduleType.Members;
var members = new Classification <string> [untyped.Length];
foreach (var index in ArrayOperations.CountUp(untyped.Length))
{
var binding = untyped[index];
var typed = InferType(doImport, environment, binding.Value).Normalized(environment);
var quantifier = typed.ShiftDown(binding.Key);
members[index] = quantifier;
environment = environment.Push(quantifier);
}
return(new Signature(members));
}
private static Classification <TypedTerm> InferMemberAccess(Func <string, Classification <dynamic> > doImport, Environment <Classification <TypedTerm> > environment, MemberAccess memberAccess)
{
var @operator = InferType(doImport, environment, memberAccess.Operator);
var type = (TypedTerm.Type)@operator.Type;
var module = (TypeStruct.Module)type.Content;
var quantifiers = module.Content.Members;
foreach (var index in ArrayOperations.CountUp(quantifiers.Length))
{
var @class = quantifiers[index];
if (@class.Term.Equals(memberAccess.Name))
{
// TODO: Substitute dependent type variables to index into @operator
return(@class.Fmap <string, TypedTerm>(
convert: _ => new TypedTerm.Destructor(@operator, new Destructors.Module(new TypedMemberAccess((uint)index)))));
}
}
throw new ArgumentException("Module does not contain member: " + memberAccess.Name);
}
public static IParser <S, Association <O, T> > Separated <S, O, T>(this IParser <S, T> parser, IParser <S, O> separator)
{
return(parser
.Continue(first => separator.AndThen(parser).Repeat()
.Continue(rest => Parsers.Returns <S, Association <O, T> >(new Association <O, T>(
@operators: rest.Fmap(_ => _.Item1),
@operands: ArrayOperations.Concatenate(new T[] { first }, rest.Fmap(_ => _.Item2)))))));
}
public static IParser <S, T[]> Separated <S, T>(this IParser <S, T> parser, IParser <S, Unit> separator)
{
return(parser
.Continue(first => parser.After(separator).Repeat()
.Continue(rest => Parsers.Returns <S, T[]>(ArrayOperations.Concatenate(new T[] { first }, rest)))));
}
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 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.");
}
}
