<?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>typecheck/FamInst.lhs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
The @FamInst@ type: family instance heads
\begin{code}
<pre><a name="line-1"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>FamInst</span> <span class='hs-layout'>(</span>
<a name="line-2"></a> <span class='hs-varid'>checkFamInstConsistency</span><span class='hs-layout'>,</span> <span class='hs-varid'>tcExtendLocalFamInstEnv</span>
<a name="line-3"></a> <span class='hs-layout'>)</span> <span class='hs-keyword'>where</span>
<a name="line-4"></a>
<a name="line-5"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>HscTypes</span>
<a name="line-6"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FamInstEnv</span>
<a name="line-7"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcMType</span>
<a name="line-8"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcType</span>
<a name="line-9"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TcRnMonad</span>
<a name="line-10"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>TyCon</span>
<a name="line-11"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Name</span>
<a name="line-12"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Module</span>
<a name="line-13"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>SrcLoc</span>
<a name="line-14"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Outputable</span>
<a name="line-15"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>LazyUniqFM</span>
<a name="line-16"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FiniteMap</span>
<a name="line-17"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>FastString</span>
<a name="line-18"></a>
<a name="line-19"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Maybes</span>
<a name="line-20"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span>
</pre>\end{code}
%************************************************************************
%* *
Optimised overlap checking for family instances
%* *
%************************************************************************
For any two family instance modules that we import directly or indirectly, we
check whether the instances in the two modules are consistent, *unless* we can
be certain that the instances of the two modules have already been checked for
consistency during the compilation of modules that we import.
Why do we need to check? Consider
module X1 where module X2 where
data T1 data T2
type instance F T1 b = Int type instance F a T2 = Char
f1 :: F T1 a -> Int f2 :: Char -> F a T2
f1 x = x f2 x = x
Now if we import both X1 and X2 we could make (f2 . f1) :: Int -> Char.
Notice that neither instance is an orphan.
How do we know which pairs of modules have already been checked? Any pair of
modules where both modules occur in the `HscTypes.dep_finsts' set (of the
`HscTypes.Dependencies') of one of our directly imported modules must have
already been checked. Everything else, we check now. (So that we can be
certain that the modules in our `HscTypes.dep_finsts' are consistent.)
\begin{code}
<pre><a name="line-1"></a><a name="ModulePair"></a><span class='hs-comment'>-- The optimisation of overlap tests is based on determining pairs of modules</span>
<a name="line-2"></a><a name="ModulePair"></a><span class='hs-comment'>-- whose family instances need to be checked for consistency.</span>
<a name="line-3"></a><a name="ModulePair"></a><span class='hs-comment'>--</span>
<a name="line-4"></a><a name="ModulePair"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>ModulePair</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>ModulePair</span> <span class='hs-conid'>Module</span> <span class='hs-conid'>Module</span>
<a name="line-5"></a>
<a name="line-6"></a><a name="canon"></a><span class='hs-comment'>-- canonical order of the components of a module pair</span>
<a name="line-7"></a><span class='hs-comment'>--</span>
<a name="line-8"></a><span class='hs-definition'>canon</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ModulePair</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>Module</span><span class='hs-layout'>,</span> <span class='hs-conid'>Module</span><span class='hs-layout'>)</span>
<a name="line-9"></a><span class='hs-definition'>canon</span> <span class='hs-layout'>(</span><span class='hs-conid'>ModulePair</span> <span class='hs-varid'>m1</span> <span class='hs-varid'>m2</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>m1</span> <span class='hs-varop'><</span> <span class='hs-varid'>m2</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>m1</span><span class='hs-layout'>,</span> <span class='hs-varid'>m2</span><span class='hs-layout'>)</span>
<a name="line-10"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>m2</span><span class='hs-layout'>,</span> <span class='hs-varid'>m1</span><span class='hs-layout'>)</span>
<a name="line-11"></a>
<a name="line-12"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Eq</span> <span class='hs-conid'>ModulePair</span> <span class='hs-keyword'>where</span>
<a name="line-13"></a> <span class='hs-varid'>mp1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>mp2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>canon</span> <span class='hs-varid'>mp1</span> <span class='hs-varop'>==</span> <span class='hs-varid'>canon</span> <span class='hs-varid'>mp2</span>
<a name="line-14"></a>
<a name="line-15"></a><span class='hs-keyword'>instance</span> <span class='hs-conid'>Ord</span> <span class='hs-conid'>ModulePair</span> <span class='hs-keyword'>where</span>
<a name="line-16"></a> <span class='hs-varid'>mp1</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>mp2</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>canon</span> <span class='hs-varid'>mp1</span> <span class='hs-varop'>`compare`</span> <span class='hs-varid'>canon</span> <span class='hs-varid'>mp2</span>
<a name="line-17"></a>
<a name="line-18"></a><a name="ModulePairSet"></a><span class='hs-comment'>-- Sets of module pairs</span>
<a name="line-19"></a><a name="ModulePairSet"></a><span class='hs-comment'>--</span>
<a name="line-20"></a><a name="ModulePairSet"></a><span class='hs-keyword'>type</span> <span class='hs-conid'>ModulePairSet</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>FiniteMap</span> <span class='hs-conid'>ModulePair</span> <span class='hs-conid'>()</span>
<a name="line-21"></a>
<a name="line-22"></a><a name="listToSet"></a><span class='hs-definition'>listToSet</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>ModulePair</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ModulePairSet</span>
<a name="line-23"></a><span class='hs-definition'>listToSet</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>listToFM</span> <span class='hs-layout'>(</span><span class='hs-varid'>zip</span> <span class='hs-varid'>l</span> <span class='hs-layout'>(</span><span class='hs-varid'>repeat</span> <span class='hs-conid'>()</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-24"></a>
<a name="line-25"></a><a name="checkFamInstConsistency"></a><span class='hs-definition'>checkFamInstConsistency</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Module</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Module</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-26"></a><span class='hs-definition'>checkFamInstConsistency</span> <span class='hs-varid'>famInstMods</span> <span class='hs-varid'>directlyImpMods</span>
<a name="line-27"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>dflags</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getDOpts</span>
<a name="line-28"></a> <span class='hs-layout'>;</span> <span class='hs-layout'>(</span><span class='hs-varid'>eps</span><span class='hs-layout'>,</span> <span class='hs-varid'>hpt</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEpsAndHpt</span>
<a name="line-29"></a>
<a name="line-30"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- Fetch the iface of a given module. Must succeed as</span>
<a name="line-31"></a> <span class='hs-comment'>-- all imported modules must already have been loaded.</span>
<a name="line-32"></a> <span class='hs-varid'>modIface</span> <span class='hs-varid'>mod</span> <span class='hs-keyglyph'>=</span>
<a name="line-33"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>lookupIfaceByModule</span> <span class='hs-varid'>dflags</span> <span class='hs-varid'>hpt</span> <span class='hs-layout'>(</span><span class='hs-varid'>eps_PIT</span> <span class='hs-varid'>eps</span><span class='hs-layout'>)</span> <span class='hs-varid'>mod</span> <span class='hs-keyword'>of</span>
<a name="line-34"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>panic</span> <span class='hs-str'>"FamInst.checkFamInstConsistency"</span>
<a name="line-35"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>iface</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>iface</span>
<a name="line-36"></a>
<a name="line-37"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>hmiModule</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mi_module</span> <span class='hs-varop'>.</span> <span class='hs-varid'>hm_iface</span>
<a name="line-38"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>hmiFamInstEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>mkFamInstEnv</span> <span class='hs-varop'>.</span> <span class='hs-varid'>md_fam_insts</span> <span class='hs-varop'>.</span> <span class='hs-varid'>hm_details</span>
<a name="line-39"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>mkFamInstEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>extendFamInstEnvList</span> <span class='hs-varid'>emptyFamInstEnv</span>
<a name="line-40"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>hptModInsts</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>[</span> <span class='hs-layout'>(</span><span class='hs-varid'>hmiModule</span> <span class='hs-varid'>hmi</span><span class='hs-layout'>,</span> <span class='hs-varid'>hmiFamInstEnv</span> <span class='hs-varid'>hmi</span><span class='hs-layout'>)</span>
<a name="line-41"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>hmi</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>eltsUFM</span> <span class='hs-varid'>hpt</span><span class='hs-keyglyph'>]</span>
<a name="line-42"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>modInstsEnv</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>eps_mod_fam_inst_env</span> <span class='hs-varid'>eps</span> <span class='hs-comment'>-- external modules</span>
<a name="line-43"></a> <span class='hs-varop'>`extendModuleEnvList`</span> <span class='hs-comment'>-- plus</span>
<a name="line-44"></a> <span class='hs-varid'>hptModInsts</span> <span class='hs-comment'>-- home package modules</span>
<a name="line-45"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>groups</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-varid'>dep_finsts</span> <span class='hs-varop'>.</span> <span class='hs-varid'>mi_deps</span> <span class='hs-varop'>.</span> <span class='hs-varid'>modIface</span><span class='hs-layout'>)</span>
<a name="line-46"></a> <span class='hs-varid'>directlyImpMods</span>
<a name="line-47"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>okPairs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>listToSet</span> <span class='hs-varop'>$</span> <span class='hs-varid'>concatMap</span> <span class='hs-varid'>allPairs</span> <span class='hs-varid'>groups</span>
<a name="line-48"></a> <span class='hs-comment'>-- instances of okPairs are consistent</span>
<a name="line-49"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>criticalPairs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>listToSet</span> <span class='hs-varop'>$</span> <span class='hs-varid'>allPairs</span> <span class='hs-varid'>famInstMods</span>
<a name="line-50"></a> <span class='hs-comment'>-- all pairs that we need to consider</span>
<a name="line-51"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>toCheckPairs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>keysFM</span> <span class='hs-varop'>$</span> <span class='hs-varid'>criticalPairs</span> <span class='hs-varop'>`minusFM`</span> <span class='hs-varid'>okPairs</span>
<a name="line-52"></a> <span class='hs-comment'>-- the difference gives us the pairs we need to check now</span>
<a name="line-53"></a> <span class='hs-layout'>}</span>
<a name="line-54"></a>
<a name="line-55"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>mapM_</span> <span class='hs-layout'>(</span><span class='hs-varid'>check</span> <span class='hs-varid'>modInstsEnv</span><span class='hs-layout'>)</span> <span class='hs-varid'>toCheckPairs</span>
<a name="line-56"></a> <span class='hs-layout'>}</span>
<a name="line-57"></a> <span class='hs-keyword'>where</span>
<a name="line-58"></a> <span class='hs-varid'>allPairs</span> <span class='hs-conid'>[]</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
<a name="line-59"></a> <span class='hs-varid'>allPairs</span> <span class='hs-layout'>(</span><span class='hs-varid'>m</span><span class='hs-conop'>:</span><span class='hs-varid'>ms</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>map</span> <span class='hs-layout'>(</span><span class='hs-conid'>ModulePair</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-varid'>ms</span> <span class='hs-varop'>++</span> <span class='hs-varid'>allPairs</span> <span class='hs-varid'>ms</span>
<a name="line-60"></a>
<a name="line-61"></a> <span class='hs-comment'>-- The modules are guaranteed to be in the environment, as they are either</span>
<a name="line-62"></a> <span class='hs-comment'>-- already loaded in the EPS or they are in the HPT.</span>
<a name="line-63"></a> <span class='hs-comment'>--</span>
<a name="line-64"></a> <span class='hs-varid'>check</span> <span class='hs-varid'>modInstsEnv</span> <span class='hs-layout'>(</span><span class='hs-conid'>ModulePair</span> <span class='hs-varid'>m1</span> <span class='hs-varid'>m2</span><span class='hs-layout'>)</span>
<a name="line-65"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>let</span> <span class='hs-layout'>{</span> <span class='hs-varid'>instEnv1</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>expectJust</span> <span class='hs-str'>"checkFamInstConsistency"</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-varid'>lookupModuleEnv</span> <span class='hs-varid'>modInstsEnv</span> <span class='hs-varop'>$</span> <span class='hs-varid'>m1</span>
<a name="line-66"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>instEnv2</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>expectJust</span> <span class='hs-str'>"checkFamInstConsistency"</span><span class='hs-layout'>)</span> <span class='hs-varop'>.</span> <span class='hs-varid'>lookupModuleEnv</span> <span class='hs-varid'>modInstsEnv</span> <span class='hs-varop'>$</span> <span class='hs-varid'>m2</span>
<a name="line-67"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>insts1</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>famInstEnvElts</span> <span class='hs-varid'>instEnv1</span>
<a name="line-68"></a> <span class='hs-layout'>}</span>
<a name="line-69"></a> <span class='hs-keyword'>in</span>
<a name="line-70"></a> <span class='hs-varid'>mapM_</span> <span class='hs-layout'>(</span><span class='hs-varid'>checkForConflicts</span> <span class='hs-layout'>(</span><span class='hs-varid'>emptyFamInstEnv</span><span class='hs-layout'>,</span> <span class='hs-varid'>instEnv2</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-varid'>insts1</span>
</pre>\end{code}
%************************************************************************
%* *
Extending the family instance environment
%* *
%************************************************************************
\begin{code}
<pre><a name="line-1"></a><a name="tcExtendLocalFamInstEnv"></a><span class='hs-comment'>-- Add new locally-defined family instances</span>
<a name="line-2"></a><span class='hs-definition'>tcExtendLocalFamInstEnv</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>FamInst</span><span class='hs-keyglyph'>]</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-varid'>a</span>
<a name="line-3"></a><span class='hs-definition'>tcExtendLocalFamInstEnv</span> <span class='hs-varid'>fam_insts</span> <span class='hs-varid'>thing_inside</span>
<a name="line-4"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-varid'>env</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getGblEnv</span>
<a name="line-5"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>inst_env'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>foldlM</span> <span class='hs-varid'>addLocalFamInst</span> <span class='hs-layout'>(</span><span class='hs-varid'>tcg_fam_inst_env</span> <span class='hs-varid'>env</span><span class='hs-layout'>)</span> <span class='hs-varid'>fam_insts</span>
<a name="line-6"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>env'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>env</span> <span class='hs-layout'>{</span> <span class='hs-varid'>tcg_fam_insts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fam_insts</span> <span class='hs-varop'>++</span> <span class='hs-varid'>tcg_fam_insts</span> <span class='hs-varid'>env</span><span class='hs-layout'>,</span>
<a name="line-7"></a> <span class='hs-varid'>tcg_fam_inst_env</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>inst_env'</span> <span class='hs-layout'>}</span>
<a name="line-8"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>setGblEnv</span> <span class='hs-varid'>env'</span> <span class='hs-varid'>thing_inside</span>
<a name="line-9"></a> <span class='hs-layout'>}</span>
<a name="line-10"></a>
<a name="line-11"></a><a name="addLocalFamInst"></a><span class='hs-comment'>-- Check that the proposed new instance is OK, </span>
<a name="line-12"></a><span class='hs-comment'>-- and then add it to the home inst env</span>
<a name="line-13"></a><span class='hs-definition'>addLocalFamInst</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FamInstEnv</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FamInst</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>FamInstEnv</span>
<a name="line-14"></a><span class='hs-definition'>addLocalFamInst</span> <span class='hs-varid'>home_fie</span> <span class='hs-varid'>famInst</span>
<a name="line-15"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- Load imported instances, so that we report</span>
<a name="line-16"></a> <span class='hs-comment'>-- overlaps correctly</span>
<a name="line-17"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>eps</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>getEps</span>
<a name="line-18"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>inst_envs</span> <span class='hs-keyglyph'>=</span> <span class='hs-layout'>(</span><span class='hs-varid'>eps_fam_inst_env</span> <span class='hs-varid'>eps</span><span class='hs-layout'>,</span> <span class='hs-varid'>home_fie</span><span class='hs-layout'>)</span>
<a name="line-19"></a>
<a name="line-20"></a> <span class='hs-comment'>-- Check for conflicting instance decls</span>
<a name="line-21"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>checkForConflicts</span> <span class='hs-varid'>inst_envs</span> <span class='hs-varid'>famInst</span>
<a name="line-22"></a>
<a name="line-23"></a> <span class='hs-comment'>-- OK, now extend the envt</span>
<a name="line-24"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-varid'>extendFamInstEnv</span> <span class='hs-varid'>home_fie</span> <span class='hs-varid'>famInst</span><span class='hs-layout'>)</span>
<a name="line-25"></a> <span class='hs-layout'>}</span>
</pre>\end{code}
%************************************************************************
%* *
Checking an instance against conflicts with an instance env
%* *
%************************************************************************
Check whether a single family instance conflicts with those in two instance
environments (one for the EPS and one for the HPT).
\begin{code}
<pre><a name="line-1"></a><a name="checkForConflicts"></a><span class='hs-definition'>checkForConflicts</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>FamInstEnv</span><span class='hs-layout'>,</span> <span class='hs-conid'>FamInstEnv</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FamInst</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcM</span> <span class='hs-conid'>()</span>
<a name="line-2"></a><span class='hs-definition'>checkForConflicts</span> <span class='hs-varid'>inst_envs</span> <span class='hs-varid'>famInst</span>
<a name="line-3"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-layout'>{</span> <span class='hs-comment'>-- To instantiate the family instance type, extend the instance</span>
<a name="line-4"></a> <span class='hs-comment'>-- envt with completely fresh template variables</span>
<a name="line-5"></a> <span class='hs-comment'>-- This is important because the template variables must</span>
<a name="line-6"></a> <span class='hs-comment'>-- not overlap with anything in the things being looked up</span>
<a name="line-7"></a> <span class='hs-comment'>-- (since we do unification). </span>
<a name="line-8"></a> <span class='hs-comment'>-- We use tcInstSkolType because we don't want to allocate</span>
<a name="line-9"></a> <span class='hs-comment'>-- fresh *meta* type variables. </span>
<a name="line-10"></a>
<a name="line-11"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>skol_tvs</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>tcInstSkolTyVars</span> <span class='hs-conid'>FamInstSkol</span>
<a name="line-12"></a> <span class='hs-layout'>(</span><span class='hs-varid'>tyConTyVars</span> <span class='hs-layout'>(</span><span class='hs-varid'>famInstTyCon</span> <span class='hs-varid'>famInst</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-13"></a> <span class='hs-layout'>;</span> <span class='hs-keyword'>let</span> <span class='hs-varid'>conflicts</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>lookupFamInstEnvConflicts</span> <span class='hs-varid'>inst_envs</span> <span class='hs-varid'>famInst</span> <span class='hs-varid'>skol_tvs</span>
<a name="line-14"></a> <span class='hs-layout'>;</span> <span class='hs-varid'>unless</span> <span class='hs-layout'>(</span><span class='hs-varid'>null</span> <span class='hs-varid'>conflicts</span><span class='hs-layout'>)</span> <span class='hs-varop'>$</span>
<a name="line-15"></a> <span class='hs-varid'>conflictInstErr</span> <span class='hs-varid'>famInst</span> <span class='hs-layout'>(</span><span class='hs-varid'>fst</span> <span class='hs-layout'>(</span><span class='hs-varid'>head</span> <span class='hs-varid'>conflicts</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-16"></a> <span class='hs-layout'>}</span>
<a name="line-17"></a> <span class='hs-keyword'>where</span>
<a name="line-18"></a>
<a name="line-19"></a><a name="conflictInstErr"></a><span class='hs-definition'>conflictInstErr</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FamInst</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>FamInst</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcRn</span> <span class='hs-conid'>()</span>
<a name="line-20"></a><span class='hs-definition'>conflictInstErr</span> <span class='hs-varid'>famInst</span> <span class='hs-varid'>conflictingFamInst</span>
<a name="line-21"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addFamInstLoc</span> <span class='hs-varid'>famInst</span> <span class='hs-varop'>$</span>
<a name="line-22"></a> <span class='hs-varid'>addErr</span> <span class='hs-layout'>(</span><span class='hs-varid'>hang</span> <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'>"Conflicting family instance declarations:"</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-23"></a> <span class='hs-num'>2</span> <span class='hs-layout'>(</span><span class='hs-varid'>pprFamInsts</span> <span class='hs-keyglyph'>[</span><span class='hs-varid'>famInst</span><span class='hs-layout'>,</span> <span class='hs-varid'>conflictingFamInst</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-24"></a>
<a name="line-25"></a><a name="addFamInstLoc"></a><span class='hs-definition'>addFamInstLoc</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>FamInst</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcRn</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>TcRn</span> <span class='hs-varid'>a</span>
<a name="line-26"></a><span class='hs-definition'>addFamInstLoc</span> <span class='hs-varid'>famInst</span> <span class='hs-varid'>thing_inside</span>
<a name="line-27"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>setSrcSpan</span> <span class='hs-layout'>(</span><span class='hs-varid'>mkSrcSpan</span> <span class='hs-varid'>loc</span> <span class='hs-varid'>loc</span><span class='hs-layout'>)</span> <span class='hs-varid'>thing_inside</span>
<a name="line-28"></a> <span class='hs-keyword'>where</span>
<a name="line-29"></a> <span class='hs-varid'>loc</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>getSrcLoc</span> <span class='hs-varid'>famInst</span>
</pre>\end{code}
</body>
</html>
