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,
17 #include "HsVersions.h"
37 %************************************************************************
39 \subsection{Type checked family instance heads}
41 %************************************************************************
45 = FamInst { fi_fam :: Name -- Family name
47 -- Used for "rough matching"; same idea as for class instances
48 , fi_tcs :: [Maybe Name] -- Top of type args
50 -- Used for "proper matching"; ditto
51 , fi_tvs :: TyVarSet -- Template tyvars for full match
52 , fi_tys :: [Type] -- Full arg types
54 , fi_tycon :: TyCon -- Representation tycon
57 -- Obtain the representation tycon of a family instance.
59 famInstTyCon :: FamInst -> TyCon
60 famInstTyCon = fi_tycon
64 instance NamedThing FamInst where
65 getName = getName . fi_tycon
67 instance Outputable FamInst where
70 -- Prints the FamInst as a family instance declaration
71 pprFamInst :: FamInst -> SDoc
73 = hang (pprFamInstHdr famInst)
74 2 (ptext SLIT("--") <+> (pprDefnLoc (getSrcLoc famInst)))
76 pprFamInstHdr :: FamInst -> SDoc
77 pprFamInstHdr (FamInst {fi_fam = fam, fi_tys = tys, fi_tycon = tycon})
78 = pprTyConSort <+> pprHead
80 pprHead = parenSymOcc (getOccName fam) (ppr fam) <+>
81 sep (map pprParendType tys)
82 pprTyConSort | isDataTyCon tycon = ptext SLIT("data instance")
83 | isNewTyCon tycon = ptext SLIT("newtype instance")
84 | isSynTyCon tycon = ptext SLIT("type instance")
85 | otherwise = panic "FamInstEnv.pprFamInstHdr"
87 pprFamInsts :: [FamInst] -> SDoc
88 pprFamInsts finsts = vcat (map pprFamInst finsts)
90 famInstHead :: FamInst -> ([TyVar], TyCon, [Type])
91 famInstHead (FamInst {fi_tycon = tycon})
92 = case tyConFamInst_maybe tycon of
93 Nothing -> panic "FamInstEnv.famInstHead"
94 Just (fam, tys) -> (tyConTyVars tycon, fam, tys)
96 -- Make a family instance representation from a tycon. This is used for local
97 -- instances, where we can safely pull on the tycon.
99 mkLocalFamInst :: TyCon -> FamInst
101 = case tyConFamInst_maybe tycon of
102 Nothing -> panic "FamInstEnv.mkLocalFamInst"
105 fi_fam = tyConName fam,
106 fi_tcs = roughMatchTcs tys,
107 fi_tvs = mkVarSet . tyConTyVars $ tycon,
112 -- Make a family instance representation from the information found in an
113 -- unterface file. In particular, we get the rough match info from the iface
114 -- (instead of computing it here).
116 mkImportedFamInst :: Name -> [Maybe Name] -> TyCon -> FamInst
117 mkImportedFamInst fam mb_tcs tycon
121 fi_tvs = mkVarSet . tyConTyVars $ tycon,
122 fi_tys = case tyConFamInst_maybe tycon of
123 Nothing -> panic "FamInstEnv.mkImportedFamInst"
124 Just (_, tys) -> tys,
130 %************************************************************************
134 %************************************************************************
136 InstEnv maps a family name to the list of known instances for that family.
139 type FamInstEnv = UniqFM FamilyInstEnv -- Maps a family to its instances
142 = FamIE [FamInst] -- The instances for a particular family, in any order
143 Bool -- True <=> there is an instance of form T a b c
144 -- If *not* then the common case of looking up
145 -- (T a b c) can fail immediately
148 -- * The fs_tvs are distinct in each FamInst
149 -- of a range value of the map (so we can safely unify them)
151 emptyFamInstEnv :: FamInstEnv
152 emptyFamInstEnv = emptyUFM
154 famInstEnvElts :: FamInstEnv -> [FamInst]
155 famInstEnvElts fi = [elt | FamIE elts _ <- eltsUFM fi, elt <- elts]
157 familyInstances :: (FamInstEnv, FamInstEnv) -> TyCon -> [FamInst]
158 familyInstances (pkg_fie, home_fie) fam
159 = get home_fie ++ get pkg_fie
161 get env = case lookupUFM env fam of
162 Just (FamIE insts _) -> insts
165 extendFamInstEnvList :: FamInstEnv -> [FamInst] -> FamInstEnv
166 extendFamInstEnvList inst_env fis = foldl extendFamInstEnv inst_env fis
168 extendFamInstEnv :: FamInstEnv -> FamInst -> FamInstEnv
169 extendFamInstEnv inst_env ins_item@(FamInst {fi_fam = cls_nm, fi_tcs = mb_tcs})
170 = addToUFM_C add inst_env cls_nm (FamIE [ins_item] ins_tyvar)
172 add (FamIE items tyvar) _ = FamIE (ins_item:items)
174 ins_tyvar = not (any isJust mb_tcs)
177 %************************************************************************
179 \subsection{Looking up a family instance}
181 %************************************************************************
183 @lookupFamInstEnv@ looks up in a @FamInstEnv@, using a one-way match.
184 Multiple matches are only possible in case of type families (not data
185 families), and then, it doesn't matter which match we choose (as the
186 instances are guaranteed confluent).
189 lookupFamInstEnv :: (FamInstEnv -- External package inst-env
190 ,FamInstEnv) -- Home-package inst-env
191 -> TyCon -> [Type] -- What we are looking for
192 -> [(TvSubst, FamInst)] -- Successful matches
193 lookupFamInstEnv (pkg_ie, home_ie) fam tys
194 = home_matches ++ pkg_matches
196 rough_tcs = roughMatchTcs tys
197 all_tvs = all isNothing rough_tcs
198 home_matches = lookup home_ie
199 pkg_matches = lookup pkg_ie
202 lookup env = case lookupUFM env fam of
203 Nothing -> [] -- No instances for this class
204 Just (FamIE insts has_tv_insts)
205 -- Short cut for common case:
206 -- The thing we are looking up is of form (C a
207 -- b c), and the FamIE has no instances of
208 -- that form, so don't bother to search
209 | all_tvs && not has_tv_insts -> []
210 | otherwise -> find insts
213 find (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs,
214 fi_tys = tpl_tys, fi_tycon = tycon }) : rest)
215 -- Fast check for no match, uses the "rough match" fields
216 | instanceCantMatch rough_tcs mb_tcs
220 | Just subst <- tcMatchTys tpl_tvs tpl_tys tys
221 = (subst, item) : find rest
223 -- No match => try next