- let tycon = famInstTyCon famInst
- ty = case tyConFamInst_maybe tycon of
- Nothing -> panic "FamInst.addLocalFamInst"
- Just (tc, tys) -> tc `mkTyConApp` tys
- ; (tvs', theta', tau') <- tcInstSkolType (FamInstSkol tycon) ty
-
- ; let (fam, tys') = tcSplitTyConApp tau'
-
-{- !!!TODO: Need to complete this:
- -- Load imported instances, so that we report
- -- overlaps correctly
- ; eps <- getEps
- ; let inst_envs = (eps_fam_inst_env eps, home_fie)
-
- -- Check for overlapping instance decls
- ; let { (matches, _) = lookupFamInstEnv inst_envs fam tys'
- ; dup_ispecs = [ dup_ispec --!!!adapt
- | (_, dup_ispec) <- matches
- , let (_,_,_,dup_tys) = instanceHead dup_ispec
- , isJust (tcMatchTys (mkVarSet tvs') tys' dup_tys)] }
- -- Find memebers of the match list which ispec itself matches.
- -- If the match is 2-way, it's a duplicate
- ; case dup_ispecs of
- dup_ispec : _ -> dupInstErr famInst dup_ispec
- [] -> return ()
- -}
-
- -- OK, now extend the envt
- ; return (extendFamInstEnv home_fie famInst) }
-
-overlapErr famInst dupFamInst
+ ; let { tycon = famInstTyCon famInst
+ ; ty = case tyConFamInst_maybe tycon of
+ Nothing -> panic "FamInst.checkForConflicts"
+ Just (tc, tys) -> tc `mkTyConApp` tys
+ }
+ ; (tvs', _, tau') <- tcInstSkolType (FamInstSkol tycon) ty
+
+ ; let (fam, tys') = tcSplitTyConApp tau'
+
+ ; let { matches = lookupFamInstEnvUnify inst_envs fam tys'
+ ; conflicts = [ conflictingFamInst
+ | match@(_, conflictingFamInst) <- matches
+ , conflicting fam tys' 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"
+
+conflictInstErr famInst conflictingFamInst