1 The @FamInst@ type: family instance heads
5 checkFamInstConsistency, tcExtendLocalFamInstEnv
28 %************************************************************************
30 Optimised overlap checking for family instances
32 %************************************************************************
34 For any two family instance modules that we import directly or indirectly, we
35 check whether the instances in the two modules are consistent, *unless* we can
36 be certain that the instances of the two modules have already been checked for
37 consistency during the compilation of modules that we import.
39 How do we know which pairs of modules have already been checked? Any pair of
40 modules where both modules occur in the `HscTypes.dep_finsts' set (of the
41 `HscTypes.Dependencies') of one of our directly imported modules must have
42 already been checked. Everything else, we check now. (So that we can be
43 certain that the modules in our `HscTypes.dep_finsts' are consistent.)
46 -- The optimisation of overlap tests is based on determining pairs of modules
47 -- whose family instances need to be checked for consistency.
49 data ModulePair = ModulePair Module Module
51 -- canonical order of the components of a module pair
53 canon :: ModulePair -> (Module, Module)
54 canon (ModulePair m1 m2) | m1 < m2 = (m1, m2)
55 | otherwise = (m2, m1)
57 instance Eq ModulePair where
58 mp1 == mp2 = canon mp1 == canon mp2
60 instance Ord ModulePair where
61 mp1 `compare` mp2 = canon mp1 `compare` canon mp2
63 -- Sets of module pairs
65 type ModulePairSet = FiniteMap ModulePair ()
67 listToSet :: [ModulePair] -> ModulePairSet
68 listToSet l = listToFM (zip l (repeat ()))
70 checkFamInstConsistency :: [Module] -> [Module] -> TcM ()
71 checkFamInstConsistency famInstMods directlyImpMods
72 = do { dflags <- getDOpts
73 ; (eps, hpt) <- getEpsAndHpt
75 ; let { -- Fetch the iface of a given module. Must succeed as
76 -- all imported modules must already have been loaded.
78 case lookupIfaceByModule dflags hpt (eps_PIT eps) mod of
79 Nothing -> panic "FamInst.checkFamInstConsistency"
82 ; hmiModule = mi_module . hm_iface
83 ; hmiFamInstEnv = mkFamInstEnv . md_fam_insts . hm_details
84 ; mkFamInstEnv = extendFamInstEnvList emptyFamInstEnv
85 ; hptModInsts = [ (hmiModule hmi, hmiFamInstEnv hmi)
87 ; modInstsEnv = eps_mod_fam_inst_env eps -- external modules
88 `extendModuleEnvList` -- plus
89 hptModInsts -- home package modules
90 ; groups = map (dep_finsts . mi_deps . modIface)
92 ; okPairs = listToSet $ concatMap allPairs groups
93 -- instances of okPairs are consistent
94 ; criticalPairs = listToSet $ allPairs famInstMods
95 -- all pairs that we need to consider
96 ; toCheckPairs = keysFM $ criticalPairs `minusFM` okPairs
97 -- the difference gives us the pairs we need to check now
100 ; mapM_ (check modInstsEnv) toCheckPairs
104 allPairs (m:ms) = map (ModulePair m) ms ++ allPairs ms
106 -- The modules are guaranteed to be in the environment, as they are either
107 -- already loaded in the EPS or they are in the HPT.
109 check modInstsEnv (ModulePair m1 m2)
110 = let { instEnv1 = fromJust . lookupModuleEnv modInstsEnv $ m1
111 ; instEnv2 = fromJust . lookupModuleEnv modInstsEnv $ m2
112 ; insts1 = famInstEnvElts instEnv1
115 mapM_ (checkForConflicts (emptyFamInstEnv, instEnv2)) insts1
118 %************************************************************************
120 Extending the family instance environment
122 %************************************************************************
125 -- Add new locally-defined family instances
126 tcExtendLocalFamInstEnv :: [FamInst] -> TcM a -> TcM a
127 tcExtendLocalFamInstEnv fam_insts thing_inside
128 = do { env <- getGblEnv
129 ; inst_env' <- foldlM addLocalFamInst (tcg_fam_inst_env env) fam_insts
130 ; let env' = env { tcg_fam_insts = fam_insts ++ tcg_fam_insts env,
131 tcg_fam_inst_env = inst_env' }
132 ; setGblEnv env' thing_inside
135 -- Check that the proposed new instance is OK,
136 -- and then add it to the home inst env
137 addLocalFamInst :: FamInstEnv -> FamInst -> TcM FamInstEnv
138 addLocalFamInst home_fie famInst
139 = do { -- Load imported instances, so that we report
140 -- overlaps correctly
142 ; let inst_envs = (eps_fam_inst_env eps, home_fie)
144 -- Check for conflicting instance decls
145 ; checkForConflicts inst_envs famInst
147 -- OK, now extend the envt
148 ; return (extendFamInstEnv home_fie famInst)
152 %************************************************************************
154 Checking an instance against conflicts with an instance env
156 %************************************************************************
158 Check whether a single family instance conflicts with those in two instance
159 environments (one for the EPS and one for the HPT).
162 checkForConflicts :: (FamInstEnv, FamInstEnv) -> FamInst -> TcM ()
163 checkForConflicts inst_envs famInst
164 = do { -- To instantiate the family instance type, extend the instance
165 -- envt with completely fresh template variables
166 -- This is important because the template variables must
167 -- not overlap with anything in the things being looked up
168 -- (since we do unification).
169 -- We use tcInstSkolType because we don't want to allocate
170 -- fresh *meta* type variables.
171 ; let { tycon = famInstTyCon famInst
172 ; ty = case tyConFamInst_maybe tycon of
173 Nothing -> panic "FamInst.checkForConflicts"
174 Just (tc, tys) -> tc `mkTyConApp` tys
176 ; (_, _, tau') <- tcInstSkolType FamInstSkol ty
178 ; let (fam, tys') = tcSplitTyConApp tau'
180 ; let { matches = lookupFamInstEnvUnify inst_envs fam tys'
181 ; conflicts = [ conflictingFamInst
182 | match@((conflictingFamInst, _), _) <- matches
183 , conflicting tycon match
186 ; unless (null conflicts) $
187 conflictInstErr famInst (head conflicts)
190 -- - In the case of data family instances, any overlap is fundamentally a
191 -- conflict (as these instances imply injective type mappings).
192 -- - In the case of type family instances, overlap is admitted as long as
193 -- the right-hand sides of the overlapping rules coincide under the
194 -- overlap substitution. We require that they are syntactically equal;
195 -- anything else would be difficult to test for at this stage.
196 conflicting tycon1 ((famInst2, _), subst)
197 | isAlgTyCon tycon1 = True
198 | otherwise = not (rhs1 `tcEqType` rhs2)
200 tycon2 = famInstTyCon famInst2
201 rhs1 = substTy subst $ synTyConType tycon1
202 rhs2 = substTy subst $ synTyConType tycon2
204 conflictInstErr :: FamInst -> FamInst -> TcRn ()
205 conflictInstErr famInst conflictingFamInst
206 = addFamInstLoc famInst $
207 addErr (hang (ptext (sLit "Conflicting family instance declarations:"))
208 2 (pprFamInsts [famInst, conflictingFamInst]))
210 addFamInstLoc :: FamInst -> TcRn a -> TcRn a
211 addFamInstLoc famInst thing_inside
212 = setSrcSpan (mkSrcSpan loc loc) thing_inside
214 loc = getSrcLoc famInst