-@extendInstEnv@ extends a @ClsInstEnv@, checking for overlaps.
-
-A boolean flag controls overlap reporting.
-
-True => overlap is permitted, but only if one template matches the other;
- not if they unify but neither is
-
-\begin{code}
-extendInstEnv :: DynFlags -> InstEnv -> [DFunId] -> (InstEnv, [Message])
- -- Similar, but all we have is the DFuns
-extendInstEnv dflags env dfun_ids = foldl (addToInstEnv dflags) (env, []) dfun_ids
-
-
-addToInstEnv :: DynFlags
- -> (InstEnv, [Message])
- -> DFunId
- -> (InstEnv, [Message]) -- Resulting InstEnv and augmented error messages
-
-addToInstEnv dflags (inst_env, errs) dfun_id
- -- Check first that the new instance doesn't
- -- conflict with another. See notes below about fundeps.
- | not (null bad_fundeps)
- = (inst_env, fundep_err : errs) -- Bad fundeps; report the first only
-
- | otherwise
- = case insert_into cls_inst_env of
- Failed err -> (inst_env, err : errs)
- Succeeded new_env -> (addToUFM inst_env clas new_env, errs)
-
- where
- cls_inst_env = classInstEnv inst_env clas
- (ins_tvs, _, clas, ins_tys) = tcSplitDFunTy (idType dfun_id)
- bad_fundeps = badFunDeps cls_inst_env clas ins_tv_set ins_tys
- fundep_err = fundepErr dfun_id (head bad_fundeps)
-
- ins_tv_set = mkVarSet ins_tvs
- ins_item = (ins_tv_set, ins_tys, dfun_id)
-
- insert_into [] = returnMaB [ins_item]
- insert_into env@(cur_item@(tpl_tvs, tpl_tys, tpl_dfun_id) : rest)
- = case unifyTyListsX (ins_tv_set `unionVarSet` tpl_tvs) tpl_tys ins_tys of
- Just subst -> insert_unifiable env subst
- Nothing -> carry_on cur_item rest
-
- carry_on cur_item rest = insert_into rest `thenMaB` \ rest' ->
- returnMaB (cur_item : rest')
-
- -- The two templates unify. This is acceptable iff
- -- (a) -fallow-overlapping-instances is on
- -- (b) one is strictly more specific than the other
- -- [It's bad if they are identical or incomparable]
- insert_unifiable env@(cur_item@(tpl_tvs, tpl_tys, tpl_dfun_id) : rest) subst
- | ins_item_more_specific && cur_item_more_specific
- = -- Duplicates
- failMaB (dupInstErr dfun_id tpl_dfun_id)
-
- | not (dopt Opt_AllowOverlappingInstances dflags)
- || not (ins_item_more_specific || cur_item_more_specific)
- = -- Overlap illegal, or the two are incomparable
- failMaB (overlapErr dfun_id tpl_dfun_id)
-
- | otherwise
- = -- OK, it's acceptable. Remaining question is whether
- -- we drop it here or compare it with others
- if ins_item_more_specific then
- -- New item is an instance of current item, so drop it here
- returnMaB (ins_item : env)
- else
- carry_on cur_item rest
-
- where
- ins_item_more_specific = allVars subst ins_tvs
- cur_item_more_specific = allVars subst (varSetElems tpl_tvs)
-
-allVars :: TyVarSubstEnv -> [TyVar] -> Bool
--- True iff all the type vars are mapped to distinct type vars
-allVars subst tvs
- = allDistinctTyVars (map lookup tvs) emptyVarSet
- where
- lookup tv = case lookupSubstEnv subst tv of
- Just (DoneTy ty) -> ty
- Nothing -> mkTyVarTy tv
-\end{code}
-
-Functional dependencies
-~~~~~~~~~~~~~~~~~~~~~~~