bool TypeInference::Unify(Tree *t1, Tree *t2, unify_mode mode)
// ----------------------------------------------------------------------------
// Unify two type forms
// ----------------------------------------------------------------------------
// A type form in XL can be:
// - A type name integer
// - A generic type name #ABC
// - A litteral value 0 1.5 "Hello"
// - A range of values 0..4 1.3..8.9 "A".."Z"
// - A union of types 0,3,5 integer|real
// - A block for precedence (real)
// - A rewrite specifier integer => real
// - The type of a pattern type (X:integer, Y:integer)
//
// Unification happens almost as "usual" for Algorithm W, except for how
// we deal with XL "shape-based" type constructors, e.g. type(P)
{
// Make sure we have the canonical form
t1 = Base(t1);
t2 = Base(t2);
if (t1 == t2)
return true; // Already unified
// Strip out blocks in type specification
if (Block *b1 = t1->AsBlock())
if (Unify(b1->child, t2))
return Join(b1, t2);
if (Block *b2 = t2->AsBlock())
if (Unify(t1, b2->child))
return Join(t1, b2);
// Lookup type names, replace them with their value
t1 = LookupTypeName(t1);
t2 = LookupTypeName(t2);
if (t1 == t2)
return true; // This may have been enough for unifiation
// Special case of constants
if (t1->IsConstant())
if (Name *t2n = t2->AsName())
return JoinConstant(t1, t2n);
if (t2->IsConstant())
if (Name *t1n = t1->AsName())
return JoinConstant(t2, t1n);
// If either is a generic, unify with the other
if (IsGeneric(t1))
return Join(t1, t2);
if (IsGeneric(t2))
return Join(t1, t2);
// Check if t1 is one of the infix constructor types
if (Infix *i1 = t1->AsInfix())
{
// Function types: Unifies only with a function type
if (i1->name == "=>")
{
if (Infix *i2 = t2->AsInfix())
if (i2->name == "=>")
return
Unify(i1->left, i2->left, i1, i2) &&
Unify(i1->right, i2->right, i1, i2);
return TypeError(i1, t2);
}
// Union types: Unify with either side
if (i1->name == "|" || i1->name == ",")
{
if (mode != DECLARATION)
{
Errors errors;
if (Unify(i1->left, t2))
return true;
errors.Swallowed();
if (Unify(i1->right, t2))
return true;
}
return TypeError(t1, t2);
}
Ooops("Malformed type definition $2 for $1", left, i1);
return false;
}
if (Infix *i2 = t2->AsInfix())
{
// Union types: Unify with either side
if (i2->name == "|" || i2->name == ",")
{
Errors errors;
if (Unify(t1, i2->left))
return true;
errors.Swallowed();
if (Unify(t1, i2->right))
return true;
return false;
}
Ooops("Malformed type definition $2 for $1", right, i2);
return false;
}
// If we have a type name at this stage, this is a failure
if (IsTypeName(t1))
{
// In declaration mode, we have success if t2 covers t1
if (mode == DECLARATION && TypeCoversType(context, t2, t1, false))
return true;
return TypeError(t1, t2);
}
if (IsTypeName(t2))
{
return TypeError(t1, t2);
}
// Check prefix constructor types
if (Prefix *p1 = t1->AsPrefix())
if (Name *pn1 = p1->left->AsName())
if (pn1->value == "type")
if (Prefix *p2 = t2->AsPrefix())
if (Name *pn2 = p2->right->AsName())
if (pn2->value == "type")
if (UnifyPatterns(p1->right, p2->right))
return Join(t1, t2);
// None of the above: fail
return TypeError(t1, t2);
}
