+extendFamInstEnv inst_env ins_item@(FamInst {fi_fam = cls_nm, fi_tcs = mb_tcs})
+ = addToUFM_C add inst_env cls_nm (FamIE [ins_item] ins_tyvar)
+ where
+ add (FamIE items tyvar) _ = FamIE (ins_item:items)
+ (ins_tyvar || tyvar)
+ ins_tyvar = not (any isJust mb_tcs)
+\end{code}
+
+%************************************************************************
+%* *
+ Looking up a family instance
+%* *
+%************************************************************************
+
+@lookupFamInstEnv@ looks up in a @FamInstEnv@, using a one-way match.
+Multiple matches are only possible in case of type families (not data
+families), and then, it doesn't matter which match we choose (as the
+instances are guaranteed confluent).
+
+We return the matching family instances and the type instance at which it
+matches. For example, if we lookup 'T [Int]' and have a family instance
+
+ data instance T [a] = ..
+
+desugared to
+
+ data :R42T a = ..
+ coe :Co:R42T a :: T [a] ~ :R42T a
+
+we return the matching instance '(FamInst{.., fi_tycon = :R42T}, Int)'.
+
+\begin{code}
+type FamInstMatch = (FamInst, [Type]) -- Matching type instance
+
+lookupFamInstEnv :: FamInstEnvs
+ -> TyCon -> [Type] -- What we are looking for
+ -> [FamInstMatch] -- Successful matches
+lookupFamInstEnv (pkg_ie, home_ie) fam tys
+ | not (isOpenTyCon fam)
+ = []
+ | otherwise
+ = home_matches ++ pkg_matches
+ where
+ rough_tcs = roughMatchTcs tys
+ all_tvs = all isNothing rough_tcs
+ home_matches = lookup home_ie
+ pkg_matches = lookup pkg_ie
+
+ --------------
+ lookup env = case lookupUFM env fam of
+ Nothing -> [] -- No instances for this class
+ Just (FamIE insts has_tv_insts)
+ -- Short cut for common case:
+ -- The thing we are looking up is of form (C a
+ -- b c), and the FamIE has no instances of
+ -- that form, so don't bother to search
+ | all_tvs && not has_tv_insts -> []
+ | otherwise -> find insts
+
+ --------------
+ find [] = []
+ find (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs,
+ fi_tys = tpl_tys, fi_tycon = tycon }) : rest)
+ -- Fast check for no match, uses the "rough match" fields
+ | instanceCantMatch rough_tcs mb_tcs
+ = find rest
+
+ -- Proper check
+ | Just subst <- tcMatchTys tpl_tvs tpl_tys tys
+ = (item, substTyVars subst (tyConTyVars tycon)) : find rest
+
+ -- No match => try next
+ | otherwise
+ = find rest
+\end{code}
+
+While @lookupFamInstEnv@ uses a one-way match, the next function
+@lookupFamInstEnvUnify@ uses two-way matching (ie, unification). This is
+needed to check for overlapping instances.
+
+For class instances, these two variants of lookup are combined into one
+function (cf, @InstEnv@). We don't do that for family instances as the
+results of matching and unification are used in two different contexts.
+Moreover, matching is the wildly more frequently used operation in the case of
+indexed synonyms and we don't want to slow that down by needless unification.
+
+\begin{code}
+lookupFamInstEnvUnify :: (FamInstEnv, FamInstEnv) -> TyCon -> [Type]
+ -> [(FamInstMatch, TvSubst)]
+lookupFamInstEnvUnify (pkg_ie, home_ie) fam tys
+ | not (isOpenTyCon fam)
+ = []
+ | otherwise
+ = home_matches ++ pkg_matches
+ where
+ rough_tcs = roughMatchTcs tys
+ all_tvs = all isNothing rough_tcs
+ home_matches = lookup home_ie
+ pkg_matches = lookup pkg_ie
+
+ --------------
+ lookup env = case lookupUFM env fam of
+ Nothing -> [] -- No instances for this class
+ Just (FamIE insts has_tv_insts)
+ -- Short cut for common case:
+ -- The thing we are looking up is of form (C a
+ -- b c), and the FamIE has no instances of
+ -- that form, so don't bother to search
+ | all_tvs && not has_tv_insts -> []
+ | otherwise -> find insts
+
+ --------------
+ find [] = []
+ find (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs,
+ fi_tys = tpl_tys, fi_tycon = tycon }) : rest)
+ -- Fast check for no match, uses the "rough match" fields
+ | instanceCantMatch rough_tcs mb_tcs
+ = find rest
+
+ | otherwise
+ = ASSERT2( tyVarsOfTypes tys `disjointVarSet` tpl_tvs,
+ (ppr fam <+> ppr tys <+> ppr all_tvs) $$
+ (ppr tycon <+> ppr tpl_tvs <+> ppr tpl_tys)
+ )
+ -- Unification will break badly if the variables overlap
+ -- They shouldn't because we allocate separate uniques for them
+ case tcUnifyTys instanceBindFun tpl_tys tys of
+ Just subst -> let rep_tys = substTyVars subst (tyConTyVars tycon)
+ in
+ ((item, rep_tys), subst) : find rest
+ Nothing -> find rest
+\end{code}
+
+%************************************************************************
+%* *
+ Looking up a family instance
+%* *
+%************************************************************************
+
+\begin{code}
+topNormaliseType :: FamInstEnvs
+ -> Type
+ -> Maybe (Coercion, Type)
+
+-- Get rid of *outermost* (or toplevel)
+-- * type functions
+-- * newtypes
+-- using appropriate coercions.
+-- By "outer" we mean that toplevelNormaliseType guarantees to return
+-- a type that does not have a reducible redex (F ty1 .. tyn) as its
+-- outermost form. It *can* return something like (Maybe (F ty)), where
+-- (F ty) is a redex.
+
+-- Its a bit like Type.repType, but handles type families too
+
+topNormaliseType env ty
+ = go [] ty