import Module
import SrcLoc
import Outputable
+import UniqFM
import FiniteMap
import Maybe
--
type ModulePairSet = FiniteMap ModulePair ()
+listToSet :: [ModulePair] -> ModulePairSet
listToSet l = listToFM (zip l (repeat ()))
checkFamInstConsistency :: [Module] -> [Module] -> TcM ()
Nothing -> panic "FamInst.checkFamInstConsistency"
Just iface -> iface
- ; modInstsEnv = eps_mod_fam_inst_env eps
+ ; hmiModule = mi_module . hm_iface
+ ; hmiFamInstEnv = mkFamInstEnv . md_fam_insts . hm_details
+ ; mkFamInstEnv = extendFamInstEnvList emptyFamInstEnv
+ ; hptModInsts = [ (hmiModule hmi, hmiFamInstEnv hmi)
+ | hmi <- eltsUFM hpt]
+ ; modInstsEnv = eps_mod_fam_inst_env eps -- external modules
+ `extendModuleEnvList` -- plus
+ hptModInsts -- home package modules
; groups = map (dep_finsts . mi_deps . modIface)
directlyImpMods
; okPairs = listToSet $ concatMap allPairs groups
allPairs [] = []
allPairs (m:ms) = map (ModulePair m) ms ++ allPairs ms
- -- Check the consistency of the family instances of the two modules.
+ -- The modules are guaranteed to be in the environment, as they are either
+ -- already loaded in the EPS or they are in the HPT.
+ --
check modInstsEnv (ModulePair m1 m2)
= let { instEnv1 = fromJust . lookupModuleEnv modInstsEnv $ m1
; instEnv2 = fromJust . lookupModuleEnv modInstsEnv $ m2
; let { matches = lookupFamInstEnvUnify inst_envs fam tys'
; conflicts = [ conflictingFamInst
- | match@(_, conflictingFamInst) <- matches
- , conflicting fam tys' tycon match
+ | match@((conflictingFamInst, _), _) <- matches
+ , conflicting tycon match
]
}
; unless (null conflicts) $
conflictInstErr famInst (head conflicts)
}
where
- -- In the case of data/newtype instances, any overlap is a conflict (as
- -- these instances imply injective type mappings).
- conflicting _ _ tycon _ | isAlgTyCon tycon = True
- conflicting fam tys' tycon (subst, cFamInst) | otherwise =
- panic "FamInst.checkForConflicts: overlap check for indexed synonyms is still missing"
+ -- * In the case of data family instances, any overlap is fundamentally a
+ -- conflict (as these instances imply injective type mappings).
+ -- * In the case of type family instances, overlap is admitted as long as
+ -- the right-hand sides of the overlapping rules coincide under the
+ -- overlap substitution. We require that they are syntactically equal;
+ -- anything else would be difficult to test for at this stage.
+ conflicting tycon1 ((famInst2, _), subst)
+ | isAlgTyCon tycon1 = True
+ | otherwise = not (rhs1 `tcEqType` rhs2)
+ where
+ tycon2 = famInstTyCon famInst2
+ rhs1 = substTy subst $ synTyConType tycon1
+ rhs2 = substTy subst $ synTyConType tycon2
conflictInstErr famInst conflictingFamInst
= addFamInstLoc famInst $