1 The @FamInst@ type: family instance heads
5 tcExtendLocalFamInstEnv
8 #include "HsVersions.h"
25 %************************************************************************
27 Extending the family instance environment
29 %************************************************************************
33 -- Add new locally-defined family instances
34 tcExtendLocalFamInstEnv :: [FamInst] -> TcM a -> TcM a
35 tcExtendLocalFamInstEnv fam_insts thing_inside
36 = do { env <- getGblEnv
37 ; inst_env' <- foldlM addLocalFamInst (tcg_fam_inst_env env) fam_insts
38 ; let env' = env { tcg_fam_insts = fam_insts ++ tcg_fam_insts env,
39 tcg_fam_inst_env = inst_env' }
40 ; setGblEnv env' thing_inside }
43 -- Check that the proposed new instance is OK,
44 -- and then add it to the home inst env
45 addLocalFamInst :: FamInstEnv -> FamInst -> TcM FamInstEnv
46 addLocalFamInst home_fie famInst
47 = do { -- To instantiate the family instance type, extend the instance
48 -- envt with completely fresh template variables
49 -- This is important because the template variables must
50 -- not overlap with anything in the things being looked up
51 -- (since we do unification).
52 -- We use tcInstSkolType because we don't want to allocate
53 -- fresh *meta* type variables.
54 let tycon = famInstTyCon famInst
55 ty = case tyConFamInst_maybe tycon of
56 Nothing -> panic "FamInst.addLocalFamInst"
57 Just (tc, tys) -> tc `mkTyConApp` tys
58 ; (tvs', _, tau') <- tcInstSkolType (FamInstSkol tycon) ty
60 ; let (fam, tys') = tcSplitTyConApp tau'
62 -- Load imported instances, so that we report
65 ; let inst_envs = (eps_fam_inst_env eps, home_fie)
67 -- Check for conflicting instance decls
68 ; let { matches = lookupFamInstEnvUnify inst_envs fam tys'
69 ; conflicts = [ conflictingFamInst
70 | match@(_, conflictingFamInst) <- matches
71 , conflicting fam tys' tycon match
74 ; unless (null conflicts) $
75 conflictInstErr famInst (head conflicts)
77 -- OK, now extend the envt
78 ; return (extendFamInstEnv home_fie famInst)
81 -- In the case of data/newtype instances, any overlap is a conflicts (as
82 -- these instances imply injective type mappings).
83 conflicting _ _ tycon _ | isAlgTyCon tycon = True
84 conflicting fam tys' tycon (subst, cFamInst) | otherwise =
85 panic "FamInst.addLocalFamInst: overlap check for indexed synonyms is still missing"
87 conflictInstErr famInst conflictingFamInst
88 = addFamInstLoc famInst $
89 addErr (hang (ptext SLIT("Conflicting family instance declarations:"))
90 2 (pprFamInsts [famInst, conflictingFamInst]))
92 addFamInstLoc famInst thing_inside
93 = setSrcSpan (mkSrcSpan loc loc) thing_inside
95 loc = getSrcLoc famInst