TyThing(..), TyThingDetails(..), TcTyThing(..), TcId,
-- Instance environment, and InstInfo type
- tcGetInstEnv, tcSetInstEnv,
+ tcGetInstEnv,
InstInfo(..), pprInstInfo, pprInstInfoDetails,
simpleInstInfoTy, simpleInstInfoTyCon,
InstBindings(..),
lclEnvElts, getInLocalScope, findGlobals,
-- Instance environment
- tcExtendLocalInstEnv, tcExtendInstEnv,
+ tcExtendLocalInstEnv, tcExtendInstEnv, tcExtendTempInstEnv, tcWithTempInstEnv,
-- Rules
tcExtendRules,
other -> notFound "tcLookupGlobal" name
tcLookupGlobalId :: Name -> TcM Id
+-- Never used for Haskell-source DataCons, hence no ADataCon case
tcLookupGlobalId name
= tcLookupGlobal_maybe name `thenM` \ maybe_thing ->
case maybe_thing of
- Just (AnId id) -> returnM id
-
- -- When typechecking Haskell source, occurrences of
- -- data constructors use the "source name", which maps
- -- to ADataCon; we want the wrapper instead
- Just (ADataCon dc) -> returnM (dataConWrapId dc)
-
- other -> notFound "tcLookupGlobal (id)" name
+ Just (AnId id) -> returnM id
+ other -> notFound "tcLookupGlobal (id)" name
tcLookupDataCon :: Name -> TcM DataCon
tcLookupDataCon con_name
tcLookupId :: Name -> TcM Id
-- Used when we aren't interested in the binding level
+-- Never a DataCon. (Why does that matter? see TcExpr.tcId)
tcLookupId name
= tcLookup name `thenM` \ thing ->
case thing of
- ATcId tc_id lvl -> returnM tc_id
- AGlobal (AnId id) -> returnM id
- AGlobal (ADataCon dc) -> returnM (dataConWrapId dc)
- -- C.f. tcLookupGlobalId
- other -> pprPanic "tcLookupId" (ppr name)
+ ATcId tc_id lvl -> returnM tc_id
+ AGlobal (AnId id) -> returnM id
+ other -> pprPanic "tcLookupId" (ppr name)
tcLookupIdLvl :: Name -> TcM (Id, Level)
+-- DataCons dealt with separately
tcLookupIdLvl name
= tcLookup name `thenM` \ thing ->
case thing of
- ATcId tc_id lvl -> returnM (tc_id, lvl)
- AGlobal (AnId id) -> returnM (id, topIdLvl id)
- AGlobal (ADataCon dc) -> returnM (dataConWrapId dc, impLevel)
+ ATcId tc_id lvl -> returnM (tc_id, lvl)
+ AGlobal (AnId id) -> returnM (id, topIdLvl id)
other -> pprPanic "tcLookupIdLvl" (ppr name)
tcLookupLocalIds :: [Name] -> TcM [TcId]
\begin{code}
tcGetInstEnv :: TcM InstEnv
-tcGetInstEnv = getGblEnv `thenM` \ env ->
- readMutVar (tcg_inst_env env)
-
-tcSetInstEnv :: InstEnv -> TcM a -> TcM a
--- Horribly imperative;
--- but used only when temporarily enhancing the instance
--- envt during 'deriving' context inference
-tcSetInstEnv ie thing_inside
- = 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
+tcGetInstEnv = do { env <- getGblEnv; readMutVar (tcg_inst_env env) }
tcExtendInstEnv :: [DFunId] -> TcM a -> TcM a
-- Add instances from local or imported
; writeMutVar ie_var inst_env'
; setGblEnv env' thing_inside }
+tcExtendTempInstEnv :: [DFunId] -> TcM a -> TcM a
+ -- Extend the instance envt, but with *no* permanent
+ -- effect on mutable variables; also ignore errors
+ -- Used during 'deriving' stuff
+tcExtendTempInstEnv dfuns thing_inside
+ = do { dflags <- getDOpts
+ ; env <- getGblEnv
+ ; let ie_var = tcg_inst_env env
+ ; inst_env <- readMutVar ie_var
+ ; let (inst_env', errs) = extendInstEnv dflags inst_env dfuns
+ -- Ignore the errors about duplicate instances.
+ -- We don't want repeated error messages
+ -- They'll appear later, when we do the top-level extendInstEnvs
+ ; writeMutVar ie_var inst_env'
+ ; result <- thing_inside
+ ; writeMutVar ie_var inst_env -- Restore!
+ ; return result }
+
+tcWithTempInstEnv :: TcM a -> TcM a
+-- Run thing_inside, discarding any effects on the instance environment
+tcWithTempInstEnv thing_inside
+ = do { env <- getGblEnv
+ ; let ie_var = tcg_inst_env env
+ ; old_ie <- readMutVar ie_var
+ ; result <- thing_inside
+ ; writeMutVar ie_var old_ie -- Restore
+ ; return result }
+
traceDFuns dfuns
= traceTc (text "Adding instances:" <+> vcat (map pp dfuns))
where
- pp dfun = ppr dfun <+> dcolon <+> ppr (idType dfun)
+ pp dfun = ppr dfun <+> dcolon <+> ppr (idType dfun)
\end{code}