1 \section[FamInstEnv]{Type checked family instance declarations}
5 FamInst(..), famInstTyCon, pprFamInst, pprFamInstHdr, pprFamInsts,
6 famInstHead, mkLocalFamInst, mkImportedFamInst,
8 FamInstEnv, emptyFamInstEnv, extendFamInstEnv, extendFamInstEnvList,
9 famInstEnvElts, familyInstances,
13 #include "HsVersions.h"
15 import InstEnv ( roughMatchTcs, instanceCantMatch )
16 import Unify ( tcMatchTys )
17 import TcType ( Type )
18 import Type ( TvSubst, TyThing (ATyCon), pprParendType )
19 import TyCon ( TyCon, isDataTyCon, isNewTyCon, isSynTyCon,
20 tyConName, tyConTyVars, tyConFamInst_maybe )
21 import VarSet ( TyVarSet, mkVarSet )
23 import Name ( Name, getOccName, NamedThing(..), getSrcLoc )
24 import OccName ( parenSymOcc )
25 import SrcLoc ( pprDefnLoc )
26 import UniqFM ( UniqFM, lookupUFM, emptyUFM, addToUFM_C, eltsUFM )
29 import Maybe ( isJust, isNothing )
30 import Monad ( mzero )
34 %************************************************************************
36 \subsection{Type checked family instance heads}
38 %************************************************************************
42 = FamInst { fi_fam :: Name -- Family name
44 -- Used for "rough matching"; same idea as for class instances
45 , fi_tcs :: [Maybe Name] -- Top of type args
47 -- Used for "proper matching"; ditto
48 , fi_tvs :: TyVarSet -- Template tyvars for full match
49 , fi_tys :: [Type] -- Full arg types
51 , fi_tycon :: TyCon -- Representation tycon
54 -- Obtain the representation tycon of a family instance.
56 famInstTyCon :: FamInst -> TyCon
57 famInstTyCon = fi_tycon
61 instance NamedThing FamInst where
62 getName = getName . fi_tycon
64 instance Outputable FamInst where
67 -- Prints the FamInst as a family instance declaration
68 pprFamInst :: FamInst -> SDoc
70 = hang (pprFamInstHdr famInst)
71 2 (ptext SLIT("--") <+> (pprDefnLoc (getSrcLoc famInst)))
73 pprFamInstHdr :: FamInst -> SDoc
74 pprFamInstHdr (FamInst {fi_fam = fam, fi_tys = tys, fi_tycon = tycon})
75 = pprTyConSort <+> pprHead
77 pprHead = parenSymOcc (getOccName fam) (ppr fam) <+>
78 sep (map pprParendType tys)
79 pprTyConSort | isDataTyCon tycon = ptext SLIT("data instance")
80 | isNewTyCon tycon = ptext SLIT("newtype instance")
81 | isSynTyCon tycon = ptext SLIT("type instance")
82 | otherwise = panic "FamInstEnv.pprFamInstHdr"
84 pprFamInsts :: [FamInst] -> SDoc
85 pprFamInsts finsts = vcat (map pprFamInst finsts)
87 famInstHead :: FamInst -> ([TyVar], TyCon, [Type])
88 famInstHead (FamInst {fi_tycon = tycon})
89 = case tyConFamInst_maybe tycon of
90 Nothing -> panic "FamInstEnv.famInstHead"
91 Just (fam, tys) -> (tyConTyVars tycon, fam, tys)
93 -- Make a family instance representation from a tycon. This is used for local
94 -- instances, where we can safely pull on the tycon.
96 mkLocalFamInst :: TyCon -> FamInst
98 = case tyConFamInst_maybe tycon of
99 Nothing -> panic "FamInstEnv.mkLocalFamInst"
102 fi_fam = tyConName fam,
103 fi_tcs = roughMatchTcs tys,
104 fi_tvs = mkVarSet . tyConTyVars $ tycon,
109 -- Make a family instance representation from the information found in an
110 -- unterface file. In particular, we get the rough match info from the iface
111 -- (instead of computing it here).
113 mkImportedFamInst :: Name -> [Maybe Name] -> TyCon -> FamInst
114 mkImportedFamInst fam mb_tcs tycon
118 fi_tvs = mkVarSet . tyConTyVars $ tycon,
119 fi_tys = case tyConFamInst_maybe tycon of
120 Nothing -> panic "FamInstEnv.mkImportedFamInst"
121 Just (_, tys) -> tys,
127 %************************************************************************
131 %************************************************************************
133 InstEnv maps a family name to the list of known instances for that family.
136 type FamInstEnv = UniqFM FamilyInstEnv -- Maps a family to its instances
139 = FamIE [FamInst] -- The instances for a particular family, in any order
140 Bool -- True <=> there is an instance of form T a b c
141 -- If *not* then the common case of looking up
142 -- (T a b c) can fail immediately
145 -- * The fs_tvs are distinct in each FamInst
146 -- of a range value of the map (so we can safely unify them)
148 emptyFamInstEnv :: FamInstEnv
149 emptyFamInstEnv = emptyUFM
151 famInstEnvElts :: FamInstEnv -> [FamInst]
152 famInstEnvElts fi = [elt | FamIE elts _ <- eltsUFM fi, elt <- elts]
154 familyInstances :: (FamInstEnv, FamInstEnv) -> TyCon -> [FamInst]
155 familyInstances (pkg_fie, home_fie) fam
156 = get home_fie ++ get pkg_fie
158 get env = case lookupUFM env fam of
159 Just (FamIE insts _) -> insts
162 extendFamInstEnvList :: FamInstEnv -> [FamInst] -> FamInstEnv
163 extendFamInstEnvList inst_env fis = foldl extendFamInstEnv inst_env fis
165 extendFamInstEnv :: FamInstEnv -> FamInst -> FamInstEnv
166 extendFamInstEnv inst_env ins_item@(FamInst {fi_fam = cls_nm, fi_tcs = mb_tcs})
167 = addToUFM_C add inst_env cls_nm (FamIE [ins_item] ins_tyvar)
169 add (FamIE items tyvar) _ = FamIE (ins_item:items)
171 ins_tyvar = not (any isJust mb_tcs)
174 %************************************************************************
176 \subsection{Looking up a family instance}
178 %************************************************************************
180 @lookupFamInstEnv@ looks up in a @FamInstEnv@, using a one-way match.
181 Multiple matches are only possible in case of type families (not data
182 families), and then, it doesn't matter which match we choose (as the
183 instances are guaranteed confluent).
186 lookupFamInstEnv :: (FamInstEnv -- External package inst-env
187 ,FamInstEnv) -- Home-package inst-env
188 -> TyCon -> [Type] -- What we are looking for
189 -> [(TvSubst, FamInst)] -- Successful matches
190 lookupFamInstEnv (pkg_ie, home_ie) fam tys
191 = home_matches ++ pkg_matches
193 rough_tcs = roughMatchTcs tys
194 all_tvs = all isNothing rough_tcs
195 home_matches = lookup home_ie
196 pkg_matches = lookup pkg_ie
199 lookup env = case lookupUFM env fam of
200 Nothing -> [] -- No instances for this class
201 Just (FamIE insts has_tv_insts)
202 -- Short cut for common case:
203 -- The thing we are looking up is of form (C a
204 -- b c), and the FamIE has no instances of
205 -- that form, so don't bother to search
206 | all_tvs && not has_tv_insts -> []
207 | otherwise -> find insts
210 find (item@(FamInst { fi_tcs = mb_tcs, fi_tvs = tpl_tvs,
211 fi_tys = tpl_tys, fi_tycon = tycon }) : rest)
212 -- Fast check for no match, uses the "rough match" fields
213 | instanceCantMatch rough_tcs mb_tcs
217 | Just subst <- tcMatchTys tpl_tvs tpl_tys tys
218 = (subst, item) : find rest
220 -- No match => try next