<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->
<title>types/FunDeps.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 2000
%
FunDeps - functional dependencies
It's better to read it as: "if we know these, then we're going to know these"
\begin{code}
<pre><a name="line-1"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>FunDeps</span> <span class='hs-layout'>(</span>
<a name="line-2"></a> <span class='hs-conid'>Equation</span><span class='hs-layout'>,</span> <span class='hs-varid'>pprEquation</span><span class='hs-layout'>,</span>
<a name="line-3"></a> <span class='hs-varid'>oclose</span><span class='hs-layout'>,</span> <span class='hs-varid'>improveOne</span><span class='hs-layout'>,</span>
<a name="line-4"></a> <span class='hs-varid'>checkInstCoverage</span><span class='hs-layout'>,</span> <span class='hs-varid'>checkFunDeps</span><span class='hs-layout'>,</span>
<a name="line-5"></a> <span class='hs-varid'>pprFundeps</span>
<a name="line-6"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-7"></a>
<a name="line-8"></a><span class='hs-cpp'>#include "HsVersions.h"</span>
<a name="line-9"></a>
<a name="line-10"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Name</span>
<a name="line-11"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Var</span>
<a name="line-12"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Class</span>
<a name="line-13"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcType</span>
<a name="line-14"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Unify</span>
<a name="line-15"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>InstEnv</span>
<a name="line-16"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>VarSet</span>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>VarEnv</span>
<a name="line-18"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
<a name="line-19"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Util</span>
<a name="line-20"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FastString</span>
<a name="line-21"></a>
<a name="line-22"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>List</span> <span class='hs-layout'>(</span> <span class='hs-varid'>nubBy</span> <span class='hs-layout'>)</span>
<a name="line-23"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Maybe</span> <span class='hs-layout'>(</span> <span class='hs-varid'>isJust</span> <span class='hs-layout'>)</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Close type variables}
%* *
%************************************************************************
oclose(vs,C) The result of extending the set of tyvars vs
using the functional dependencies from C
grow(vs,C) The result of extend the set of tyvars vs
using all conceivable links from C.
E.g. vs = {a}, C = {H [a] b, K (b,Int) c, Eq e}
Then grow(vs,C) = {a,b,c}
Note that grow(vs,C) `superset` grow(vs,simplify(C))
That is, simplfication can only shrink the result of grow.
Notice that
oclose is conservative v `elem` oclose(vs,C)
one way: => v is definitely fixed by vs
grow is conservative if v might be fixed by vs
the other way: => v `elem` grow(vs,C)
----------------------------------------------------------
(oclose preds tvs) closes the set of type variables tvs,
wrt functional dependencies in preds. The result is a superset
of the argument set. For example, if we have
class C a b | a->b where ...
then
oclose [C (x,y) z, C (x,p) q] {x,y} = {x,y,z}
because if we know x and y then that fixes z.
oclose is used (only) when generalising a type T; see extensive
notes in TcSimplify.
Note [Important subtlety in oclose]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider (oclose (C Int t) {}), where class C a b | a->b
Then, since a->b, 't' is fully determined by Int, and the
uniform thing is to return {t}.
However, consider
class D a b c | b->c
f x = e -- 'e' generates constraint (D s Int t)
-- \x.e has type s->s
Then, if (oclose (D s Int t) {}) = {t}, we'll make the function
monomorphic in 't', thus
f :: forall s. D s Int t => s -> s
But if this function is never called, 't' will never be instantiated;
the functional dependencies that fix 't' may well be instance decls in
some importing module. But the top-level defaulting of unconstrained
type variables will fix t=GHC.Prim.Any, and that's simply a bug.
Conclusion: oclose only returns a type variable as "fixed" if it
depends on at least one type variable in the input fixed_tvs.
Remember, it's always sound for oclose to return a smaller set.
An interesting example is tcfail093, where we get this inferred type:
class C a b | a->b
dup :: forall h. (Call (IO Int) h) => () -> Int -> h
This is perhaps a bit silly, because 'h' is fixed by the (IO Int);
previously GHC rejected this saying 'no instance for Call (IO Int) h'.
But it's right on the borderline. If there was an extra, otherwise
uninvolved type variable, like 's' in the type of 'f' above, then
we must accept the function. So, for now anyway, we accept 'dup' too.
\begin{code}
<pre><a name="line-1"></a><a name="oclose"></a><span class='hs-definition'>oclose</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>PredType</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TyVarSet</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TyVarSet</span>
<a name="line-2"></a><span class='hs-definition'>oclose</span> <span class='hs-varid'>preds</span> <span class='hs-varid'>fixed_tvs</span>
<a name="line-3"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>null</span> <span class='hs-varid'>tv_fds</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fixed_tvs</span> <span class='hs-comment'>-- Fast escape hatch for common case</span>
<a name="line-4"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isEmptyVarSet</span> <span class='hs-varid'>fixed_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>emptyVarSet</span> <span class='hs-comment'>-- Note [Important subtlety in oclose]</span>
<a name="line-5"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>loop</span> <span class='hs-varid'>fixed_tvs</span>
<a name="line-6"></a> <span class='hs-keyword'>where</span>
<a name="line-7"></a> <span class='hs-varid'>loop</span> <span class='hs-varid'>fixed_tvs</span>
<a name="line-8"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>new_fixed_tvs</span> <span class='hs-varop'>`subVarSet`</span> <span class='hs-varid'>fixed_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fixed_tvs</span>
<a name="line-9"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>loop</span> <span class='hs-varid'>new_fixed_tvs</span>
<a name="line-10"></a> <span class='hs-keyword'>where</span>
<a name="line-11"></a> <span class='hs-varid'>new_fixed_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>foldl</span> <span class='hs-varid'>extend</span> <span class='hs-varid'>fixed_tvs</span> <span class='hs-varid'>tv_fds</span>
<a name="line-12"></a>
<a name="line-13"></a> <span class='hs-varid'>extend</span> <span class='hs-varid'>fixed_tvs</span> <span class='hs-layout'>(</span><span class='hs-varid'>ls</span><span class='hs-layout'>,</span><span class='hs-varid'>rs</span><span class='hs-layout'>)</span>
<a name="line-14"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isEmptyVarSet</span> <span class='hs-varid'>ls</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Note [Important subtlety in oclose]</span>
<a name="line-15"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>ls</span> <span class='hs-varop'>`subVarSet`</span> <span class='hs-varid'>fixed_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fixed_tvs</span> <span class='hs-varop'>`unionVarSet`</span> <span class='hs-varid'>rs</span>
<a name="line-16"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fixed_tvs</span>
<a name="line-17"></a>
<a name="line-18"></a> <span class='hs-varid'>tv_fds</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>TyVarSet</span><span class='hs-layout'>,</span><span class='hs-conid'>TyVarSet</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-19"></a> <span class='hs-comment'>-- In our example, tv_fds will be [ ({x,y}, {z}), ({x,p},{q}) ]</span>
<a name="line-20"></a> <span class='hs-comment'>-- Meaning "knowing x,y fixes z, knowing x,p fixes q"</span>
<a name="line-21"></a> <span class='hs-varid'>tv_fds</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-layout'>(</span><span class='hs-varid'>tyVarsOfTypes</span> <span class='hs-varid'>xs</span><span class='hs-layout'>,</span> <span class='hs-varid'>tyVarsOfTypes</span> <span class='hs-varid'>ys</span><span class='hs-layout'>)</span>
<a name="line-22"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>ClassP</span> <span class='hs-varid'>cls</span> <span class='hs-varid'>tys</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>preds</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- Ignore implicit params</span>
<a name="line-23"></a> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>cls_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>cls_fds</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>classTvsFds</span> <span class='hs-varid'>cls</span><span class='hs-layout'>,</span>
<a name="line-24"></a> <span class='hs-varid'>fd</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>cls_fds</span><span class='hs-layout'>,</span>
<a name="line-25"></a> <span class='hs-keyword'>let</span> <span class='hs-layout'>(</span><span class='hs-varid'>xs</span><span class='hs-layout'>,</span><span class='hs-varid'>ys</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>instFD</span> <span class='hs-varid'>fd</span> <span class='hs-varid'>cls_tvs</span> <span class='hs-varid'>tys</span>
<a name="line-26"></a> <span class='hs-keyglyph'>]</span>
</pre>\end{code}
%************************************************************************
%* *
\subsection{Generate equations from functional dependencies}
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="Equation"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>Equation</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-conid'>TyVarSet</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Type</span><span class='hs-layout'>,</span> <span class='hs-conid'>Type</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-2"></a><span class='hs-comment'>-- These pairs of types should be equal, for some</span>
<a name="line-3"></a><span class='hs-comment'>-- substitution of the tyvars in the tyvar set</span>
<a name="line-4"></a><span class='hs-comment'>-- INVARIANT: corresponding types aren't already equal</span>
<a name="line-5"></a>
<a name="line-6"></a><span class='hs-comment'>-- It's important that we have a *list* of pairs of types. Consider</span>
<a name="line-7"></a><span class='hs-comment'>-- class C a b c | a -> b c where ...</span>
<a name="line-8"></a><span class='hs-comment'>-- instance C Int x x where ...</span>
<a name="line-9"></a><span class='hs-comment'>-- Then, given the constraint (C Int Bool v) we should improve v to Bool,</span>
<a name="line-10"></a><span class='hs-comment'>-- via the equation ({x}, [(Bool,x), (v,x)])</span>
<a name="line-11"></a><span class='hs-comment'>-- This would not happen if the class had looked like</span>
<a name="line-12"></a><span class='hs-comment'>-- class C a b c | a -> b, a -> c</span>
<a name="line-13"></a>
<a name="line-14"></a><span class='hs-comment'>-- To "execute" the equation, make fresh type variable for each tyvar in the set,</span>
<a name="line-15"></a><span class='hs-comment'>-- instantiate the two types with these fresh variables, and then unify.</span>
<a name="line-16"></a><span class='hs-comment'>--</span>
<a name="line-17"></a><span class='hs-comment'>-- For example, ({a,b}, (a,Int,b), (Int,z,Bool))</span>
<a name="line-18"></a><span class='hs-comment'>-- We unify z with Int, but since a and b are quantified we do nothing to them</span>
<a name="line-19"></a><span class='hs-comment'>-- We usually act on an equation by instantiating the quantified type varaibles</span>
<a name="line-20"></a><span class='hs-comment'>-- to fresh type variables, and then calling the standard unifier.</span>
<a name="line-21"></a>
<a name="line-22"></a><a name="pprEquation"></a><span class='hs-definition'>pprEquation</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Equation</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>SDoc</span>
<a name="line-23"></a><span class='hs-definition'>pprEquation</span> <span class='hs-layout'>(</span><span class='hs-varid'>qtvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>pairs</span><span class='hs-layout'>)</span>
<a name="line-24"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"forall"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>braces</span> <span class='hs-layout'>(</span><span class='hs-varid'>pprWithCommas</span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>varSetElems</span> <span class='hs-varid'>qtvs</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-25"></a> <span class='hs-varid'>nest</span> <span class='hs-num'>2</span> <span class='hs-layout'>(</span><span class='hs-varid'>vcat</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>t1</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"~"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>t2</span> <span class='hs-keyglyph'>|</span> <span class='hs-layout'>(</span><span class='hs-varid'>t1</span><span class='hs-layout'>,</span><span class='hs-varid'>t2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>pairs</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
</pre>\end{code}
Given a bunch of predicates that must hold, such as
C Int t1, C Int t2, C Bool t3, ?x::t4, ?x::t5
improve figures out what extra equations must hold.
For example, if we have
class C a b | a->b where ...
then improve will return
[(t1,t2), (t4,t5)]
NOTA BENE:
* improve does not iterate. It's possible that when we make
t1=t2, for example, that will in turn trigger a new equation.
This would happen if we also had
C t1 t7, C t2 t8
If t1=t2, we also get t7=t8.
improve does *not* do this extra step. It relies on the caller
doing so.
* The equations unify types that are not already equal. So there
is no effect iff the result of improve is empty
\begin{code}
<pre><a name="line-1"></a><a name="Pred_Loc"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>Pred_Loc</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-conid'>PredType</span><span class='hs-layout'>,</span> <span class='hs-conid'>SDoc</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- SDoc says where the Pred comes from</span>
<a name="line-2"></a>
<a name="line-3"></a><a name="improveOne"></a><span class='hs-definition'>improveOne</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Class</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Instance</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- Gives instances for given class</span>
<a name="line-4"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Pred_Loc</span> <span class='hs-comment'>-- Do improvement triggered by this</span>
<a name="line-5"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Pred_Loc</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Current constraints </span>
<a name="line-6"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Equation</span><span class='hs-layout'>,</span><span class='hs-conid'>Pred_Loc</span><span class='hs-layout'>,</span><span class='hs-conid'>Pred_Loc</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Derived equalities that must also hold</span>
<a name="line-7"></a> <span class='hs-comment'>-- (NB the above INVARIANT for type Equation)</span>
<a name="line-8"></a> <span class='hs-comment'>-- The Pred_Locs explain which two predicates were</span>
<a name="line-9"></a> <span class='hs-comment'>-- combined (for error messages)</span>
<a name="line-10"></a><span class='hs-comment'>-- Just do improvement triggered by a single, distinguised predicate</span>
<a name="line-11"></a>
<a name="line-12"></a><span class='hs-definition'>improveOne</span> <span class='hs-sel'>_inst_env</span> <span class='hs-varid'>pred</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>IParam</span> <span class='hs-varid'>ip</span> <span class='hs-varid'>ty</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>preds</span>
<a name="line-13"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varid'>emptyVarSet</span><span class='hs-layout'>,</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-varid'>ty</span><span class='hs-layout'>,</span><span class='hs-varid'>ty2</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span> <span class='hs-varid'>pred</span><span class='hs-layout'>,</span> <span class='hs-varid'>p2</span><span class='hs-layout'>)</span>
<a name="line-14"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>p2</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>IParam</span> <span class='hs-varid'>ip2</span> <span class='hs-varid'>ty2</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>preds</span>
<a name="line-15"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>ip</span><span class='hs-varop'>==</span><span class='hs-varid'>ip2</span>
<a name="line-16"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>ty</span> <span class='hs-varop'>`tcEqType`</span> <span class='hs-varid'>ty2</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-17"></a>
<a name="line-18"></a><span class='hs-definition'>improveOne</span> <span class='hs-varid'>inst_env</span> <span class='hs-varid'>pred</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>ClassP</span> <span class='hs-varid'>cls</span> <span class='hs-varid'>tys</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>preds</span>
<a name="line-19"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>tys</span> <span class='hs-varop'>`lengthAtLeast`</span> <span class='hs-num'>2</span>
<a name="line-20"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>instance_eqns</span> <span class='hs-varop'>++</span> <span class='hs-varid'>pairwise_eqns</span>
<a name="line-21"></a> <span class='hs-comment'>-- NB: we put the instance equations first. This biases the </span>
<a name="line-22"></a> <span class='hs-comment'>-- order so that we first improve individual constraints against the</span>
<a name="line-23"></a> <span class='hs-comment'>-- instances (which are perhaps in a library and less likely to be</span>
<a name="line-24"></a> <span class='hs-comment'>-- wrong; and THEN perform the pairwise checks.</span>
<a name="line-25"></a> <span class='hs-comment'>-- The other way round, it's possible for the pairwise check to succeed</span>
<a name="line-26"></a> <span class='hs-comment'>-- and cause a subsequent, misleading failure of one of the pair with an</span>
<a name="line-27"></a> <span class='hs-comment'>-- instance declaration. See tcfail143.hs for an example</span>
<a name="line-28"></a> <span class='hs-keyword'>where</span>
<a name="line-29"></a> <span class='hs-layout'>(</span><span class='hs-varid'>cls_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>cls_fds</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>classTvsFds</span> <span class='hs-varid'>cls</span>
<a name="line-30"></a> <span class='hs-varid'>instances</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>inst_env</span> <span class='hs-varid'>cls</span>
<a name="line-31"></a> <span class='hs-varid'>rough_tcs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>roughMatchTcs</span> <span class='hs-varid'>tys</span>
<a name="line-32"></a>
<a name="line-33"></a> <span class='hs-comment'>-- NOTE that we iterate over the fds first; they are typically</span>
<a name="line-34"></a> <span class='hs-comment'>-- empty, which aborts the rest of the loop.</span>
<a name="line-35"></a> <span class='hs-varid'>pairwise_eqns</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Equation</span><span class='hs-layout'>,</span><span class='hs-conid'>Pred_Loc</span><span class='hs-layout'>,</span><span class='hs-conid'>Pred_Loc</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-36"></a> <span class='hs-varid'>pairwise_eqns</span> <span class='hs-comment'>-- This group comes from pairwise comparison</span>
<a name="line-37"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-layout'>(</span><span class='hs-varid'>eqn</span><span class='hs-layout'>,</span> <span class='hs-varid'>pred</span><span class='hs-layout'>,</span> <span class='hs-varid'>p2</span><span class='hs-layout'>)</span>
<a name="line-38"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>fd</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>cls_fds</span>
<a name="line-39"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>p2</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>ClassP</span> <span class='hs-varid'>cls2</span> <span class='hs-varid'>tys2</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>preds</span>
<a name="line-40"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>cls</span> <span class='hs-varop'>==</span> <span class='hs-varid'>cls2</span>
<a name="line-41"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>eqn</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>checkClsFD</span> <span class='hs-varid'>emptyVarSet</span> <span class='hs-varid'>fd</span> <span class='hs-varid'>cls_tvs</span> <span class='hs-varid'>tys</span> <span class='hs-varid'>tys2</span>
<a name="line-42"></a> <span class='hs-keyglyph'>]</span>
<a name="line-43"></a>
<a name="line-44"></a> <span class='hs-varid'>instance_eqns</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-layout'>(</span><span class='hs-conid'>Equation</span><span class='hs-layout'>,</span><span class='hs-conid'>Pred_Loc</span><span class='hs-layout'>,</span><span class='hs-conid'>Pred_Loc</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-45"></a> <span class='hs-varid'>instance_eqns</span> <span class='hs-comment'>-- This group comes from comparing with instance decls</span>
<a name="line-46"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-layout'>(</span><span class='hs-varid'>eqn</span><span class='hs-layout'>,</span> <span class='hs-varid'>p_inst</span><span class='hs-layout'>,</span> <span class='hs-varid'>pred</span><span class='hs-layout'>)</span>
<a name="line-47"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>fd</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>cls_fds</span> <span class='hs-comment'>-- Iterate through the fundeps first, </span>
<a name="line-48"></a> <span class='hs-comment'>-- because there often are none!</span>
<a name="line-49"></a> <span class='hs-layout'>,</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>trimmed_tcs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>trimRoughMatchTcs</span> <span class='hs-varid'>cls_tvs</span> <span class='hs-varid'>fd</span> <span class='hs-varid'>rough_tcs</span>
<a name="line-50"></a> <span class='hs-comment'>-- Trim the rough_tcs based on the head of the fundep.</span>
<a name="line-51"></a> <span class='hs-comment'>-- Remember that instanceCantMatch treats both argumnents</span>
<a name="line-52"></a> <span class='hs-comment'>-- symmetrically, so it's ok to trim the rough_tcs,</span>
<a name="line-53"></a> <span class='hs-comment'>-- rather than trimming each inst_tcs in turn</span>
<a name="line-54"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>ispec</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Instance</span> <span class='hs-layout'>{</span> <span class='hs-varid'>is_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>qtvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>is_tys</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tys_inst</span><span class='hs-layout'>,</span>
<a name="line-55"></a> <span class='hs-varid'>is_tcs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>inst_tcs</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>instances</span>
<a name="line-56"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>instanceCantMatch</span> <span class='hs-varid'>inst_tcs</span> <span class='hs-varid'>trimmed_tcs</span><span class='hs-layout'>)</span>
<a name="line-57"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>eqn</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>checkClsFD</span> <span class='hs-varid'>qtvs</span> <span class='hs-varid'>fd</span> <span class='hs-varid'>cls_tvs</span> <span class='hs-varid'>tys_inst</span> <span class='hs-varid'>tys</span>
<a name="line-58"></a> <span class='hs-layout'>,</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>p_inst</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkClassPred</span> <span class='hs-varid'>cls</span> <span class='hs-varid'>tys_inst</span><span class='hs-layout'>,</span>
<a name="line-59"></a> <span class='hs-varid'>sep</span> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"arising from the dependency"</span><span class='hs-layout'>)</span> <span class='hs-varop'><+></span> <span class='hs-varid'>quotes</span> <span class='hs-layout'>(</span><span class='hs-varid'>pprFunDep</span> <span class='hs-varid'>fd</span><span class='hs-layout'>)</span>
<a name="line-60"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>ptext</span> <span class='hs-layout'>(</span><span class='hs-varid'>sLit</span> <span class='hs-str'>"in the instance declaration at"</span><span class='hs-layout'>)</span>
<a name="line-61"></a> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-layout'>(</span><span class='hs-varid'>getSrcLoc</span> <span class='hs-varid'>ispec</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span>
<a name="line-62"></a> <span class='hs-keyglyph'>]</span>
<a name="line-63"></a>
<a name="line-64"></a><span class='hs-definition'>improveOne</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span> <span class='hs-keyword'>_</span>
<a name="line-65"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-66"></a>
<a name="line-67"></a>
<a name="line-68"></a><a name="checkClsFD"></a><span class='hs-definition'>checkClsFD</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>TyVarSet</span> <span class='hs-comment'>-- Quantified type variables; see note below</span>
<a name="line-69"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FunDep</span> <span class='hs-conid'>TyVar</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TyVar</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- One functional dependency from the class</span>
<a name="line-70"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span><span class='hs-keyglyph'>]</span>
<a name="line-71"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Equation</span><span class='hs-keyglyph'>]</span>
<a name="line-72"></a>
<a name="line-73"></a><span class='hs-definition'>checkClsFD</span> <span class='hs-varid'>qtvs</span> <span class='hs-varid'>fd</span> <span class='hs-varid'>clas_tvs</span> <span class='hs-varid'>tys1</span> <span class='hs-varid'>tys2</span>
<a name="line-74"></a><span class='hs-comment'>-- 'qtvs' are the quantified type variables, the ones which an be instantiated </span>
<a name="line-75"></a><span class='hs-comment'>-- to make the types match. For example, given</span>
<a name="line-76"></a><span class='hs-comment'>-- class C a b | a->b where ...</span>
<a name="line-77"></a><span class='hs-comment'>-- instance C (Maybe x) (Tree x) where ..</span>
<a name="line-78"></a><span class='hs-comment'>--</span>
<a name="line-79"></a><span class='hs-comment'>-- and an Inst of form (C (Maybe t1) t2), </span>
<a name="line-80"></a><span class='hs-comment'>-- then we will call checkClsFD with</span>
<a name="line-81"></a><span class='hs-comment'>--</span>
<a name="line-82"></a><span class='hs-comment'>-- qtvs = {x}, tys1 = [Maybe x, Tree x]</span>
<a name="line-83"></a><span class='hs-comment'>-- tys2 = [Maybe t1, t2]</span>
<a name="line-84"></a><span class='hs-comment'>--</span>
<a name="line-85"></a><span class='hs-comment'>-- We can instantiate x to t1, and then we want to force</span>
<a name="line-86"></a><span class='hs-comment'>-- (Tree x) [t1/x] ~ t2</span>
<a name="line-87"></a><span class='hs-comment'>--</span>
<a name="line-88"></a><span class='hs-comment'>-- This function is also used when matching two Insts (rather than an Inst</span>
<a name="line-89"></a><span class='hs-comment'>-- against an instance decl. In that case, qtvs is empty, and we are doing</span>
<a name="line-90"></a><span class='hs-comment'>-- an equality check</span>
<a name="line-91"></a><span class='hs-comment'>-- </span>
<a name="line-92"></a><span class='hs-comment'>-- This function is also used by InstEnv.badFunDeps, which needs to *unify*</span>
<a name="line-93"></a><span class='hs-comment'>-- For the one-sided matching case, the qtvs are just from the template,</span>
<a name="line-94"></a><span class='hs-comment'>-- so we get matching</span>
<a name="line-95"></a><span class='hs-comment'>--</span>
<a name="line-96"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ASSERT2</span><span class='hs-layout'>(</span> <span class='hs-varid'>length</span> <span class='hs-varid'>tys1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>length</span> <span class='hs-varid'>tys2</span> <span class='hs-varop'>&&</span>
<a name="line-97"></a> <span class='hs-varid'>length</span> <span class='hs-varid'>tys1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>length</span> <span class='hs-varid'>clas_tvs</span>
<a name="line-98"></a> <span class='hs-layout'>,</span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>tys1</span> <span class='hs-varop'><+></span> <span class='hs-varid'>ppr</span> <span class='hs-varid'>tys2</span> <span class='hs-layout'>)</span>
<a name="line-99"></a>
<a name="line-100"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>tcUnifyTys</span> <span class='hs-varid'>bind_fn</span> <span class='hs-varid'>ls1</span> <span class='hs-varid'>ls2</span> <span class='hs-keyword'>of</span>
<a name="line-101"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>[]</span>
<a name="line-102"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>subst</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>isJust</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcUnifyTys</span> <span class='hs-varid'>bind_fn</span> <span class='hs-varid'>rs1'</span> <span class='hs-varid'>rs2'</span><span class='hs-layout'>)</span>
<a name="line-103"></a> <span class='hs-comment'>-- Don't include any equations that already hold. </span>
<a name="line-104"></a> <span class='hs-comment'>-- Reason: then we know if any actual improvement has happened,</span>
<a name="line-105"></a> <span class='hs-comment'>-- in which case we need to iterate the solver</span>
<a name="line-106"></a> <span class='hs-comment'>-- In making this check we must taking account of the fact that any </span>
<a name="line-107"></a> <span class='hs-comment'>-- qtvs that aren't already instantiated can be instantiated to anything </span>
<a name="line-108"></a> <span class='hs-comment'>-- at all</span>
<a name="line-109"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>[]</span>
<a name="line-110"></a>
<a name="line-111"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-comment'>-- Aha! A useful equation</span>
<a name="line-112"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span> <span class='hs-layout'>(</span><span class='hs-varid'>qtvs'</span><span class='hs-layout'>,</span> <span class='hs-varid'>zip</span> <span class='hs-varid'>rs1'</span> <span class='hs-varid'>rs2'</span><span class='hs-layout'>)</span><span class='hs-keyglyph'>]</span>
<a name="line-113"></a> <span class='hs-comment'>-- We could avoid this substTy stuff by producing the eqn</span>
<a name="line-114"></a> <span class='hs-comment'>-- (qtvs, ls1++rs1, ls2++rs2)</span>
<a name="line-115"></a> <span class='hs-comment'>-- which will re-do the ls1/ls2 unification when the equation is</span>
<a name="line-116"></a> <span class='hs-comment'>-- executed. What we're doing instead is recording the partial</span>
<a name="line-117"></a> <span class='hs-comment'>-- work of the ls1/ls2 unification leaving a smaller unification problem</span>
<a name="line-118"></a> <span class='hs-keyword'>where</span>
<a name="line-119"></a> <span class='hs-varid'>rs1'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>substTys</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>rs1</span>
<a name="line-120"></a> <span class='hs-varid'>rs2'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>substTys</span> <span class='hs-varid'>subst</span> <span class='hs-varid'>rs2</span>
<a name="line-121"></a> <span class='hs-varid'>qtvs'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>filterVarSet</span> <span class='hs-layout'>(</span><span class='hs-varop'>`notElemTvSubst`</span> <span class='hs-varid'>subst</span><span class='hs-layout'>)</span> <span class='hs-varid'>qtvs</span>
<a name="line-122"></a> <span class='hs-comment'>-- qtvs' are the quantified type variables</span>
<a name="line-123"></a> <span class='hs-comment'>-- that have not been substituted out</span>
<a name="line-124"></a> <span class='hs-comment'>-- </span>
<a name="line-125"></a> <span class='hs-comment'>-- Eg. class C a b | a -> b</span>
<a name="line-126"></a> <span class='hs-comment'>-- instance C Int [y]</span>
<a name="line-127"></a> <span class='hs-comment'>-- Given constraint C Int z</span>
<a name="line-128"></a> <span class='hs-comment'>-- we generate the equation</span>
<a name="line-129"></a> <span class='hs-comment'>-- ({y}, [y], z)</span>
<a name="line-130"></a> <span class='hs-keyword'>where</span>
<a name="line-131"></a> <span class='hs-varid'>bind_fn</span> <span class='hs-varid'>tv</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>tv</span> <span class='hs-varop'>`elemVarSet`</span> <span class='hs-varid'>qtvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>BindMe</span>
<a name="line-132"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Skolem</span>
<a name="line-133"></a>
<a name="line-134"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ls1</span><span class='hs-layout'>,</span> <span class='hs-varid'>rs1</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>instFD</span> <span class='hs-varid'>fd</span> <span class='hs-varid'>clas_tvs</span> <span class='hs-varid'>tys1</span>
<a name="line-135"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ls2</span><span class='hs-layout'>,</span> <span class='hs-varid'>rs2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>instFD</span> <span class='hs-varid'>fd</span> <span class='hs-varid'>clas_tvs</span> <span class='hs-varid'>tys2</span>
<a name="line-136"></a>
<a name="line-137"></a><a name="instFD"></a><span class='hs-definition'>instFD</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FunDep</span> <span class='hs-conid'>TyVar</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TyVar</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FunDep</span> <span class='hs-conid'>Type</span>
<a name="line-138"></a><span class='hs-definition'>instFD</span> <span class='hs-layout'>(</span><span class='hs-varid'>ls</span><span class='hs-layout'>,</span><span class='hs-varid'>rs</span><span class='hs-layout'>)</span> <span class='hs-varid'>tvs</span> <span class='hs-varid'>tys</span>
<a name="line-139"></a> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>map</span> <span class='hs-varid'>lookup</span> <span class='hs-varid'>ls</span><span class='hs-layout'>,</span> <span class='hs-varid'>map</span> <span class='hs-varid'>lookup</span> <span class='hs-varid'>rs</span><span class='hs-layout'>)</span>
<a name="line-140"></a> <span class='hs-keyword'>where</span>
<a name="line-141"></a> <span class='hs-varid'>env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>zipVarEnv</span> <span class='hs-varid'>tvs</span> <span class='hs-varid'>tys</span>
<a name="line-142"></a> <span class='hs-varid'>lookup</span> <span class='hs-varid'>tv</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lookupVarEnv_NF</span> <span class='hs-varid'>env</span> <span class='hs-varid'>tv</span>
</pre>\end{code}
\begin{code}
<pre><a name="line-1"></a><a name="checkInstCoverage"></a><span class='hs-definition'>checkInstCoverage</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Class</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
<a name="line-2"></a><span class='hs-comment'>-- Check that the Coverage Condition is obeyed in an instance decl</span>
<a name="line-3"></a><span class='hs-comment'>-- For example, if we have </span>
<a name="line-4"></a><span class='hs-comment'>-- class theta => C a b | a -> b</span>
<a name="line-5"></a><span class='hs-comment'>-- instance C t1 t2 </span>
<a name="line-6"></a><span class='hs-comment'>-- Then we require fv(t2) `subset` fv(t1)</span>
<a name="line-7"></a><span class='hs-comment'>-- See Note [Coverage Condition] below</span>
<a name="line-8"></a>
<a name="line-9"></a><span class='hs-definition'>checkInstCoverage</span> <span class='hs-varid'>clas</span> <span class='hs-varid'>inst_taus</span>
<a name="line-10"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>all</span> <span class='hs-varid'>fundep_ok</span> <span class='hs-varid'>fds</span>
<a name="line-11"></a> <span class='hs-keyword'>where</span>
<a name="line-12"></a> <span class='hs-layout'>(</span><span class='hs-varid'>tyvars</span><span class='hs-layout'>,</span> <span class='hs-varid'>fds</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>classTvsFds</span> <span class='hs-varid'>clas</span>
<a name="line-13"></a> <span class='hs-varid'>fundep_ok</span> <span class='hs-varid'>fd</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tyVarsOfTypes</span> <span class='hs-varid'>rs</span> <span class='hs-varop'>`subVarSet`</span> <span class='hs-varid'>tyVarsOfTypes</span> <span class='hs-varid'>ls</span>
<a name="line-14"></a> <span class='hs-keyword'>where</span>
<a name="line-15"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ls</span><span class='hs-layout'>,</span><span class='hs-varid'>rs</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>instFD</span> <span class='hs-varid'>fd</span> <span class='hs-varid'>tyvars</span> <span class='hs-varid'>inst_taus</span>
</pre>\end{code}
Note [Coverage condition]
~~~~~~~~~~~~~~~~~~~~~~~~~
For the coverage condition, we used to require only that
fv(t2) `subset` oclose(fv(t1), theta)
Example:
class Mul a b c | a b -> c where
(.*.) :: a -> b -> c
instance Mul Int Int Int where (.*.) = (*)
instance Mul Int Float Float where x .*. y = fromIntegral x * y
instance Mul a b c => Mul a [b] [c] where x .*. v = map (x.*.) v
In the third instance, it's not the case that fv([c]) `subset` fv(a,[b]).
But it is the case that fv([c]) `subset` oclose( theta, fv(a,[b]) )
But it is a mistake to accept the instance because then this defn:
f = \ b x y -> if b then x .*. [y] else y
makes instance inference go into a loop, because it requires the constraint
Mul a [b] b
%************************************************************************
%* *
Check that a new instance decl is OK wrt fundeps
%* *
%************************************************************************
Here is the bad case:
class C a b | a->b where ...
instance C Int Bool where ...
instance C Int Char where ...
The point is that a->b, so Int in the first parameter must uniquely
determine the second. In general, given the same class decl, and given
instance C s1 s2 where ...
instance C t1 t2 where ...
Then the criterion is: if U=unify(s1,t1) then U(s2) = U(t2).
Matters are a little more complicated if there are free variables in
the s2/t2.
class D a b c | a -> b
instance D a b => D [(a,a)] [b] Int
instance D a b => D [a] [b] Bool
The instance decls don't overlap, because the third parameter keeps
them separate. But we want to make sure that given any constraint
D s1 s2 s3
if s1 matches
\begin{code}
<pre><a name="line-1"></a><a name="checkFunDeps"></a><span class='hs-definition'>checkFunDeps</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>InstEnv</span><span class='hs-layout'>,</span> <span class='hs-conid'>InstEnv</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Instance</span>
<a name="line-2"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Instance</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Nothing <=> ok</span>
<a name="line-3"></a> <span class='hs-comment'>-- Just dfs <=> conflict with dfs</span>
<a name="line-4"></a><span class='hs-comment'>-- Check wheher adding DFunId would break functional-dependency constraints</span>
<a name="line-5"></a><span class='hs-comment'>-- Used only for instance decls defined in the module being compiled</span>
<a name="line-6"></a><span class='hs-definition'>checkFunDeps</span> <span class='hs-varid'>inst_envs</span> <span class='hs-varid'>ispec</span>
<a name="line-7"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>null</span> <span class='hs-varid'>bad_fundeps</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
<a name="line-8"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Just</span> <span class='hs-varid'>bad_fundeps</span>
<a name="line-9"></a> <span class='hs-keyword'>where</span>
<a name="line-10"></a> <span class='hs-layout'>(</span><span class='hs-varid'>ins_tvs</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>,</span> <span class='hs-varid'>clas</span><span class='hs-layout'>,</span> <span class='hs-varid'>ins_tys</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>instanceHead</span> <span class='hs-varid'>ispec</span>
<a name="line-11"></a> <span class='hs-varid'>ins_tv_set</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkVarSet</span> <span class='hs-varid'>ins_tvs</span>
<a name="line-12"></a> <span class='hs-varid'>cls_inst_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>classInstances</span> <span class='hs-varid'>inst_envs</span> <span class='hs-varid'>clas</span>
<a name="line-13"></a> <span class='hs-varid'>bad_fundeps</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>badFunDeps</span> <span class='hs-varid'>cls_inst_env</span> <span class='hs-varid'>clas</span> <span class='hs-varid'>ins_tv_set</span> <span class='hs-varid'>ins_tys</span>
<a name="line-14"></a>
<a name="line-15"></a><a name="badFunDeps"></a><span class='hs-definition'>badFunDeps</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Instance</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Class</span>
<a name="line-16"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TyVarSet</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Type</span><span class='hs-keyglyph'>]</span> <span class='hs-comment'>-- Proposed new instance type</span>
<a name="line-17"></a> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Instance</span><span class='hs-keyglyph'>]</span>
<a name="line-18"></a><span class='hs-definition'>badFunDeps</span> <span class='hs-varid'>cls_insts</span> <span class='hs-varid'>clas</span> <span class='hs-varid'>ins_tv_set</span> <span class='hs-varid'>ins_tys</span>
<a name="line-19"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nubBy</span> <span class='hs-varid'>eq_inst</span> <span class='hs-varop'>$</span>
<a name="line-20"></a> <span class='hs-keyglyph'>[</span> <span class='hs-varid'>ispec</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>fd</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>fds</span><span class='hs-layout'>,</span> <span class='hs-comment'>-- fds is often empty, so do this first!</span>
<a name="line-21"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>trimmed_tcs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>trimRoughMatchTcs</span> <span class='hs-varid'>clas_tvs</span> <span class='hs-varid'>fd</span> <span class='hs-varid'>rough_tcs</span><span class='hs-layout'>,</span>
<a name="line-22"></a> <span class='hs-varid'>ispec</span><span class='hs-keyglyph'>@</span><span class='hs-layout'>(</span><span class='hs-conid'>Instance</span> <span class='hs-layout'>{</span> <span class='hs-varid'>is_tcs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>inst_tcs</span><span class='hs-layout'>,</span> <span class='hs-varid'>is_tvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tvs</span><span class='hs-layout'>,</span>
<a name="line-23"></a> <span class='hs-varid'>is_tys</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tys</span> <span class='hs-layout'>}</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>cls_insts</span><span class='hs-layout'>,</span>
<a name="line-24"></a> <span class='hs-comment'>-- Filter out ones that can't possibly match, </span>
<a name="line-25"></a> <span class='hs-comment'>-- based on the head of the fundep</span>
<a name="line-26"></a> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>instanceCantMatch</span> <span class='hs-varid'>inst_tcs</span> <span class='hs-varid'>trimmed_tcs</span><span class='hs-layout'>)</span><span class='hs-layout'>,</span>
<a name="line-27"></a> <span class='hs-varid'>notNull</span> <span class='hs-layout'>(</span><span class='hs-varid'>checkClsFD</span> <span class='hs-layout'>(</span><span class='hs-varid'>tvs</span> <span class='hs-varop'>`unionVarSet`</span> <span class='hs-varid'>ins_tv_set</span><span class='hs-layout'>)</span>
<a name="line-28"></a> <span class='hs-varid'>fd</span> <span class='hs-varid'>clas_tvs</span> <span class='hs-varid'>tys</span> <span class='hs-varid'>ins_tys</span><span class='hs-layout'>)</span>
<a name="line-29"></a> <span class='hs-keyglyph'>]</span>
<a name="line-30"></a> <span class='hs-keyword'>where</span>
<a name="line-31"></a> <span class='hs-layout'>(</span><span class='hs-varid'>clas_tvs</span><span class='hs-layout'>,</span> <span class='hs-varid'>fds</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>classTvsFds</span> <span class='hs-varid'>clas</span>
<a name="line-32"></a> <span class='hs-varid'>rough_tcs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>roughMatchTcs</span> <span class='hs-varid'>ins_tys</span>
<a name="line-33"></a> <span class='hs-varid'>eq_inst</span> <span class='hs-varid'>i1</span> <span class='hs-varid'>i2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>instanceDFunId</span> <span class='hs-varid'>i1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>instanceDFunId</span> <span class='hs-varid'>i2</span>
<a name="line-34"></a> <span class='hs-comment'>-- An single instance may appear twice in the un-nubbed conflict list</span>
<a name="line-35"></a> <span class='hs-comment'>-- because it may conflict with more than one fundep. E.g.</span>
<a name="line-36"></a> <span class='hs-comment'>-- class C a b c | a -> b, a -> c</span>
<a name="line-37"></a> <span class='hs-comment'>-- instance C Int Bool Bool</span>
<a name="line-38"></a> <span class='hs-comment'>-- instance C Int Char Char</span>
<a name="line-39"></a> <span class='hs-comment'>-- The second instance conflicts with the first by *both* fundeps</span>
<a name="line-40"></a>
<a name="line-41"></a><a name="trimRoughMatchTcs"></a><span class='hs-definition'>trimRoughMatchTcs</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>TyVar</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FunDep</span> <span class='hs-conid'>TyVar</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Maybe</span> <span class='hs-conid'>Name</span><span class='hs-keyglyph'>]</span>
<a name="line-42"></a><span class='hs-comment'>-- Computing rough_tcs for a particular fundep</span>
<a name="line-43"></a><span class='hs-comment'>-- class C a b c | a -> b where ...</span>
<a name="line-44"></a><span class='hs-comment'>-- For each instance .... => C ta tb tc</span>
<a name="line-45"></a><span class='hs-comment'>-- we want to match only on the type ta; so our</span>
<a name="line-46"></a><span class='hs-comment'>-- rough-match thing must similarly be filtered. </span>
<a name="line-47"></a><span class='hs-comment'>-- Hence, we Nothing-ise the tb and tc types right here</span>
<a name="line-48"></a><span class='hs-definition'>trimRoughMatchTcs</span> <span class='hs-varid'>clas_tvs</span> <span class='hs-layout'>(</span><span class='hs-varid'>ltvs</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-varid'>mb_tcs</span>
<a name="line-49"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>zipWith</span> <span class='hs-varid'>select</span> <span class='hs-varid'>clas_tvs</span> <span class='hs-varid'>mb_tcs</span>
<a name="line-50"></a> <span class='hs-keyword'>where</span>
<a name="line-51"></a> <span class='hs-varid'>select</span> <span class='hs-varid'>clas_tv</span> <span class='hs-varid'>mb_tc</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>clas_tv</span> <span class='hs-varop'>`elem`</span> <span class='hs-varid'>ltvs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mb_tc</span>
<a name="line-52"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Nothing</span>
</pre>\end{code}
</body>
</html>
