compiler/typecheck/FamInst.lhs

   1 The @FamInst@ type: family instance heads
   2
   3 \begin{code}
   4 module FamInst (
   5         tcExtendLocalFamInstEnv
   6     ) where
   7
   8 #include "HsVersions.h"
   9
  10 import HscTypes
  11 import FamInstEnv
  12 import TcMType
  13 import TcType
  14 import TcRnMonad
  15 import TyCon
  16 import Type
  17 import Outputable
  18 \end{code}
  19
  20
  21 %************************************************************************
  22 %*                                                                      *
  23         Extending the family instance environment
  24 %*                                                                      *
  25 %************************************************************************
  26
  27 \begin{code}
  28
  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 }
  37
  38
  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
  55
  56         ; let   (fam, tys') = tcSplitTyConApp tau'
  57
  58                 -- Load imported instances, so that we report
  59                 -- overlaps correctly
  60         ; eps <- getEps
  61         ; let inst_envs = (eps_fam_inst_env eps, home_fie)
  62
  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
  72         ; case dup_ispecs of
  73             dup_ispec : _ -> dupInstErr famInst dup_ispec
  74             []            -> return ()
  75  -}
  76
  77                 -- OK, now extend the envt
  78         ; return (extendFamInstEnv home_fie famInst) }
  79
  80 {-  UNUSED??? --SDM
  81 overlapErr famInst dupFamInst
  82   = addFamInstLoc famInst $
  83     addErr (hang (ptext SLIT("Overlapping family instance declarations:"))
  84                2 (pprFamInsts [famInst, dupFamInst]))
  85
  86 addFamInstLoc famInst thing_inside
  87   = setSrcSpan (mkSrcSpan loc loc) thing_inside
  88   where
  89     loc = getSrcLoc famInst
  90 -}
  91 \end{code}