+ = getGblEnv `thenM` \ env ->
+ let
+ ie_var = tcg_inst_env env
+ in
+ readMutVar ie_var `thenM` \ old_ie ->
+ writeMutVar ie_var ie `thenM_`
+ thing_inside `thenM` \ result ->
+ writeMutVar ie_var old_ie `thenM_`
+ returnM result
+
+tcExtendInstEnv :: [DFunId] -> TcM a -> TcM a
+ -- Add instances from local or imported
+ -- instances, and refresh the instance-env cache
+tcExtendInstEnv dfuns thing_inside
+ = do { dflags <- getDOpts
+ ; eps <- getEps
+ ; env <- getGblEnv
+ ; let ie_var = tcg_inst_env env
+ ; inst_env <- readMutVar ie_var
+ ; let
+ -- Extend the total inst-env with the new dfuns
+ (inst_env', errs) = extendInstEnv dflags inst_env dfuns
+
+ -- Sort the ones from this module from the others
+ (lcl_dfuns, pkg_dfuns) = partition (isLocalThing mod) dfuns
+ mod = tcg_mod env
+
+ -- And add the pieces to the right places
+ (eps_inst_env', _) = extendInstEnv dflags (eps_inst_env eps) pkg_dfuns
+ eps' = eps { eps_inst_env = eps_inst_env' }
+
+ env' = env { tcg_insts = lcl_dfuns ++ tcg_insts env }
+
+ ; traceDFuns dfuns
+ ; addErrs errs
+ ; writeMutVar ie_var inst_env'
+ ; setEps eps'
+ ; setGblEnv env' thing_inside }
+
+tcExtendLocalInstEnv :: [InstInfo] -> TcM a -> TcM a
+ -- Special case for local instance decls
+tcExtendLocalInstEnv infos thing_inside
+ = do { dflags <- getDOpts
+ ; env <- getGblEnv
+ ; let ie_var = tcg_inst_env env
+ ; inst_env <- readMutVar ie_var
+ ; let
+ dfuns = map iDFunId infos
+ (inst_env', errs) = extendInstEnv dflags inst_env dfuns
+ env' = env { tcg_insts = dfuns ++ tcg_insts env }
+ ; traceDFuns dfuns
+ ; addErrs errs
+ ; writeMutVar ie_var inst_env'
+ ; setGblEnv env' thing_inside }
+
+traceDFuns dfuns
+ = traceTc (text "Adding instances:" <+> vcat (map pp dfuns))
+ where
+ pp dfun = ppr dfun <+> dcolon <+> ppr (idType dfun)
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Rules}
+%* *
+%************************************************************************
+
+\begin{code}
+tcExtendRules :: [RuleDecl Id] -> TcM a -> TcM a
+ -- Just pop the new rules into the EPS and envt resp
+ -- All the rules come from an interface file, not soruce
+ -- Nevertheless, some may be for this module, if we read
+ -- its interface instead of its source code
+tcExtendRules rules thing_inside
+ = do { eps <- getEps
+ ; env <- getGblEnv
+ ; let
+ (lcl_rules, pkg_rules) = partition is_local_rule rules
+ is_local_rule = isLocalThing mod . ifaceRuleDeclName
+ mod = tcg_mod env
+
+ core_rules = [(id,rule) | IfaceRuleOut id rule <- pkg_rules]
+ eps' = eps { eps_rule_base = addIfaceRules (eps_rule_base eps) core_rules }
+ -- All the rules from an interface are of the IfaceRuleOut form
+
+ env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
+
+ ; setEps eps'
+ ; setGblEnv env' thing_inside }
+
+addIfaceRules :: RuleBase -> [IdCoreRule] -> RuleBase
+addIfaceRules rule_base rules
+ = foldl extendRuleBase rule_base rules
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{The InstInfo type}
+%* *
+%************************************************************************
+
+The InstInfo type summarises the information in an instance declaration
+
+ instance c => k (t tvs) where b
+
+It is used just for *local* instance decls (not ones from interface files).
+But local instance decls includes
+ - derived ones
+ - generic ones
+as well as explicit user written ones.
+
+\begin{code}
+data InstInfo
+ = InstInfo {
+ iDFunId :: DFunId, -- The dfun id
+ iBinds :: InstBindings
+ }
+
+data InstBindings
+ = VanillaInst -- The normal case
+ RenamedMonoBinds -- Bindings
+ [RenamedSig] -- User pragmas recorded for generating
+ -- specialised instances
+
+ | NewTypeDerived -- Used for deriving instances of newtypes, where the
+ [Type] -- witness dictionary is identical to the argument
+ -- dictionary. Hence no bindings, no pragmas
+ -- The [Type] are the representation types
+ -- See notes in TcDeriv
+
+pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info))]
+
+pprInstInfoDetails (InstInfo { iBinds = VanillaInst b _ }) = ppr b
+pprInstInfoDetails (InstInfo { iBinds = NewTypeDerived _}) = text "Derived from the representation type"
+
+simpleInstInfoTy :: InstInfo -> Type
+simpleInstInfoTy info = case tcSplitDFunTy (idType (iDFunId info)) of
+ (_, _, _, [ty]) -> ty
+
+simpleInstInfoTyCon :: InstInfo -> TyCon
+ -- Gets the type constructor for a simple instance declaration,
+ -- i.e. one of the form instance (...) => C (T a b c) where ...
+simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
+\end{code}