import ErrUtils ( Message, Messages, emptyMessages, errorsFound,
mkErrMsg, mkWarnMsg, printErrorsAndWarnings,
mkLocMessage, mkLongErrMsg )
-import SrcLoc ( mkGeneralSrcSpan, SrcSpan, Located(..) )
+import SrcLoc ( mkGeneralSrcSpan, isGoodSrcSpan, SrcSpan, Located(..) )
import NameEnv ( emptyNameEnv )
import NameSet ( emptyDUs, emptyNameSet )
import OccName ( emptyOccEnv )
tvs_var <- newIORef emptyVarSet ;
type_env_var <- newIORef emptyNameEnv ;
dfuns_var <- newIORef emptyNameSet ;
+ th_var <- newIORef False ;
let {
gbl_env = TcGblEnv {
tcg_type_env_var = type_env_var,
tcg_inst_env = mkImpInstEnv hsc_env,
tcg_inst_uses = dfuns_var,
+ tcg_th_used = th_var,
tcg_exports = emptyNameSet,
tcg_imports = init_imports,
tcg_dus = emptyDUs,
} ;
lcl_env = TcLclEnv {
tcl_errs = errs_var,
- tcl_loc = mkGeneralSrcSpan FSLIT("Top level of module"),
+ tcl_loc = mkGeneralSrcSpan FSLIT("Top level"),
tcl_ctxt = [],
tcl_rdr = emptyLocalRdrEnv,
tcl_th_ctxt = topStage,
getHpt :: TcRnIf gbl lcl HomePackageTable
getHpt = do { env <- getTopEnv; return (hsc_HPT env) }
+
+getEpsAndHpt :: TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
+getEpsAndHpt = do { env <- getTopEnv; eps <- readMutVar (hsc_EPS env)
+ ; return (eps, hsc_HPT env) }
\end{code}
%************************************************************************
getSrcSpanM = do { env <- getLclEnv; return (tcl_loc env) }
addSrcSpan :: SrcSpan -> TcRn a -> TcRn a
-addSrcSpan loc = updLclEnv (\env -> env { tcl_loc = loc })
+addSrcSpan loc thing_inside
+ | isGoodSrcSpan loc = updLclEnv (\env -> env { tcl_loc = loc }) thing_inside
+ | otherwise = thing_inside -- Don't overwrite useful info with useless
addLocM :: (a -> TcM b) -> Located a -> TcM b
addLocM fn (L loc a) = addSrcSpan loc $ fn a
%************************************************************************
\begin{code}
+recordThUse :: TcM ()
+recordThUse = do { env <- getGblEnv; writeMutVar (tcg_th_used env) True }
+
getStage :: TcM ThStage
getStage = do { env <- getLclEnv; return (tcl_th_ctxt env) }