1 \section[FamInst]{The @FamInst@ type: family instance heads}
5 tcExtendLocalFamInstEnv
8 #include "HsVersions.h"
10 import FamInstEnv ( FamInstEnv, FamInst(..), famInstTyCon, extendFamInstEnv,
11 pprFamInst, pprFamInsts )
12 import TcMType ( tcInstSkolType )
13 import TcType ( SkolemInfo(..), tcSplitTyConApp )
14 import TcRnMonad ( TcM, TcGblEnv(..), setGblEnv, getGblEnv, foldlM,
16 import TyCon ( tyConFamInst_maybe )
17 import Type ( mkTyConApp )
18 import Name ( getSrcLoc )
19 import SrcLoc ( mkSrcSpan )
24 %************************************************************************
26 Extending the family instance environment
28 %************************************************************************
32 -- Add new locally-defined family instances
33 tcExtendLocalFamInstEnv :: [FamInst] -> TcM a -> TcM a
34 tcExtendLocalFamInstEnv fam_insts thing_inside
35 = do { env <- getGblEnv
36 ; inst_env' <- foldlM addLocalFamInst (tcg_fam_inst_env env) fam_insts
37 ; let env' = env { tcg_fam_inst_env = inst_env' }
38 ; setGblEnv env' thing_inside }
41 -- Check that the proposed new instance is OK,
42 -- and then add it to the home inst env
43 addLocalFamInst :: FamInstEnv -> FamInst -> TcM FamInstEnv
44 addLocalFamInst home_fie famInst
45 = do { -- Instantiate the family instance type extend the instance
46 -- envt with completely fresh template variables
47 -- This is important because the template variables must
48 -- not overlap with anything in the things being looked up
49 -- (since we do unification).
50 -- We use tcInstSkolType because we don't want to allocate
51 -- fresh *meta* type variables.
52 let tycon = famInstTyCon famInst
53 ty = case tyConFamInst_maybe tycon of
54 Nothing -> panic "FamInst.addLocalFamInst"
55 Just (tc, tys) -> tc `mkTyConApp` tys
56 ; (tvs', theta', tau') <- tcInstSkolType (FamInstSkol tycon) ty
58 ; let (fam, tys') = tcSplitTyConApp tau'
60 {- !!!TODO: Need to complete this:
61 -- Load imported instances, so that we report
64 ; let inst_envs = (eps_fam_inst_env eps, home_fie)
66 -- Check for overlapping instance decls
67 ; let { (matches, _) = lookupFamInstEnv inst_envs fam tys'
68 ; dup_ispecs = [ dup_ispec --!!!adapt
69 | (_, dup_ispec) <- matches
70 , let (_,_,_,dup_tys) = instanceHead dup_ispec
71 , isJust (tcMatchTys (mkVarSet tvs') tys' dup_tys)] }
72 -- Find memebers of the match list which ispec itself matches.
73 -- If the match is 2-way, it's a duplicate
75 dup_ispec : _ -> dupInstErr famInst dup_ispec
79 -- OK, now extend the envt
80 ; return (extendFamInstEnv home_fie famInst) }
82 overlapErr famInst dupFamInst
83 = addFamInstLoc famInst $
84 addErr (hang (ptext SLIT("Overlapping family instance declarations:"))
85 2 (pprFamInsts [famInst, dupFamInst]))
87 addFamInstLoc famInst thing_inside
88 = setSrcSpan (mkSrcSpan loc loc) thing_inside
90 loc = getSrcLoc famInst