2 % (c) The University of Glasgow 2006
5 FamInstEnv: Type checked family instance declarations
9 FamInst(..), famInstTyCon, famInstTyVars,
10 pprFamInst, pprFamInstHdr, pprFamInsts,
11 famInstHead, mkLocalFamInst, mkImportedFamInst,
13 FamInstEnvs, FamInstEnv, emptyFamInstEnv,
14 extendFamInstEnv, extendFamInstEnvList,
15 famInstEnvElts, familyInstances,
17 lookupFamInstEnv, lookupFamInstEnvUnify
20 #include "HsVersions.h"
40 %************************************************************************
42 \subsection{Type checked family instance heads}
44 %************************************************************************
48 = FamInst { fi_fam :: Name -- Family name
50 -- Used for "rough matching"; same idea as for class instances
51 , fi_tcs :: [Maybe Name] -- Top of type args
53 -- Used for "proper matching"; ditto
54 , fi_tvs :: TyVarSet -- Template tyvars for full match
55 , fi_tys :: [Type] -- Full arg types
57 , fi_tycon :: TyCon -- Representation tycon
60 -- Obtain the representation tycon of a family instance.
62 famInstTyCon :: FamInst -> TyCon
63 famInstTyCon = fi_tycon
65 famInstTyVars = fi_tvs
69 instance NamedThing FamInst where
70 getName = getName . fi_tycon
72 instance Outputable FamInst where
75 -- Prints the FamInst as a family instance declaration
76 pprFamInst :: FamInst -> SDoc
78 = hang (pprFamInstHdr famInst)
79 2 (ptext SLIT("--") <+> (pprDefnLoc (getSrcLoc famInst)))
81 pprFamInstHdr :: FamInst -> SDoc
82 pprFamInstHdr (FamInst {fi_fam = fam, fi_tys = tys, fi_tycon = tycon})
83 = pprTyConSort <+> pprHead
85 pprHead = parenSymOcc (getOccName fam) (ppr fam) <+>
86 sep (map pprParendType tys)
87 pprTyConSort | isDataTyCon tycon = ptext SLIT("data instance")
88 | isNewTyCon tycon = ptext SLIT("newtype instance")
89 | isSynTyCon tycon = ptext SLIT("type instance")
90 | otherwise = panic "FamInstEnv.pprFamInstHdr"
92 pprFamInsts :: [FamInst] -> SDoc
93 pprFamInsts finsts = vcat (map pprFamInst finsts)
95 famInstHead :: FamInst -> ([TyVar], TyCon, [Type])
96 famInstHead (FamInst {fi_tycon = tycon})
97 = case tyConFamInst_maybe tycon of
98 Nothing -> panic "FamInstEnv.famInstHead"
99 Just (fam, tys) -> (tyConTyVars tycon, fam, tys)
101 -- Make a family instance representation from a tycon. This is used for local
102 -- instances, where we can safely pull on the tycon.
104 mkLocalFamInst :: TyCon -> FamInst
106 = case tyConFamInst_maybe tycon of
107 Nothing -> panic "FamInstEnv.mkLocalFamInst"
110 fi_fam = tyConName fam,
111 fi_tcs = roughMatchTcs tys,
112 fi_tvs = mkVarSet . tyConTyVars $ tycon,
117 -- Make a family instance representation from the information found in an
118 -- unterface file. In particular, we get the rough match info from the iface
119 -- (instead of computing it here).
121 mkImportedFamInst :: Name -> [Maybe Name] -> TyCon -> FamInst
122 mkImportedFamInst fam mb_tcs tycon
126 fi_tvs = mkVarSet . tyConTyVars $ tycon,
127 fi_tys = case tyConFamInst_maybe tycon of
128 Nothing -> panic "FamInstEnv.mkImportedFamInst"
129 Just (_, tys) -> tys,
135 %************************************************************************
139 %************************************************************************
141 InstEnv maps a family name to the list of known instances for that family.
144 type FamInstEnv = UniqFM FamilyInstEnv -- Maps a family to its instances
146 type FamInstEnvs = (FamInstEnv, FamInstEnv)
147 -- External package inst-env, Home-package inst-env
150 = FamIE [FamInst] -- The instances for a particular family, in any order
151 Bool -- True <=> there is an instance of form T a b c
152 -- If *not* then the common case of looking up
153 -- (T a b c) can fail immediately
156 -- * The fs_tvs are distinct in each FamInst
157 -- of a range value of the map (so we can safely unify them)
159 emptyFamInstEnv :: FamInstEnv
160 emptyFamInstEnv = emptyUFM
162 famInstEnvElts :: FamInstEnv -> [FamInst]
163 famInstEnvElts fi = [elt | FamIE elts _ <- eltsUFM fi, elt <- elts]
165 familyInstances :: (FamInstEnv, FamInstEnv) -> TyCon -> [FamInst]
166 familyInstances (pkg_fie, home_fie) fam
167 = get home_fie ++ get pkg_fie
169 get env = case lookupUFM env fam of
170 Just (FamIE insts _) -> insts
173 extendFamInstEnvList :: FamInstEnv -> [FamInst] -> FamInstEnv
174 extendFamInstEnvList inst_env fis = foldl extendFamInstEnv inst_env fis
176 extendFamInstEnv :: FamInstEnv -> FamInst -> FamInstEnv
177 extendFamInstEnv inst_env ins_item@(FamInst {fi_fam = cls_nm, fi_tcs = mb_tcs})
178 = addToUFM_C add inst_env cls_nm (FamIE [ins_item] ins_tyvar)
180 add (FamIE items tyvar) _ = FamIE (ins_item:items)
182 ins_tyvar = not (any isJust mb_tcs)
185 %************************************************************************
187 \subsection{Looking up a family instance}
189 %************************************************************************
191 @lookupFamInstEnv@ looks up in a @FamInstEnv@, using a one-way match.
192 Multiple matches are only possible in case of type families (not data
193 families), and then, it doesn't matter which match we choose (as the
194 instances are guaranteed confluent).
197 lookupFamInstEnv :: FamInstEnvs
198 -> TyCon -> [Type] -- What we are looking for
199 -> [(TvSubst, FamInst)] -- Successful matches
200 lookupFamInstEnv (pkg_ie, home_ie) fam tys
201 = home_matches ++ pkg_matches
203 rough_tcs = roughMatchTcs tys
204 all_tvs = all isNothing rough_tcs
205 home_matches = lookup home_ie
206 pkg_matches = lookup pkg_ie
209 lookup env = case lookupUFM env fam of
210 Nothing -> [] -- No instances for this class
211 Just (FamIE insts has_tv_insts)
212 -- Short cut for common case:
213 -- The thing we are looking up is of form (C a
214 -- b c), and the FamIE has no instances of
215 -- that form, so don't bother to search
216 | all_tvs && not has_tv_insts -> []
217 | otherwise -> find insts
221 find (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs,
222 fi_tys = tpl_tys, fi_tycon = tycon }) : rest)
223 -- Fast check for no match, uses the "rough match" fields
224 | instanceCantMatch rough_tcs mb_tcs
228 | Just subst <- tcMatchTys tpl_tvs tpl_tys tys
229 = (subst, item) : find rest
231 -- No match => try next
236 While @lookupFamInstEnv@ uses a one-way match, the next function
237 @lookupFamInstEnvUnify@ uses two-way matching (ie, unification). This is
238 needed to check for overlapping instances.
240 For class instances, these two variants of lookup are combined into one
241 function (cf, @InstEnv@). We don't do that for family instances as the
242 results of matching and unification are used in two different contexts.
243 Moreover, matching is the wildly more frequently used operation in the case of
244 indexed synonyms and we don't want to slow that down by needless unification.
247 lookupFamInstEnvUnify :: (FamInstEnv, FamInstEnv) -> TyCon -> [Type]
248 -> [(TvSubst, FamInst)]
249 lookupFamInstEnvUnify (pkg_ie, home_ie) fam tys
250 = home_matches ++ pkg_matches
252 rough_tcs = roughMatchTcs tys
253 all_tvs = all isNothing rough_tcs
254 home_matches = lookup home_ie
255 pkg_matches = lookup pkg_ie
258 lookup env = case lookupUFM env fam of
259 Nothing -> [] -- No instances for this class
260 Just (FamIE insts has_tv_insts)
261 -- Short cut for common case:
262 -- The thing we are looking up is of form (C a
263 -- b c), and the FamIE has no instances of
264 -- that form, so don't bother to search
265 | all_tvs && not has_tv_insts -> []
266 | otherwise -> find insts
270 find (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs,
271 fi_tys = tpl_tys, fi_tycon = tycon }) : rest)
272 -- Fast check for no match, uses the "rough match" fields
273 | instanceCantMatch rough_tcs mb_tcs
277 = ASSERT2( tyVarsOfTypes tys `disjointVarSet` tpl_tvs,
278 (ppr fam <+> ppr tys <+> ppr all_tvs) $$
279 (ppr tycon <+> ppr tpl_tvs <+> ppr tpl_tys)
281 -- Unification will break badly if the variables overlap
282 -- They shouldn't because we allocate separate uniques for them
283 case tcUnifyTys bind_fn tpl_tys tys of
284 Just subst -> (subst, item) : find rest
287 -- See explanation at @InstEnv.bind_fn@.
289 bind_fn tv | isTcTyVar tv && isExistentialTyVar tv = Skolem