import FastString
import Panic
import Util
-
+import Exception
+
import System.IO
import Data.IORef
-import Control.Exception
import Control.Monad
\end{code}
initTc hsc_env hsc_src keep_rn_syntax mod do_this
= do { errs_var <- newIORef (emptyBag, emptyBag) ;
tvs_var <- newIORef emptyVarSet ;
- type_env_var <- newIORef emptyNameEnv ;
dfuns_var <- newIORef emptyNameSet ;
keep_var <- newIORef emptyNameSet ;
th_var <- newIORef False ;
dfun_n_var <- newIORef 1 ;
+ type_env_var <- case hsc_type_env_var hsc_env of {
+ Just (_mod, te_var) -> return te_var ;
+ Nothing -> newIORef emptyNameEnv } ;
let {
maybe_rn_syntax empty_val
| keep_rn_syntax = Just empty_val
tcg_rn_decls = maybe_rn_syntax emptyRnGroup,
tcg_binds = emptyLHsBinds,
- tcg_deprecs = NoDeprecs,
+ tcg_warns = NoWarnings,
tcg_insts = [],
tcg_fam_insts= [],
tcg_rules = [],
dumpTcRn :: SDoc -> TcRn ()
dumpTcRn doc = do { rdr_env <- getGlobalRdrEnv ;
dflags <- getDOpts ;
- liftIO (printForUser stderr (mkPrintUnqualified dflags rdr_env) doc) }
+ liftIO (printForUser stderr (mkPrintUnqualified dflags rdr_env) doc) }
+
+debugDumpTcRn :: SDoc -> TcRn ()
+debugDumpTcRn doc | opt_NoDebugOutput = return ()
+ | otherwise = dumpTcRn doc
dumpOptTcRn :: DynFlag -> SDoc -> TcRn ()
dumpOptTcRn flag doc = ifOptM flag (dumpTcRn doc)
\begin{code}
+#if __GLASGOW_HASKELL__ < 609
try_m :: TcRn r -> TcRn (Either Exception r)
+#else
+try_m :: TcRn r -> TcRn (Either ErrorCall r)
+#endif
-- Does try_m, with a debug-trace on failure
try_m thing
= do { mb_r <- tryM thing ;
-- Used when checking the up-to-date-ness of the old Iface
-- Initialise the environment with no useful info at all
initIfaceCheck hsc_env do_this
- = do { let gbl_env = IfGblEnv { if_rec_types = Nothing }
- ; initTcRnIf 'i' hsc_env gbl_env () do_this
- }
+ = do let rec_types = case hsc_type_env_var hsc_env of
+ Just (mod,var) -> Just (mod, readMutVar var)
+ Nothing -> Nothing
+ gbl_env = IfGblEnv { if_rec_types = rec_types }
+ initTcRnIf 'i' hsc_env gbl_env () do_this
initIfaceTc :: ModIface
-> (TcRef TypeEnv -> IfL a) -> TcRnIf gbl lcl a