2 % (c) The University of Glasgow 2006
5 FamInstEnv: Type checked family instance declarations
9 FamInst(..), famInstTyCon, pprFamInst, pprFamInstHdr, pprFamInsts,
10 famInstHead, mkLocalFamInst, mkImportedFamInst,
12 FamInstEnv, emptyFamInstEnv, extendFamInstEnv, extendFamInstEnvList,
13 famInstEnvElts, familyInstances,
15 lookupFamInstEnvExact, lookupFamInstEnv, lookupFamInstEnvUnify
18 #include "HsVersions.h"
39 %************************************************************************
41 \subsection{Type checked family instance heads}
43 %************************************************************************
47 = FamInst { fi_fam :: Name -- Family name
49 -- Used for "rough matching"; same idea as for class instances
50 , fi_tcs :: [Maybe Name] -- Top of type args
52 -- Used for "proper matching"; ditto
53 , fi_tvs :: TyVarSet -- Template tyvars for full match
54 , fi_tys :: [Type] -- Full arg types
56 , fi_tycon :: TyCon -- Representation tycon
59 -- Obtain the representation tycon of a family instance.
61 famInstTyCon :: FamInst -> TyCon
62 famInstTyCon = fi_tycon
66 instance NamedThing FamInst where
67 getName = getName . fi_tycon
69 instance Outputable FamInst where
72 -- Prints the FamInst as a family instance declaration
73 pprFamInst :: FamInst -> SDoc
75 = hang (pprFamInstHdr famInst)
76 2 (ptext SLIT("--") <+> (pprDefnLoc (getSrcLoc famInst)))
78 pprFamInstHdr :: FamInst -> SDoc
79 pprFamInstHdr (FamInst {fi_fam = fam, fi_tys = tys, fi_tycon = tycon})
80 = pprTyConSort <+> pprHead
82 pprHead = parenSymOcc (getOccName fam) (ppr fam) <+>
83 sep (map pprParendType tys)
84 pprTyConSort | isDataTyCon tycon = ptext SLIT("data instance")
85 | isNewTyCon tycon = ptext SLIT("newtype instance")
86 | isSynTyCon tycon = ptext SLIT("type instance")
87 | otherwise = panic "FamInstEnv.pprFamInstHdr"
89 pprFamInsts :: [FamInst] -> SDoc
90 pprFamInsts finsts = vcat (map pprFamInst finsts)
92 famInstHead :: FamInst -> ([TyVar], TyCon, [Type])
93 famInstHead (FamInst {fi_tycon = tycon})
94 = case tyConFamInst_maybe tycon of
95 Nothing -> panic "FamInstEnv.famInstHead"
96 Just (fam, tys) -> (tyConTyVars tycon, fam, tys)
98 -- Make a family instance representation from a tycon. This is used for local
99 -- instances, where we can safely pull on the tycon.
101 mkLocalFamInst :: TyCon -> FamInst
103 = case tyConFamInst_maybe tycon of
104 Nothing -> panic "FamInstEnv.mkLocalFamInst"
107 fi_fam = tyConName fam,
108 fi_tcs = roughMatchTcs tys,
109 fi_tvs = mkVarSet . tyConTyVars $ tycon,
114 -- Make a family instance representation from the information found in an
115 -- unterface file. In particular, we get the rough match info from the iface
116 -- (instead of computing it here).
118 mkImportedFamInst :: Name -> [Maybe Name] -> TyCon -> FamInst
119 mkImportedFamInst fam mb_tcs tycon
123 fi_tvs = mkVarSet . tyConTyVars $ tycon,
124 fi_tys = case tyConFamInst_maybe tycon of
125 Nothing -> panic "FamInstEnv.mkImportedFamInst"
126 Just (_, tys) -> tys,
132 %************************************************************************
136 %************************************************************************
138 InstEnv maps a family name to the list of known instances for that family.
141 type FamInstEnv = UniqFM FamilyInstEnv -- Maps a family to its instances
144 = FamIE [FamInst] -- The instances for a particular family, in any order
145 Bool -- True <=> there is an instance of form T a b c
146 -- If *not* then the common case of looking up
147 -- (T a b c) can fail immediately
150 -- * The fs_tvs are distinct in each FamInst
151 -- of a range value of the map (so we can safely unify them)
153 emptyFamInstEnv :: FamInstEnv
154 emptyFamInstEnv = emptyUFM
156 famInstEnvElts :: FamInstEnv -> [FamInst]
157 famInstEnvElts fi = [elt | FamIE elts _ <- eltsUFM fi, elt <- elts]
159 familyInstances :: (FamInstEnv, FamInstEnv) -> TyCon -> [FamInst]
160 familyInstances (pkg_fie, home_fie) fam
161 = get home_fie ++ get pkg_fie
163 get env = case lookupUFM env fam of
164 Just (FamIE insts _) -> insts
167 extendFamInstEnvList :: FamInstEnv -> [FamInst] -> FamInstEnv
168 extendFamInstEnvList inst_env fis = foldl extendFamInstEnv inst_env fis
170 extendFamInstEnv :: FamInstEnv -> FamInst -> FamInstEnv
171 extendFamInstEnv inst_env ins_item@(FamInst {fi_fam = cls_nm, fi_tcs = mb_tcs})
172 = addToUFM_C add inst_env cls_nm (FamIE [ins_item] ins_tyvar)
174 add (FamIE items tyvar) _ = FamIE (ins_item:items)
176 ins_tyvar = not (any isJust mb_tcs)
179 %************************************************************************
181 \subsection{Looking up a family instance}
183 %************************************************************************
185 @lookupFamInstEnvExact@ looks up in a @FamInstEnv@ using an exact match.
186 This is used when we want the @TyCon@ of a particular family instance (e.g.,
187 during deriving classes).
190 lookupFamInstEnvExact :: (FamInstEnv -- External package inst-env
191 ,FamInstEnv) -- Home-package inst-env
192 -> TyCon -> [Type] -- What we are looking for
194 lookupFamInstEnvExact (pkg_ie, home_ie) fam tys
195 = home_matches `mplus` pkg_matches
197 rough_tcs = roughMatchTcs tys
198 all_tvs = all isNothing rough_tcs
199 home_matches = lookup home_ie
200 pkg_matches = lookup pkg_ie
203 lookup env = case lookupUFM env fam of
204 Nothing -> Nothing -- No instances for this class
205 Just (FamIE insts has_tv_insts)
206 -- Short cut for common case:
207 -- The thing we are looking up is of form (C a
208 -- b c), and the FamIE has no instances of
209 -- that form, so don't bother to search
210 | all_tvs && not has_tv_insts -> Nothing
211 | otherwise -> find insts
215 find (item@(FamInst { fi_tcs = mb_tcs, fi_tys = tpl_tys }) : rest)
216 -- Fast check for no match, uses the "rough match" fields
217 | instanceCantMatch rough_tcs mb_tcs
221 | tcEqTypes tpl_tys tys
224 -- No match => try next
229 @lookupFamInstEnv@ looks up in a @FamInstEnv@, using a one-way match.
230 Multiple matches are only possible in case of type families (not data
231 families), and then, it doesn't matter which match we choose (as the
232 instances are guaranteed confluent).
235 lookupFamInstEnv :: (FamInstEnv -- External package inst-env
236 ,FamInstEnv) -- Home-package inst-env
237 -> TyCon -> [Type] -- What we are looking for
238 -> [(TvSubst, FamInst)] -- Successful matches
239 lookupFamInstEnv (pkg_ie, home_ie) fam tys
240 = home_matches ++ pkg_matches
242 rough_tcs = roughMatchTcs tys
243 all_tvs = all isNothing rough_tcs
244 home_matches = lookup home_ie
245 pkg_matches = lookup pkg_ie
248 lookup env = case lookupUFM env fam of
249 Nothing -> [] -- No instances for this class
250 Just (FamIE insts has_tv_insts)
251 -- Short cut for common case:
252 -- The thing we are looking up is of form (C a
253 -- b c), and the FamIE has no instances of
254 -- that form, so don't bother to search
255 | all_tvs && not has_tv_insts -> []
256 | otherwise -> find insts
260 find (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs,
261 fi_tys = tpl_tys, fi_tycon = tycon }) : rest)
262 -- Fast check for no match, uses the "rough match" fields
263 | instanceCantMatch rough_tcs mb_tcs
267 | Just subst <- tcMatchTys tpl_tvs tpl_tys tys
268 = (subst, item) : find rest
270 -- No match => try next
275 While @lookupFamInstEnv@ uses a one-way match, the next function
276 @lookupFamInstEnvUnify@ uses two-way matching (ie, unification). This is
277 needed to check for overlapping instances.
279 For class instances, these two variants of lookup are combined into one
280 function (cf, @InstEnv@). We don't do that for family instances as the
281 results of matching and unification are used in two different contexts.
282 Moreover, matching is the wildly more frequently used operation in the case of
283 indexed synonyms and we don't want to slow that down by needless unification.
286 lookupFamInstEnvUnify :: (FamInstEnv, FamInstEnv) -> TyCon -> [Type]
287 -> [(TvSubst, FamInst)]
288 lookupFamInstEnvUnify (pkg_ie, home_ie) fam tys
289 = home_matches ++ pkg_matches
291 rough_tcs = roughMatchTcs tys
292 all_tvs = all isNothing rough_tcs
293 home_matches = lookup home_ie
294 pkg_matches = lookup pkg_ie
297 lookup env = case lookupUFM env fam of
298 Nothing -> [] -- No instances for this class
299 Just (FamIE insts has_tv_insts)
300 -- Short cut for common case:
301 -- The thing we are looking up is of form (C a
302 -- b c), and the FamIE has no instances of
303 -- that form, so don't bother to search
304 | all_tvs && not has_tv_insts -> []
305 | otherwise -> find insts
309 find (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs,
310 fi_tys = tpl_tys, fi_tycon = tycon }) : rest)
311 -- Fast check for no match, uses the "rough match" fields
312 | instanceCantMatch rough_tcs mb_tcs
316 = ASSERT2( tyVarsOfTypes tys `disjointVarSet` tpl_tvs,
317 (ppr fam <+> ppr tys <+> ppr all_tvs) $$
318 (ppr tycon <+> ppr tpl_tvs <+> ppr tpl_tys)
320 -- Unification will break badly if the variables overlap
321 -- They shouldn't because we allocate separate uniques for them
322 case tcUnifyTys bind_fn tpl_tys tys of
323 Just subst -> (subst, item) : find rest
326 -- See explanation at @InstEnv.bind_fn@.
328 bind_fn tv | isTcTyVar tv && isExistentialTyVar tv = Skolem