Commit e4b7186c authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Fix an ASSERT failure in FamInstEnv

I added a lot of comments too, to explain the preconditions;
esp Note [FamInstEnv]
parent 20607885
......@@ -155,13 +155,31 @@ mkImportedFamInst fam mb_tcs tycon
%* *
%************************************************************************
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
......@@ -233,6 +251,7 @@ lookupFamInstEnv
:: 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
......@@ -250,6 +269,8 @@ lookupFamInstEnvConflicts
-- 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'
......@@ -314,11 +335,14 @@ lookup_fam_inst_env -- The worker, local to this module
-> 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
......@@ -442,25 +466,28 @@ topNormaliseType env ty
---------------
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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment