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
49 -- INVARIANT: fi_fam = case tyConFamInst_maybe fi_tycon of
50 -- Just (tc, tys) -> tc
52 -- Used for "rough matching"; same idea as for class instances
53 , fi_tcs :: [Maybe Name] -- Top of type args
54 -- INVARIANT: fi_tcs = roughMatchTcs fi_tys
56 -- Used for "proper matching"; ditto
57 , fi_tvs :: TyVarSet -- Template tyvars for full match
58 , fi_tys :: [Type] -- Full arg types
59 -- INVARIANT: fi_tvs = tyConTyVars fi_tycon
60 -- fi_tys = case tyConFamInst_maybe fi_tycon of
61 -- Just (_, tys) -> tys
63 , fi_tycon :: TyCon -- Representation tycon
66 -- Obtain the representation tycon of a family instance.
68 famInstTyCon :: FamInst -> TyCon
69 famInstTyCon = fi_tycon
71 famInstTyVars = fi_tvs
75 instance NamedThing FamInst where
76 getName = getName . fi_tycon
78 instance Outputable FamInst where
81 -- Prints the FamInst as a family instance declaration
82 pprFamInst :: FamInst -> SDoc
84 = hang (pprFamInstHdr famInst)
85 2 (ptext SLIT("--") <+> (pprDefnLoc (getSrcSpan famInst)))
87 pprFamInstHdr :: FamInst -> SDoc
88 pprFamInstHdr (FamInst {fi_fam = fam, fi_tys = tys, fi_tycon = tycon})
89 = pprTyConSort <+> pprHead
91 pprHead = pprTypeApp (parenSymOcc (getOccName fam) (ppr fam)) tys
92 pprTyConSort | isDataTyCon tycon = ptext SLIT("data instance")
93 | isNewTyCon tycon = ptext SLIT("newtype instance")
94 | isSynTyCon tycon = ptext SLIT("type instance")
95 | otherwise = panic "FamInstEnv.pprFamInstHdr"
97 pprFamInsts :: [FamInst] -> SDoc
98 pprFamInsts finsts = vcat (map pprFamInst finsts)
100 famInstHead :: FamInst -> ([TyVar], TyCon, [Type])
101 famInstHead (FamInst {fi_tycon = tycon})
102 = case tyConFamInst_maybe tycon of
103 Nothing -> panic "FamInstEnv.famInstHead"
104 Just (fam, tys) -> (tyConTyVars tycon, fam, tys)
106 -- Make a family instance representation from a tycon. This is used for local
107 -- instances, where we can safely pull on the tycon.
109 mkLocalFamInst :: TyCon -> FamInst
111 = case tyConFamInst_maybe tycon of
112 Nothing -> panic "FamInstEnv.mkLocalFamInst"
115 fi_fam = tyConName fam,
116 fi_tcs = roughMatchTcs tys,
117 fi_tvs = mkVarSet . tyConTyVars $ tycon,
122 -- Make a family instance representation from the information found in an
123 -- unterface file. In particular, we get the rough match info from the iface
124 -- (instead of computing it here).
126 mkImportedFamInst :: Name -> [Maybe Name] -> TyCon -> FamInst
127 mkImportedFamInst fam mb_tcs tycon
131 fi_tvs = mkVarSet . tyConTyVars $ tycon,
132 fi_tys = case tyConFamInst_maybe tycon of
133 Nothing -> panic "FamInstEnv.mkImportedFamInst"
134 Just (_, tys) -> tys,
140 %************************************************************************
144 %************************************************************************
146 InstEnv maps a family name to the list of known instances for that family.
149 type FamInstEnv = UniqFM FamilyInstEnv -- Maps a family to its instances
151 type FamInstEnvs = (FamInstEnv, FamInstEnv)
152 -- External package inst-env, Home-package inst-env
155 = FamIE [FamInst] -- The instances for a particular family, in any order
156 Bool -- True <=> there is an instance of form T a b c
157 -- If *not* then the common case of looking up
158 -- (T a b c) can fail immediately
161 -- * The fs_tvs are distinct in each FamInst
162 -- of a range value of the map (so we can safely unify them)
164 emptyFamInstEnv :: FamInstEnv
165 emptyFamInstEnv = emptyUFM
167 famInstEnvElts :: FamInstEnv -> [FamInst]
168 famInstEnvElts fi = [elt | FamIE elts _ <- eltsUFM fi, elt <- elts]
170 familyInstances :: (FamInstEnv, FamInstEnv) -> TyCon -> [FamInst]
171 familyInstances (pkg_fie, home_fie) fam
172 = get home_fie ++ get pkg_fie
174 get env = case lookupUFM env fam of
175 Just (FamIE insts _) -> insts
178 extendFamInstEnvList :: FamInstEnv -> [FamInst] -> FamInstEnv
179 extendFamInstEnvList inst_env fis = foldl extendFamInstEnv inst_env fis
181 extendFamInstEnv :: FamInstEnv -> FamInst -> FamInstEnv
182 extendFamInstEnv inst_env ins_item@(FamInst {fi_fam = cls_nm, fi_tcs = mb_tcs})
183 = addToUFM_C add inst_env cls_nm (FamIE [ins_item] ins_tyvar)
185 add (FamIE items tyvar) _ = FamIE (ins_item:items)
187 ins_tyvar = not (any isJust mb_tcs)
190 %************************************************************************
192 \subsection{Looking up a family instance}
194 %************************************************************************
196 @lookupFamInstEnv@ looks up in a @FamInstEnv@, using a one-way match.
197 Multiple matches are only possible in case of type families (not data
198 families), and then, it doesn't matter which match we choose (as the
199 instances are guaranteed confluent).
201 We return the matching family instances and the type instance at which it
202 matches. For example, if we lookup 'T [Int]' and have a family instance
204 data instance T [a] = ..
209 coe :Co:R42T a :: T [a] ~ :R42T a
211 we return the matching instance '(FamInst{.., fi_tycon = :R42T}, Int)'.
214 type FamInstMatch = (FamInst, [Type]) -- Matching type instance
216 lookupFamInstEnv :: FamInstEnvs
217 -> TyCon -> [Type] -- What we are looking for
218 -> [FamInstMatch] -- Successful matches
219 lookupFamInstEnv (pkg_ie, home_ie) fam tys
220 = home_matches ++ pkg_matches
222 rough_tcs = roughMatchTcs tys
223 all_tvs = all isNothing rough_tcs
224 home_matches = lookup home_ie
225 pkg_matches = lookup pkg_ie
228 lookup env = case lookupUFM env fam of
229 Nothing -> [] -- No instances for this class
230 Just (FamIE insts has_tv_insts)
231 -- Short cut for common case:
232 -- The thing we are looking up is of form (C a
233 -- b c), and the FamIE has no instances of
234 -- that form, so don't bother to search
235 | all_tvs && not has_tv_insts -> []
236 | otherwise -> find insts
240 find (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs,
241 fi_tys = tpl_tys, fi_tycon = tycon }) : rest)
242 -- Fast check for no match, uses the "rough match" fields
243 | instanceCantMatch rough_tcs mb_tcs
247 | Just subst <- tcMatchTys tpl_tvs tpl_tys tys
248 = (item, substTyVars subst (tyConTyVars tycon)) : find rest
250 -- No match => try next
255 While @lookupFamInstEnv@ uses a one-way match, the next function
256 @lookupFamInstEnvUnify@ uses two-way matching (ie, unification). This is
257 needed to check for overlapping instances.
259 For class instances, these two variants of lookup are combined into one
260 function (cf, @InstEnv@). We don't do that for family instances as the
261 results of matching and unification are used in two different contexts.
262 Moreover, matching is the wildly more frequently used operation in the case of
263 indexed synonyms and we don't want to slow that down by needless unification.
266 lookupFamInstEnvUnify :: (FamInstEnv, FamInstEnv) -> TyCon -> [Type]
268 lookupFamInstEnvUnify (pkg_ie, home_ie) fam tys
269 = home_matches ++ pkg_matches
271 rough_tcs = roughMatchTcs tys
272 all_tvs = all isNothing rough_tcs
273 home_matches = lookup home_ie
274 pkg_matches = lookup pkg_ie
277 lookup env = case lookupUFM env fam of
278 Nothing -> [] -- No instances for this class
279 Just (FamIE insts has_tv_insts)
280 -- Short cut for common case:
281 -- The thing we are looking up is of form (C a
282 -- b c), and the FamIE has no instances of
283 -- that form, so don't bother to search
284 | all_tvs && not has_tv_insts -> []
285 | otherwise -> find insts
289 find (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs,
290 fi_tys = tpl_tys, fi_tycon = tycon }) : rest)
291 -- Fast check for no match, uses the "rough match" fields
292 | instanceCantMatch rough_tcs mb_tcs
296 = ASSERT2( tyVarsOfTypes tys `disjointVarSet` tpl_tvs,
297 (ppr fam <+> ppr tys <+> ppr all_tvs) $$
298 (ppr tycon <+> ppr tpl_tvs <+> ppr tpl_tys)
300 -- Unification will break badly if the variables overlap
301 -- They shouldn't because we allocate separate uniques for them
302 case tcUnifyTys bind_fn tpl_tys tys of
303 Just subst -> let rep_tys = substTyVars subst (tyConTyVars tycon)
305 (item, rep_tys) : find rest
308 -- See explanation at @InstEnv.bind_fn@.
310 bind_fn tv | isTcTyVar tv && isExistentialTyVar tv = Skolem