1 The @FamInst@ type: family instance heads
5 tcExtendLocalFamInstEnv
8 #include "HsVersions.h"
21 %************************************************************************
23 Extending the family instance environment
25 %************************************************************************
29 -- Add new locally-defined family instances
30 tcExtendLocalFamInstEnv :: [FamInst] -> TcM a -> TcM a
31 tcExtendLocalFamInstEnv fam_insts thing_inside
32 = do { env <- getGblEnv
33 ; inst_env' <- foldlM addLocalFamInst (tcg_fam_inst_env env) fam_insts
34 ; let env' = env { tcg_fam_insts = fam_insts ++ tcg_fam_insts env,
35 tcg_fam_inst_env = inst_env' }
36 ; setGblEnv env' thing_inside }
39 -- Check that the proposed new instance is OK,
40 -- and then add it to the home inst env
41 addLocalFamInst :: FamInstEnv -> FamInst -> TcM FamInstEnv
42 addLocalFamInst home_fie famInst
43 = do { -- To instantiate the family instance type, extend the instance
44 -- envt with completely fresh template variables
45 -- This is important because the template variables must
46 -- not overlap with anything in the things being looked up
47 -- (since we do unification).
48 -- We use tcInstSkolType because we don't want to allocate
49 -- fresh *meta* type variables.
50 let tycon = famInstTyCon famInst
51 ty = case tyConFamInst_maybe tycon of
52 Nothing -> panic "FamInst.addLocalFamInst"
53 Just (tc, tys) -> tc `mkTyConApp` tys
54 ; (tvs', theta', tau') <- tcInstSkolType (FamInstSkol tycon) ty
56 ; let (fam, tys') = tcSplitTyConApp tau'
58 -- Load imported instances, so that we report
61 ; let inst_envs = (eps_fam_inst_env eps, home_fie)
63 {- !!!TODO: Need to complete this:
64 -- Check for overlapping instance decls
65 ; let { (matches, _) = lookupFamInstEnv inst_envs fam tys'
66 ; dup_ispecs = [ dup_ispec --!!!adapt
67 | (_, dup_ispec) <- matches
68 , let (_,_,_,dup_tys) = instanceHead dup_ispec
69 , isJust (tcMatchTys (mkVarSet tvs') tys' dup_tys)] }
70 -- Find memebers of the match list which ispec itself matches.
71 -- If the match is 2-way, it's a duplicate
73 dup_ispec : _ -> dupInstErr famInst dup_ispec
77 -- OK, now extend the envt
78 ; return (extendFamInstEnv home_fie famInst) }
81 overlapErr famInst dupFamInst
82 = addFamInstLoc famInst $
83 addErr (hang (ptext SLIT("Overlapping family instance declarations:"))
84 2 (pprFamInsts [famInst, dupFamInst]))
86 addFamInstLoc famInst thing_inside
87 = setSrcSpan (mkSrcSpan loc loc) thing_inside
89 loc = getSrcLoc famInst