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 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 @lookupFamInstEnv@ looks up in a @FamInstEnv@, using a one-way match.
186 Multiple matches are only possible in case of type families (not data
187 families), and then, it doesn't matter which match we choose (as the
188 instances are guaranteed confluent).
191 lookupFamInstEnv :: (FamInstEnv -- External package inst-env
192 ,FamInstEnv) -- Home-package inst-env
193 -> TyCon -> [Type] -- What we are looking for
194 -> [(TvSubst, FamInst)] -- Successful matches
195 lookupFamInstEnv (pkg_ie, home_ie) fam tys
196 = home_matches ++ pkg_matches
198 rough_tcs = roughMatchTcs tys
199 all_tvs = all isNothing rough_tcs
200 home_matches = lookup home_ie
201 pkg_matches = lookup pkg_ie
204 lookup env = case lookupUFM env fam of
205 Nothing -> [] -- No instances for this class
206 Just (FamIE insts has_tv_insts)
207 -- Short cut for common case:
208 -- The thing we are looking up is of form (C a
209 -- b c), and the FamIE has no instances of
210 -- that form, so don't bother to search
211 | all_tvs && not has_tv_insts -> []
212 | otherwise -> find insts
216 find (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs,
217 fi_tys = tpl_tys, fi_tycon = tycon }) : rest)
218 -- Fast check for no match, uses the "rough match" fields
219 | instanceCantMatch rough_tcs mb_tcs
223 | Just subst <- tcMatchTys tpl_tvs tpl_tys tys
224 = (subst, item) : find rest
226 -- No match => try next
231 While @lookupFamInstEnv@ uses a one-way match, the next function
232 @lookupFamInstEnvUnify@ uses two-way matching (ie, unification). This is
233 needed to check for overlapping instances.
235 For class instances, these two variants of lookup are combined into one
236 function (cf, @InstEnv@). We don't do that for family instances as the
237 results of matching and unification are used in two different contexts.
238 Moreover, matching is the wildly more frequently used operation in the case of
239 indexed synonyms and we don't want to slow that down by needless unification.
242 lookupFamInstEnvUnify :: (FamInstEnv, FamInstEnv) -> TyCon -> [Type]
243 -> [(TvSubst, FamInst)]
244 lookupFamInstEnvUnify (pkg_ie, home_ie) fam tys
245 = home_matches ++ pkg_matches
247 rough_tcs = roughMatchTcs tys
248 all_tvs = all isNothing rough_tcs
249 home_matches = lookup home_ie
250 pkg_matches = lookup pkg_ie
253 lookup env = case lookupUFM env fam of
254 Nothing -> [] -- No instances for this class
255 Just (FamIE insts has_tv_insts)
256 -- Short cut for common case:
257 -- The thing we are looking up is of form (C a
258 -- b c), and the FamIE has no instances of
259 -- that form, so don't bother to search
260 | all_tvs && not has_tv_insts -> []
261 | otherwise -> find insts
265 find (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs,
266 fi_tys = tpl_tys, fi_tycon = tycon }) : rest)
267 -- Fast check for no match, uses the "rough match" fields
268 | instanceCantMatch rough_tcs mb_tcs
272 = ASSERT2( tyVarsOfTypes tys `disjointVarSet` tpl_tvs,
273 (ppr fam <+> ppr tys <+> ppr all_tvs) $$
274 (ppr tycon <+> ppr tpl_tvs <+> ppr tpl_tys)
276 -- Unification will break badly if the variables overlap
277 -- They shouldn't because we allocate separate uniques for them
278 case tcUnifyTys bind_fn tpl_tys tys of
279 Just subst -> (subst, item) : find rest
282 -- See explanation at @InstEnv.bind_fn@.
284 bind_fn tv | isTcTyVar tv && isExistentialTyVar tv = Skolem