%* *
%************************************************************************
-InstEnv maps a family name to the list of known instances for that family.
+Note [FamInstEnv]
+~~~~~~~~~~~~~~~~~~~~~
+A FamInstEnv maps a family name to the list of known instances for that family.
+
+The same FamInstEnv includes both 'data family' and 'type family' instances.
+Type families are reduced during type inference, but not data families;
+the user explains when to use a data family instance by using contructors
+and pattern matching.
+
+Neverthless it is still useful to have data families in the FamInstEnv:
+
+ - For finding overlaps and conflicts
+
+ - For finding the representation type...see FamInstEnv.topNormaliseType
+ and its call site in Simplify
+
+ - In standalone deriving instance Eq (T [Int]) we need to find the
+ representation type for T [Int]
\begin{code}
type FamInstEnv = UniqFM FamilyInstEnv -- Maps a family to its instances
+ -- See Note [FamInstEnv]
type FamInstEnvs = (FamInstEnv, FamInstEnv)
- -- External package inst-env, Home-package inst-env
+ -- External package inst-env, Home-package inst-env
data FamilyInstEnv
= FamIE [FamInst] -- The instances for a particular family, in any order
-- If *not* then the common case of looking up
-- (T a b c) can fail immediately
+instance Outputable FamilyInstEnv where
+ ppr (FamIE fs b) = ptext (sLit "FamIE") <+> ppr b <+> vcat (map ppr fs)
+
-- INVARIANTS:
-- * The fs_tvs are distinct in each FamInst
-- of a range value of the map (so we can safely unify them)
:: FamInstEnvs
-> TyCon -> [Type] -- What we are looking for
-> [FamInstMatch] -- Successful matches
+-- Precondition: the tycon is saturated (or over-saturated)
lookupFamInstEnv
= lookup_fam_inst_env match True
-- to find conflicting matches
-- The skolem tyvars are needed because we don't have a
-- unique supply to hand
+--
+-- Precondition: the tycon is saturated (or over-saturated)
lookupFamInstEnvConflicts envs fam_inst skol_tvs
= lookup_fam_inst_env my_unify False envs fam tys'
-> FamInstEnvs
-> TyCon -> [Type] -- What we are looking for
-> [FamInstMatch] -- Successful matches
+
+-- Precondition: the tycon is saturated (or over-saturated)
+
lookup_fam_inst_env match_fun one_sided (pkg_ie, home_ie) fam tys
| not (isFamilyTyCon fam)
= []
| otherwise
- = ASSERT( n_tys >= arity ) -- Family type applications must be saturated
+ = ASSERT2( n_tys >= arity, ppr fam <+> ppr tys ) -- Family type applications must be saturated
home_matches ++ pkg_matches
where
home_matches = lookup home_ie
---------------
normaliseTcApp :: FamInstEnvs -> TyCon -> [Type] -> (CoercionI, Type)
normaliseTcApp env tc tys
- = let -- First normalise the arg types so that they'll match
+ | isFamilyTyCon tc
+ , tyConArity tc <= length tys -- Unsaturated data families are possible
+ , [(fam_inst, inst_tys)] <- lookupFamInstEnv env tc ntys
+ = let -- A matching family instance exists
+ rep_tc = famInstTyCon fam_inst
+ co_tycon = expectJust "lookupFamInst" (tyConFamilyCoercion_maybe rep_tc)
+ co = mkTyConApp co_tycon inst_tys
+ first_coi = mkTransCoI tycon_coi (ACo co)
+ (rest_coi, nty) = normaliseType env (mkTyConApp rep_tc inst_tys)
+ fix_coi = mkTransCoI first_coi rest_coi
+ in
+ (fix_coi, nty)
+
+ | otherwise
+ = (tycon_coi, TyConApp tc ntys)
+
+ where
+ -- Normalise the arg types so that they'll match
-- when we lookup in in the instance envt
- (cois, ntys) = mapAndUnzip (normaliseType env) tys
- tycon_coi = mkTyConAppCoI tc cois
- in -- Now try the top-level redex
- case lookupFamInstEnv env tc ntys of
- -- A matching family instance exists
- [(fam_inst, tys)] -> (fix_coi, nty)
- where
- rep_tc = famInstTyCon fam_inst
- co_tycon = expectJust "lookupFamInst" (tyConFamilyCoercion_maybe rep_tc)
- co = mkTyConApp co_tycon tys
- first_coi = mkTransCoI tycon_coi (ACo co)
- (rest_coi,nty) = normaliseType env (mkTyConApp rep_tc tys)
- fix_coi = mkTransCoI first_coi rest_coi
-
- -- No unique matching family instance exists;
- -- we do not do anything
- _ -> (tycon_coi, TyConApp tc ntys)
+ (cois, ntys) = mapAndUnzip (normaliseType env) tys
+ tycon_coi = mkTyConAppCoI tc cois
+
---------------
normaliseType :: FamInstEnvs -- environment with family instances
-> Type -- old type
normaliseType env (AppTy ty1 ty2)
= let (coi1,nty1) = normaliseType env ty1
(coi2,nty2) = normaliseType env ty2
- in (mkAppTyCoI coi1 coi2, AppTy nty1 nty2)
+ in (mkAppTyCoI coi1 coi2, mkAppTy nty1 nty2)
normaliseType env (FunTy ty1 ty2)
= let (coi1,nty1) = normaliseType env ty1
(coi2,nty2) = normaliseType env ty2
- in (mkFunTyCoI coi1 coi2, FunTy nty1 nty2)
+ in (mkFunTyCoI coi1 coi2, mkFunTy nty1 nty2)
normaliseType env (ForAllTy tyvar ty1)
= let (coi,nty1) = normaliseType env ty1
in (mkForAllTyCoI tyvar coi, ForAllTy tyvar nty1)