Refactor interface loading

In order to support several home-units and several independent
unit-databases, it's easier to explicitly pass UnitState, DynFlags, etc.
to interface loading functions.

This patch converts some functions using monads such as IfG or TcRnIf
with implicit access to HscEnv to use IO instead and to pass them
specific fields of HscEnv instead of an HscEnv value.

7 files changed, 319 insertions, 281 deletions

diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index c2276e2b01..cfd8e1a2ee 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -13,7 +13,6 @@ module GHC.Iface.Binary (
         -- * Public API for interface file serialisation
         writeBinIface,
         readBinIface,
-        readBinIface_,
         getSymtabName,
         getDictFastString,
         CheckHiWay(..),
@@ -42,7 +41,6 @@ import GHC.Iface.Env
 import GHC.Unit
 import GHC.Unit.Module.ModIface
 import GHC.Types.Name
-import GHC.Driver.Session
 import GHC.Platform.Profile
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Supply
@@ -82,20 +80,15 @@ data TraceBinIFace
    = TraceBinIFace (SDoc -> IO ())
    | QuietBinIFace
 
--- | Read an interface file
-readBinIface :: CheckHiWay -> TraceBinIFace -> FilePath
-             -> TcRnIf a b ModIface
-readBinIface checkHiWay traceBinIFaceReading hi_path = do
-    ncu <- mkNameCacheUpdater
-    dflags <- getDynFlags
-    let profile = targetProfile dflags
-    liftIO $ readBinIface_ profile checkHiWay traceBinIFaceReading hi_path ncu
-
--- | Read an interface file in 'IO'.
-readBinIface_ :: Profile -> CheckHiWay -> TraceBinIFace -> FilePath
-              -> NameCacheUpdater
-              -> IO ModIface
-readBinIface_ profile checkHiWay traceBinIFace hi_path ncu = do
+-- | Read an interface file.
+readBinIface
+  :: Profile
+  -> NameCacheUpdater
+  -> CheckHiWay
+  -> TraceBinIFace
+  -> FilePath
+  -> IO ModIface
+readBinIface profile ncu checkHiWay traceBinIFace hi_path = do
     let platform = profilePlatform profile
 
         wantedGot :: String -> a -> a -> (a -> SDoc) -> IO ()
diff --git a/compiler/GHC/Iface/Env.hs b/compiler/GHC/Iface/Env.hs
index 4b4567289c..00ec3790d9 100644
--- a/compiler/GHC/Iface/Env.hs
+++ b/compiler/GHC/Iface/Env.hs
@@ -15,9 +15,11 @@ module GHC.Iface.Env (
 
         ifaceExportNames,
 
+        trace_if, trace_hi_diffs, -- FIXME: temporary
+
         -- Name-cache stuff
         allocateGlobalBinder, updNameCacheTc, updNameCache,
-        mkNameCacheUpdater, NameCacheUpdater(..),
+        mkNameCacheUpdater, mkNameCacheUpdaterM, NameCacheUpdater(..),
    ) where
 
 #include "HsVersions.h"
@@ -25,6 +27,7 @@ module GHC.Iface.Env (
 import GHC.Prelude
 
 import GHC.Driver.Env
+import GHC.Driver.Session
 
 import GHC.Tc.Utils.Monad
 import GHC.Core.Type
@@ -45,8 +48,11 @@ import GHC.Types.Unique.Supply
 import GHC.Types.SrcLoc
 
 import GHC.Utils.Outputable
+import GHC.Utils.Error
+
 import Data.List     ( partition )
 import Data.IORef
+import Control.Monad
 
 {-
 *********************************************************
@@ -134,10 +140,13 @@ ifaceExportNames exports = return exports
 newtype NameCacheUpdater
       = NCU { updateNameCache :: forall c. (NameCache -> (NameCache, c)) -> IO c }
 
-mkNameCacheUpdater :: TcRnIf a b NameCacheUpdater
-mkNameCacheUpdater = do { hsc_env <- getTopEnv
-                        ; let !ncRef = hsc_NC hsc_env
-                        ; return (NCU (updNameCache ncRef)) }
+mkNameCacheUpdater :: HscEnv -> NameCacheUpdater
+mkNameCacheUpdater hsc_env = NCU (updNameCache ncRef)
+  where
+    !ncRef = hsc_NC hsc_env
+
+mkNameCacheUpdaterM :: TcRnIf a b NameCacheUpdater
+mkNameCacheUpdaterM = mkNameCacheUpdater <$> getTopEnv
 
 updNameCacheTc :: Module -> OccName -> (NameCache -> (NameCache, c))
                -> TcRnIf a b c
@@ -320,3 +329,10 @@ updNameCache :: IORef NameCache
 updNameCache ncRef upd_fn
   = atomicModifyIORef' ncRef upd_fn
 
+trace_if :: DynFlags -> SDoc -> IO ()
+{-# INLINE trace_if #-}
+trace_if dflags doc = when (dopt Opt_D_dump_if_trace dflags) $ putMsg dflags doc
+
+trace_hi_diffs :: DynFlags -> SDoc -> IO ()
+{-# INLINE trace_hi_diffs #-}
+trace_hi_diffs dflags doc = when (dopt Opt_D_dump_hi_diffs dflags) $ putMsg dflags doc
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index b1a4f4d27c..820dd19622 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -57,6 +57,7 @@ import GHC.Iface.Syntax
 import GHC.Iface.Ext.Fields
 import GHC.Iface.Binary
 import GHC.Iface.Rename
+import GHC.Iface.Env
 
 import GHC.Tc.Utils.Monad
 
@@ -166,7 +167,8 @@ importDecl :: Name -> IfM lcl (MaybeErr SDoc TyThing)
 -- It's not a wired-in thing -- the caller caught that
 importDecl name
   = ASSERT( not (isWiredInName name) )
-    do  { traceIf nd_doc
+    do  { dflags <- getDynFlags
+        ; liftIO $ trace_if dflags nd_doc
 
         -- Load the interface, which should populate the PTE
         ; mb_iface <- ASSERT2( isExternalName name, ppr name )
@@ -240,7 +242,8 @@ checkWiredInTyCon tc
   = return ()
   | otherwise
   = do  { mod <- getModule
-        ; traceIf (text "checkWiredInTyCon" <+> ppr tc_name $$ ppr mod)
+        ; dflags <- getDynFlags
+        ; liftIO $ trace_if dflags (text "checkWiredInTyCon" <+> ppr tc_name $$ ppr mod)
         ; ASSERT( isExternalName tc_name )
           when (mod /= nameModule tc_name)
                (initIfaceTcRn (loadWiredInHomeIface tc_name))
@@ -405,7 +408,9 @@ loadPluginInterface doc mod_name
 -- | A wrapper for 'loadInterface' that throws an exception if it fails
 loadInterfaceWithException :: SDoc -> Module -> WhereFrom -> IfM lcl ModIface
 loadInterfaceWithException doc mod_name where_from
-  = withException (loadInterface doc mod_name where_from)
+  = do
+    dflags <- getDynFlags
+    withException dflags (loadInterface doc mod_name where_from)
 
 ------------------
 loadInterface :: SDoc -> Module -> WhereFrom
@@ -438,8 +443,9 @@ loadInterface doc_str mod from
         {       -- Read the state
           (eps,hpt) <- getEpsAndHpt
         ; gbl_env <- getGblEnv
+        ; dflags <- getDynFlags
 
-        ; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)
+        ; liftIO $ trace_if dflags (text "Considering whether to load" <+> ppr mod <+> ppr from)
 
                 -- Check whether we have the interface already
         ; hsc_env <- getTopEnv
@@ -674,7 +680,7 @@ computeInterface doc_str hi_boot_file mod0 = do
     let home_unit = hsc_home_unit hsc_env
     case getModuleInstantiation mod0 of
         (imod, Just indef) | isHomeUnitIndefinite home_unit -> do
-            r <- findAndReadIface doc_str imod mod0 hi_boot_file
+            r <- liftIO $ findAndReadIface hsc_env doc_str imod mod0 hi_boot_file
             case r of
                 Succeeded (iface0, path) -> do
                     hsc_env <- getTopEnv
@@ -685,8 +691,8 @@ computeInterface doc_str hi_boot_file mod0 = do
                         Right x -> return (Succeeded (x, path))
                         Left errs -> liftIO . throwIO . mkSrcErr $ errs
                 Failed err -> return (Failed err)
-        (mod, _) ->
-            findAndReadIface doc_str mod mod0 hi_boot_file
+        (mod, _) -> liftIO $
+            findAndReadIface hsc_env doc_str mod mod0 hi_boot_file
 
 -- | Compute the signatures which must be compiled in order to
 -- load the interface for a 'Module'.  The output of this function
@@ -705,8 +711,9 @@ moduleFreeHolesPrecise doc_str mod
  | otherwise =
    case getModuleInstantiation mod of
     (imod, Just indef) -> do
+        dflags <- getDynFlags
         let insts = instUnitInsts (moduleUnit indef)
-        traceIf (text "Considering whether to load" <+> ppr mod <+>
+        liftIO $ trace_if dflags (text "Considering whether to load" <+> ppr mod <+>
                  text "to compute precise free module holes")
         (eps, hpt) <- getEpsAndHpt
         case tryEpsAndHpt eps hpt `firstJust` tryDepsCache eps imod insts of
@@ -721,7 +728,8 @@ moduleFreeHolesPrecise doc_str mod
             Just ifhs  -> Just (renameFreeHoles ifhs insts)
             _otherwise -> Nothing
     readAndCache imod insts = do
-        mb_iface <- findAndReadIface (text "moduleFreeHolesPrecise" <+> doc_str) imod mod NotBoot
+        hsc_env <- getTopEnv
+        mb_iface <- liftIO $ findAndReadIface hsc_env (text "moduleFreeHolesPrecise" <+> doc_str) imod mod NotBoot
         case mb_iface of
             Succeeded (iface, _) -> do
                 let ifhs = mi_free_holes iface
@@ -810,7 +818,8 @@ This actually happened with P=base, Q=ghc-prim, via the AMP warnings.
 See #8320.
 -}
 
-findAndReadIface :: SDoc
+findAndReadIface :: HscEnv
+                 -> SDoc
                  -- The unique identifier of the on-disk module we're
                  -- looking for
                  -> InstalledModule
@@ -820,14 +829,21 @@ findAndReadIface :: SDoc
                  -> Module
                  -> IsBootInterface     -- True  <=> Look for a .hi-boot file
                                         -- False <=> Look for .hi file
-                 -> TcRnIf gbl lcl (MaybeErr SDoc (ModIface, FilePath))
+                 -> IO (MaybeErr SDoc (ModIface, FilePath))
         -- Nothing <=> file not found, or unreadable, or illegible
         -- Just x  <=> successfully found and parsed
 
         -- It *doesn't* add an error to the monad, because
         -- sometimes it's ok to fail... see notes with loadInterface
-findAndReadIface doc_str mod wanted_mod_with_insts hi_boot_file
-  = do traceIf (sep [hsep [text "Reading",
+findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
+  let dflags     = hsc_dflags hsc_env
+  let home_unit  = hsc_home_unit hsc_env
+  let unit_env   = hsc_unit_env hsc_env
+  let profile    = targetProfile dflags
+  let name_cache = mkNameCacheUpdater hsc_env
+  let unit_state = hsc_units hsc_env
+
+  trace_if dflags (sep [hsep [text "Reading",
                            if hi_boot_file == IsBoot
                              then text "[boot]"
                              else Outputable.empty,
@@ -835,92 +851,91 @@ findAndReadIface doc_str mod wanted_mod_with_insts hi_boot_file
                            ppr mod <> semi],
                      nest 4 (text "reason:" <+> doc_str)])
 
-       -- Check for GHC.Prim, and return its static interface
-       -- See Note [GHC.Prim] in primops.txt.pp.
-       -- TODO: make this check a function
-       if mod `installedModuleEq` gHC_PRIM
-           then do
-               hooks <- getHooks
-               let iface = case ghcPrimIfaceHook hooks of
-                            Nothing -> ghcPrimIface
-                            Just h  -> h
-               return (Succeeded (iface, "<built in interface for GHC.Prim>"))
-           else do
-               dflags <- getDynFlags
-               -- Look for the file
-               hsc_env <- getTopEnv
-               mb_found <- liftIO (findExactModule hsc_env mod)
-               let home_unit  = hsc_home_unit hsc_env
-               case mb_found of
-                   InstalledFound loc mod -> do
-                       -- Found file, so read it
-                       let file_path = addBootSuffix_maybe hi_boot_file
-                                                           (ml_hi_file loc)
-
-                       -- See Note [Home module load error]
-                       if isHomeInstalledModule home_unit mod &&
-                          not (isOneShot (ghcMode dflags))
-                           then return (Failed (homeModError mod loc))
-                           else do r <- read_file file_path
-                                   checkBuildDynamicToo r
-                                   return r
-                   err -> do
-                       traceIf (text "...not found")
-                       hsc_env <- getTopEnv
-                       let profile = Profile (targetPlatform dflags) (ways dflags)
-                       return $ Failed $ cannotFindInterface
-                                           (hsc_unit_env hsc_env)
-                                           profile
-                                           (may_show_locations (hsc_dflags hsc_env))
-                                           (moduleName mod)
-                                           err
-    where read_file file_path = do
-              traceIf (text "readIFace" <+> text file_path)
-              -- Figure out what is recorded in mi_module.  If this is
-              -- a fully definite interface, it'll match exactly, but
-              -- if it's indefinite, the inside will be uninstantiated!
-              unit_state <- hsc_units <$> getTopEnv
-              let wanted_mod =
-                    case getModuleInstantiation wanted_mod_with_insts of
-                        (_, Nothing) -> wanted_mod_with_insts
-                        (_, Just indef_mod) ->
-                          instModuleToModule unit_state
-                            (uninstantiateInstantiatedModule indef_mod)
-              read_result <- readIface wanted_mod file_path
-              case read_result of
-                Failed err -> return (Failed (badIfaceFile file_path err))
-                Succeeded iface -> return (Succeeded (iface, file_path))
-                            -- Don't forget to fill in the package name...
-
-          -- Indefinite interfaces are ALWAYS non-dynamic.
-          checkBuildDynamicToo (Succeeded (iface, _filePath))
-            | not (moduleIsDefinite (mi_module iface)) = return ()
-
-          checkBuildDynamicToo (Succeeded (iface, filePath)) = do
-              let load_dynamic = do
-                     dflags <- getDynFlags
-                     let dynFilePath = addBootSuffix_maybe hi_boot_file
-                                     $ replaceExtension filePath (hiSuf dflags)
-                     r <- read_file dynFilePath
-                     case r of
-                         Succeeded (dynIface, _)
-                          | mi_mod_hash (mi_final_exts iface) == mi_mod_hash (mi_final_exts dynIface) ->
-                             return ()
-                          | otherwise ->
-                             do traceIf (text "Dynamic hash doesn't match")
-                                setDynamicTooFailed dflags
-                         Failed err ->
-                             do traceIf (text "Failed to load dynamic interface file:" $$ err)
-                                setDynamicTooFailed dflags
-
-              dflags <- getDynFlags
-              dynamicTooState dflags >>= \case
-                DT_Dont   -> return ()
-                DT_Failed -> return ()
-                DT_Dyn    -> load_dynamic
-                DT_OK     -> withDynamicNow load_dynamic
-
-          checkBuildDynamicToo _ = return ()
+  -- Check for GHC.Prim, and return its static interface
+  -- See Note [GHC.Prim] in primops.txt.pp.
+  -- TODO: make this check a function
+  if mod `installedModuleEq` gHC_PRIM
+      then do
+          hooks <- getHooks
+          let iface = case ghcPrimIfaceHook hooks of
+                       Nothing -> ghcPrimIface
+                       Just h  -> h
+          return (Succeeded (iface, "<built in interface for GHC.Prim>"))
+      else do
+          -- Look for the file
+          mb_found <- liftIO (findExactModule hsc_env mod)
+          case mb_found of
+              InstalledFound loc mod -> do
+                  -- Found file, so read it
+                  let file_path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc)
+                  -- See Note [Home module load error]
+                  if isHomeInstalledModule home_unit mod &&
+                     not (isOneShot (ghcMode dflags))
+                      then return (Failed (homeModError mod loc))
+                      else do
+                        r <- read_file name_cache unit_state dflags wanted_mod file_path
+                        case r of
+                          Failed _
+                            -> return ()
+                          Succeeded (iface,fp)
+                            -> load_dynamic_too_maybe name_cache unit_state
+                                                      dflags wanted_mod
+                                                      hi_boot_file iface fp
+                        return r
+              err -> do
+                  trace_if dflags (text "...not found")
+                  return $ Failed $ cannotFindInterface
+                                      unit_env
+                                      profile
+                                      (may_show_locations (hsc_dflags hsc_env))
+                                      (moduleName mod)
+                                      err
+
+-- | Check if we need to try the dynamic interface for -dynamic-too
+load_dynamic_too_maybe :: NameCacheUpdater -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> FilePath -> IO ()
+load_dynamic_too_maybe name_cache unit_state dflags wanted_mod is_boot iface file_path
+  -- Indefinite interfaces are ALWAYS non-dynamic.
+  | not (moduleIsDefinite (mi_module iface)) = return ()
+  | otherwise = dynamicTooState dflags  >>= \case
+      DT_Dont   -> return ()
+      DT_Failed -> return ()
+      DT_Dyn    -> load_dynamic_too name_cache unit_state dflags wanted_mod is_boot iface file_path
+      DT_OK     -> load_dynamic_too name_cache unit_state (setDynamicNow dflags) wanted_mod is_boot iface file_path
+
+load_dynamic_too :: NameCacheUpdater -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> FilePath -> IO ()
+load_dynamic_too name_cache unit_state dflags wanted_mod is_boot iface file_path = do
+  let dynFilePath = addBootSuffix_maybe is_boot
+                  $ replaceExtension file_path (hiSuf dflags)
+  read_file name_cache unit_state dflags wanted_mod dynFilePath >>= \case
+    Succeeded (dynIface, _)
+     | mi_mod_hash (mi_final_exts iface) == mi_mod_hash (mi_final_exts dynIface)
+     -> return ()
+     | otherwise ->
+        do trace_if dflags (text "Dynamic hash doesn't match")
+           setDynamicTooFailed dflags
+    Failed err ->
+        do trace_if dflags (text "Failed to load dynamic interface file:" $$ err)
+           setDynamicTooFailed dflags
+
+read_file :: NameCacheUpdater -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr SDoc (ModIface, FilePath))
+read_file name_cache unit_state dflags wanted_mod file_path = do
+  trace_if dflags (text "readIFace" <+> text file_path)
+
+  -- Figure out what is recorded in mi_module.  If this is
+  -- a fully definite interface, it'll match exactly, but
+  -- if it's indefinite, the inside will be uninstantiated!
+  let wanted_mod' =
+        case getModuleInstantiation wanted_mod of
+            (_, Nothing) -> wanted_mod
+            (_, Just indef_mod) ->
+              instModuleToModule unit_state
+                (uninstantiateInstantiatedModule indef_mod)
+  read_result <- readIface dflags name_cache wanted_mod' file_path
+  case read_result of
+    Failed err -> return (Failed (badIfaceFile file_path err))
+    Succeeded iface -> return (Succeeded (iface, file_path))
+                -- Don't forget to fill in the package name...
+
 
 -- | Write interface file
 writeIface :: Logger -> DynFlags -> FilePath -> ModIface -> IO ()
@@ -930,29 +945,32 @@ writeIface logger dflags hi_file_path new_iface
              profile = targetProfile dflags
          writeBinIface profile printer hi_file_path new_iface
 
--- @readIface@ tries just the one file.
-readIface :: Module -> FilePath
-          -> TcRnIf gbl lcl (MaybeErr SDoc ModIface)
-        -- Failed err    <=> file not found, or unreadable, or illegible
-        -- Succeeded iface <=> successfully found and parsed
-
-readIface wanted_mod file_path
-  = do  { res <- tryMostM $
-                 readBinIface CheckHiWay QuietBinIFace file_path
-        ; case res of
-            Right iface
-                -- NB: This check is NOT just a sanity check, it is
-                -- critical for correctness of recompilation checking
-                -- (it lets us tell when -this-unit-id has changed.)
-                | wanted_mod == actual_mod
-                                -> return (Succeeded iface)
-                | otherwise     -> return (Failed err)
-                where
-                  actual_mod = mi_module iface
-                  err = hiModuleNameMismatchWarn wanted_mod actual_mod
-
-            Left exn    -> return (Failed (text (showException exn)))
-    }
+-- | @readIface@ tries just the one file.
+--
+-- Failed err    <=> file not found, or unreadable, or illegible
+-- Succeeded iface <=> successfully found and parsed
+readIface
+  :: DynFlags
+  -> NameCacheUpdater
+  -> Module
+  -> FilePath
+  -> IO (MaybeErr SDoc ModIface)
+readIface dflags name_cache wanted_mod file_path = do
+  let profile = targetProfile dflags
+  res <- tryMost $ readBinIface profile name_cache CheckHiWay QuietBinIFace file_path
+  case res of
+    Right iface
+        -- NB: This check is NOT just a sanity check, it is
+        -- critical for correctness of recompilation checking
+        -- (it lets us tell when -this-unit-id has changed.)
+        | wanted_mod == actual_mod
+                        -> return (Succeeded iface)
+        | otherwise     -> return (Failed err)
+        where
+          actual_mod = mi_module iface
+          err = hiModuleNameMismatchWarn wanted_mod actual_mod
+
+    Left exn    -> return (Failed (text (showException exn)))
 
 {-
 *********************************************************
@@ -1054,12 +1072,14 @@ showIface hsc_env filename = do
    let dflags  = hsc_dflags hsc_env
    let logger  = hsc_logger hsc_env
        unit_state = hsc_units hsc_env
+       profile = targetProfile dflags
        printer = putLogMsg logger dflags NoReason SevOutput noSrcSpan . withPprStyle defaultDumpStyle
+       name_cache = mkNameCacheUpdater hsc_env
 
    -- skip the hi way check; we don't want to worry about profiled vs.
    -- non-profiled interfaces, for example.
    iface <- initTcRnIf 's' hsc_env () () $
-       readBinIface IgnoreHiWay (TraceBinIFace printer) filename
+       liftIO $ readBinIface profile name_cache IgnoreHiWay (TraceBinIFace printer) filename
 
    let -- See Note [Name qualification with --show-iface]
        qualifyImportedNames mod _
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index d0a06173ec..ca35ec60fb 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -24,6 +24,7 @@ import GHC.Iface.Syntax
 import GHC.Iface.Recomp.Binary
 import GHC.Iface.Load
 import GHC.Iface.Recomp.Flags
+import GHC.Iface.Env
 
 import GHC.Core
 import GHC.Tc.Utils.Monad
@@ -159,21 +160,22 @@ check_old_iface hsc_env mod_summary src_modified maybe_iface
         getIface =
             case maybe_iface of
                 Just _  -> do
-                    traceIf (text "We already have the old interface for" <+>
+                    trace_if dflags (text "We already have the old interface for" <+>
                       ppr (ms_mod mod_summary))
                     return maybe_iface
                 Nothing -> loadIface
 
         loadIface = do
              let iface_path = msHiFilePath mod_summary
-             read_result <- readIface (ms_mod mod_summary) iface_path
+             let ncu        = mkNameCacheUpdater hsc_env
+             read_result <- readIface dflags ncu (ms_mod mod_summary) iface_path
              case read_result of
                  Failed err -> do
-                     traceIf (text "FYI: cannot read old interface file:" $$ nest 4 err)
-                     traceHiDiffs (text "Old interface file was invalid:" $$ nest 4 err)
+                     trace_if dflags (text "FYI: cannot read old interface file:" $$ nest 4 err)
+                     trace_hi_diffs dflags (text "Old interface file was invalid:" $$ nest 4 err)
                      return Nothing
                  Succeeded iface -> do
-                     traceIf (text "Read the interface file" <+> text iface_path)
+                     trace_if dflags (text "Read the interface file" <+> text iface_path)
                      return $ Just iface
 
         src_changed
@@ -182,7 +184,7 @@ check_old_iface hsc_env mod_summary src_modified maybe_iface
             | otherwise = False
     in do
         when src_changed $
-            traceHiDiffs (nest 4 $ text "Source file changed or recompilation check turned off")
+            liftIO $ trace_hi_diffs dflags (nest 4 $ text "Source file changed or recompilation check turned off")
 
         case src_changed of
             -- If the source has changed and we're in interactive mode,
@@ -194,11 +196,11 @@ check_old_iface hsc_env mod_summary src_modified maybe_iface
             -- Try and read the old interface for the current module
             -- from the .hi file left from the last time we compiled it
             True -> do
-                maybe_iface' <- getIface
+                maybe_iface' <- liftIO $ getIface
                 return (MustCompile, maybe_iface')
 
             False -> do
-                maybe_iface' <- getIface
+                maybe_iface' <- liftIO $ getIface
                 case maybe_iface' of
                     -- We can't retrieve the iface
                     Nothing    -> return (MustCompile, Nothing)
@@ -225,25 +227,27 @@ checkVersions :: HscEnv
               -> ModIface       -- Old interface
               -> IfG (RecompileRequired, Maybe ModIface)
 checkVersions hsc_env mod_summary iface
-  = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
+  = do { liftIO $ trace_hi_diffs dflags
+                        (text "Considering whether compilation is required for" <+>
                         ppr (mi_module iface) <> colon)
 
        -- readIface will have verified that the UnitId matches,
        -- but we ALSO must make sure the instantiation matches up.  See
        -- test case bkpcabal04!
+       ; hsc_env <- getTopEnv
        ; if not (isHomeModule home_unit (mi_module iface))
             then return (RecompBecause "-this-unit-id changed", Nothing) else do {
-       ; recomp <- checkFlagHash hsc_env iface
+       ; recomp <- liftIO $ checkFlagHash hsc_env iface
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
-       ; recomp <- checkOptimHash hsc_env iface
+       ; recomp <- liftIO $ checkOptimHash hsc_env iface
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
-       ; recomp <- checkHpcHash hsc_env iface
+       ; recomp <- liftIO $ checkHpcHash hsc_env iface
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
-       ; recomp <- checkMergedSignatures mod_summary iface
+       ; recomp <- liftIO $ checkMergedSignatures hsc_env mod_summary iface
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
-       ; recomp <- checkHsig mod_summary iface
+       ; recomp <- liftIO $ checkHsig hsc_env mod_summary iface
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
-       ; recomp <- checkHie mod_summary
+       ; recomp <- pure (checkHie dflags mod_summary)
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
        ; recomp <- checkDependencies hsc_env mod_summary iface
        ; if recompileRequired recomp then return (recomp, Just iface) else do {
@@ -270,6 +274,7 @@ checkVersions hsc_env mod_summary iface
        ; return (recomp, Just iface)
     }}}}}}}}}}
   where
+    dflags = hsc_dflags hsc_env
     home_unit = hsc_home_unit hsc_env
     -- This is a bit of a hack really
     mod_deps :: ModuleNameEnv ModuleNameWithIsBoot
@@ -347,88 +352,89 @@ pluginRecompileToRecompileRequired old_fp new_fp pr
 
 -- | Check if an hsig file needs recompilation because its
 -- implementing module has changed.
-checkHsig :: ModSummary -> ModIface -> IfG RecompileRequired
-checkHsig mod_summary iface = do
-    hsc_env <- getTopEnv
+checkHsig :: HscEnv -> ModSummary -> ModIface -> IO RecompileRequired
+checkHsig hsc_env mod_summary iface = do
     let home_unit = hsc_home_unit hsc_env
+        dflags    = hsc_dflags hsc_env
         outer_mod = ms_mod mod_summary
         inner_mod = homeModuleNameInstantiation home_unit (moduleName outer_mod)
     MASSERT( isHomeModule home_unit outer_mod )
     case inner_mod == mi_semantic_module iface of
-        True -> up_to_date (text "implementing module unchanged")
+        True -> up_to_date dflags (text "implementing module unchanged")
         False -> return (RecompBecause "implementing module changed")
 
 -- | Check if @.hie@ file is out of date or missing.
-checkHie :: ModSummary -> IfG RecompileRequired
-checkHie mod_summary = do
-    dflags <- getDynFlags
+checkHie :: DynFlags -> ModSummary -> RecompileRequired
+checkHie dflags mod_summary =
     let hie_date_opt = ms_hie_date mod_summary
         hs_date = ms_hs_date mod_summary
-    pure $ case gopt Opt_WriteHie dflags of
-               False -> UpToDate
-               True -> case hie_date_opt of
-                           Nothing -> RecompBecause "HIE file is missing"
-                           Just hie_date
-                               | hie_date < hs_date
-                               -> RecompBecause "HIE file is out of date"
-                               | otherwise
-                               -> UpToDate
+    in if not (gopt Opt_WriteHie dflags)
+      then UpToDate
+      else case hie_date_opt of
+             Nothing -> RecompBecause "HIE file is missing"
+             Just hie_date
+                 | hie_date < hs_date
+                 -> RecompBecause "HIE file is out of date"
+                 | otherwise
+                 -> UpToDate
 
 -- | Check the flags haven't changed
-checkFlagHash :: HscEnv -> ModIface -> IfG RecompileRequired
+checkFlagHash :: HscEnv -> ModIface -> IO RecompileRequired
 checkFlagHash hsc_env iface = do
+    let dflags   = hsc_dflags hsc_env
     let old_hash = mi_flag_hash (mi_final_exts iface)
-    new_hash <- liftIO $ fingerprintDynFlags hsc_env
-                                             (mi_module iface)
-                                             putNameLiterally
+    new_hash <- fingerprintDynFlags hsc_env (mi_module iface) putNameLiterally
     case old_hash == new_hash of
-        True  -> up_to_date (text "Module flags unchanged")
-        False -> out_of_date_hash "flags changed"
+        True  -> up_to_date dflags (text "Module flags unchanged")
+        False -> out_of_date_hash dflags "flags changed"
                      (text "  Module flags have changed")
                      old_hash new_hash
 
 -- | Check the optimisation flags haven't changed
-checkOptimHash :: HscEnv -> ModIface -> IfG RecompileRequired
+checkOptimHash :: HscEnv -> ModIface -> IO RecompileRequired
 checkOptimHash hsc_env iface = do
+    let dflags   = hsc_dflags hsc_env
     let old_hash = mi_opt_hash (mi_final_exts iface)
-    new_hash <- liftIO $ fingerprintOptFlags (hsc_dflags hsc_env)
+    new_hash <- fingerprintOptFlags (hsc_dflags hsc_env)
                                                putNameLiterally
     if | old_hash == new_hash
-         -> up_to_date (text "Optimisation flags unchanged")
+         -> up_to_date dflags (text "Optimisation flags unchanged")
        | gopt Opt_IgnoreOptimChanges (hsc_dflags hsc_env)
-         -> up_to_date (text "Optimisation flags changed; ignoring")
+         -> up_to_date dflags (text "Optimisation flags changed; ignoring")
        | otherwise
-         -> out_of_date_hash "Optimisation flags changed"
+         -> out_of_date_hash dflags "Optimisation flags changed"
                      (text "  Optimisation flags have changed")
                      old_hash new_hash
 
 -- | Check the HPC flags haven't changed
-checkHpcHash :: HscEnv -> ModIface -> IfG RecompileRequired
+checkHpcHash :: HscEnv -> ModIface -> IO RecompileRequired
 checkHpcHash hsc_env iface = do
+    let dflags   = hsc_dflags hsc_env
     let old_hash = mi_hpc_hash (mi_final_exts iface)
-    new_hash <- liftIO $ fingerprintHpcFlags (hsc_dflags hsc_env)
+    new_hash <- fingerprintHpcFlags (hsc_dflags hsc_env)
                                                putNameLiterally
     if | old_hash == new_hash
-         -> up_to_date (text "HPC flags unchanged")
+         -> up_to_date dflags (text "HPC flags unchanged")
        | gopt Opt_IgnoreHpcChanges (hsc_dflags hsc_env)
-         -> up_to_date (text "HPC flags changed; ignoring")
+         -> up_to_date dflags (text "HPC flags changed; ignoring")
        | otherwise
-         -> out_of_date_hash "HPC flags changed"
+         -> out_of_date_hash dflags "HPC flags changed"
                      (text "  HPC flags have changed")
                      old_hash new_hash
 
 -- Check that the set of signatures we are merging in match.
 -- If the -unit-id flags change, this can change too.
-checkMergedSignatures :: ModSummary -> ModIface -> IfG RecompileRequired
-checkMergedSignatures mod_summary iface = do
-    unit_state <- hsc_units <$> getTopEnv
+checkMergedSignatures :: HscEnv -> ModSummary -> ModIface -> IO RecompileRequired
+checkMergedSignatures hsc_env mod_summary iface = do
+    let dflags     = hsc_dflags hsc_env
+    let unit_state = hsc_units hsc_env
     let old_merged = sort [ mod | UsageMergedRequirement{ usg_mod = mod } <- mi_usages iface ]
         new_merged = case Map.lookup (ms_mod_name mod_summary)
                                      (requirementContext unit_state) of
                         Nothing -> []
                         Just r -> sort $ map (instModuleToModule unit_state) r
     if old_merged == new_merged
-        then up_to_date (text "signatures to merge in unchanged" $$ ppr new_merged)
+        then up_to_date dflags (text "signatures to merge in unchanged" $$ ppr new_merged)
         else return (RecompBecause "signatures to merge in changed")
 
 -- If the direct imports of this module are resolved to targets that
@@ -452,31 +458,32 @@ checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
 checkDependencies hsc_env summary iface
  =
    checkList $
-     [ checkList (map dep_missing (ms_imps summary ++ ms_srcimps summary))
+     [ liftIO $ checkList (map dep_missing (ms_imps summary ++ ms_srcimps summary))
      , do
          (recomp, mnames_seen) <- runUntilRecompRequired $ map
            checkForNewHomeDependency
            (ms_home_imps summary)
-         case recomp of
+         liftIO $ case recomp of
            UpToDate -> do
              let
                seen_home_deps = Set.unions $ map Set.fromList mnames_seen
              checkIfAllOldHomeDependenciesAreSeen seen_home_deps
            _ -> return recomp]
  where
+   dflags = hsc_dflags hsc_env
    prev_dep_mods = dep_mods (mi_deps iface)
    prev_dep_plgn = dep_plgins (mi_deps iface)
    prev_dep_pkgs = dep_pkgs (mi_deps iface)
    home_unit     = hsc_home_unit hsc_env
 
    dep_missing (mb_pkg, L _ mod) = do
-     find_res <- liftIO $ findImportedModule hsc_env mod (mb_pkg)
+     find_res <- findImportedModule hsc_env mod (mb_pkg)
      let reason = moduleNameString mod ++ " changed"
      case find_res of
         Found _ mod
           | isHomeUnit home_unit pkg
            -> if moduleName mod `notElem` map gwib_mod prev_dep_mods ++ prev_dep_plgn
-                 then do traceHiDiffs $
+                 then do trace_hi_diffs dflags $
                            text "imported module " <> quotes (ppr mod) <>
                            text " not among previous dependencies"
                          return (RecompBecause reason)
@@ -484,7 +491,7 @@ checkDependencies hsc_env summary iface
                          return UpToDate
           | otherwise
            -> if toUnitId pkg `notElem` (map fst prev_dep_pkgs)
-                 then do traceHiDiffs $
+                 then do trace_hi_diffs dflags $
                            text "imported module " <> quotes (ppr mod) <>
                            text " is from package " <> quotes (ppr pkg) <>
                            text ", which is not among previous dependencies"
@@ -510,13 +517,13 @@ checkDependencies hsc_env summary iface
      if not (isOldHomeDeps mname)
        then return (UpToDate, [])
        else do
-         mb_result <- getFromModIface "need mi_deps for" mod $ \imported_iface -> do
+         mb_result <- getFromModIface "need mi_deps for" mod $ \imported_iface -> liftIO $ do
            let mnames = mname:(map gwib_mod $ filter ((== NotBoot) . gwib_isBoot) $
                  dep_mods $ mi_deps imported_iface)
            case find (not . isOldHomeDeps) mnames of
              Nothing -> return (UpToDate, mnames)
              Just new_dep_mname -> do
-               traceHiDiffs $
+               trace_hi_diffs dflags $
                  text "imported home module " <> quotes (ppr mod) <>
                  text " has a new dependency " <> quotes (ppr new_dep_mname)
                return (RecompBecause reason, [])
@@ -541,19 +548,19 @@ checkDependencies hsc_env summary iface
      if not (null unseen_old_deps)
        then do
          let missing_dep = Set.elemAt 0 unseen_old_deps
-         traceHiDiffs $
+         trace_hi_diffs dflags $
            text "missing old home dependency " <> quotes (ppr missing_dep)
          return $ RecompBecause "missing old dependency"
        else return UpToDate
 
-needInterface :: Module -> (ModIface -> IfG RecompileRequired)
+needInterface :: Module -> (ModIface -> IO RecompileRequired)
              -> IfG RecompileRequired
 needInterface mod continue
   = do
       mb_recomp <- getFromModIface
         "need version info for"
         mod
-        continue
+        (liftIO . continue)
       case mb_recomp of
         Nothing -> return MustCompile
         Just recomp -> return recomp
@@ -562,8 +569,9 @@ getFromModIface :: String -> Module -> (ModIface -> IfG a)
               -> IfG (Maybe a)
 getFromModIface doc_msg mod getter
   = do  -- Load the imported interface if possible
+    dflags <- getDynFlags
     let doc_str = sep [text doc_msg, ppr mod]
-    traceHiDiffs (text "Checking innterface for module" <+> ppr mod)
+    liftIO $ trace_hi_diffs dflags (text "Checking innterface for module" <+> ppr mod)
 
     mb_iface <- loadInterface doc_str mod ImportBySystem
         -- Load the interface, but don't complain on failure;
@@ -571,8 +579,7 @@ getFromModIface doc_msg mod getter
 
     case mb_iface of
       Failed _ -> do
-        traceHiDiffs (sep [text "Couldn't load interface for module",
-                           ppr mod])
+        liftIO $ trace_hi_diffs dflags (sep [text "Couldn't load interface for module", ppr mod])
         return Nothing
                   -- Couldn't find or parse a module mentioned in the
                   -- old interface file.  Don't complain: it might
@@ -586,19 +593,21 @@ getFromModIface doc_msg mod getter
 checkModUsage :: Unit -> Usage -> IfG RecompileRequired
 checkModUsage _this_pkg UsagePackageModule{
                                 usg_mod = mod,
-                                usg_mod_hash = old_mod_hash }
-  = needInterface mod $ \iface -> do
+                                usg_mod_hash = old_mod_hash } = do
+  dflags <- getDynFlags
+  needInterface mod $ \iface -> do
     let reason = moduleNameString (moduleName mod) ++ " changed"
-    checkModuleFingerprint reason old_mod_hash (mi_mod_hash (mi_final_exts iface))
+    checkModuleFingerprint dflags reason old_mod_hash (mi_mod_hash (mi_final_exts iface))
         -- We only track the ABI hash of package modules, rather than
         -- individual entity usages, so if the ABI hash changes we must
         -- recompile.  This is safe but may entail more recompilation when
         -- a dependent package has changed.
 
-checkModUsage _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_hash }
-  = needInterface mod $ \iface -> do
+checkModUsage _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_hash } = do
+  dflags <- getDynFlags
+  needInterface mod $ \iface -> do
     let reason = moduleNameString (moduleName mod) ++ " changed (raw)"
-    checkModuleFingerprint reason old_mod_hash (mi_mod_hash (mi_final_exts iface))
+    checkModuleFingerprint dflags reason old_mod_hash (mi_mod_hash (mi_final_exts iface))
 
 checkModUsage this_pkg UsageHomeModule{
                                 usg_mod_name = mod_name,
@@ -607,30 +616,31 @@ checkModUsage this_pkg UsageHomeModule{
                                 usg_entities = old_decl_hash }
   = do
     let mod = mkModule this_pkg mod_name
+    dflags <- getDynFlags
     needInterface mod $ \iface -> do
+     let
+         new_mod_hash    = mi_mod_hash (mi_final_exts iface)
+         new_decl_hash   = mi_hash_fn  (mi_final_exts iface)
+         new_export_hash = mi_exp_hash (mi_final_exts iface)
 
-       let
-           new_mod_hash    = mi_mod_hash (mi_final_exts iface)
-           new_decl_hash   = mi_hash_fn  (mi_final_exts iface)
-           new_export_hash = mi_exp_hash (mi_final_exts iface)
-
-           reason = moduleNameString mod_name ++ " changed"
+         reason = moduleNameString mod_name ++ " changed"
 
+     liftIO $ do
            -- CHECK MODULE
-       recompile <- checkModuleFingerprint reason old_mod_hash new_mod_hash
+       recompile <- checkModuleFingerprint dflags reason old_mod_hash new_mod_hash
        if not (recompileRequired recompile)
          then return UpToDate
          else
            -- CHECK EXPORT LIST
-           checkMaybeHash reason maybe_old_export_hash new_export_hash
+           checkMaybeHash dflags reason maybe_old_export_hash new_export_hash
                (text "  Export list changed") $ do
 
                  -- CHECK ITEMS ONE BY ONE
-                 recompile <- checkList [ checkEntityUsage reason new_decl_hash u
+                 recompile <- checkList [ checkEntityUsage dflags reason new_decl_hash u
                                         | u <- old_decl_hash]
                  if recompileRequired recompile
                    then return recompile     -- This one failed, so just bail out now
-                   else up_to_date (text "  Great!  The bits I use are up to date")
+                   else up_to_date dflags (text "  Great!  The bits I use are up to date")
 
 
 checkModUsage _this_pkg UsageFile{ usg_file_path = file,
@@ -651,54 +661,55 @@ checkModUsage _this_pkg UsageFile{ usg_file_path = file,
 #endif
 
 ------------------------
-checkModuleFingerprint :: String -> Fingerprint -> Fingerprint
-                       -> IfG RecompileRequired
-checkModuleFingerprint reason old_mod_hash new_mod_hash
+checkModuleFingerprint :: DynFlags -> String -> Fingerprint -> Fingerprint
+                       -> IO RecompileRequired
+checkModuleFingerprint dflags reason old_mod_hash new_mod_hash
   | new_mod_hash == old_mod_hash
-  = up_to_date (text "Module fingerprint unchanged")
+  = up_to_date dflags (text "Module fingerprint unchanged")
 
   | otherwise
-  = out_of_date_hash reason (text "  Module fingerprint has changed")
+  = out_of_date_hash dflags reason (text "  Module fingerprint has changed")
                      old_mod_hash new_mod_hash
 
 ------------------------
-checkMaybeHash :: String -> Maybe Fingerprint -> Fingerprint -> SDoc
-               -> IfG RecompileRequired -> IfG RecompileRequired
-checkMaybeHash reason maybe_old_hash new_hash doc continue
+checkMaybeHash :: DynFlags -> String -> Maybe Fingerprint -> Fingerprint -> SDoc
+               -> IO RecompileRequired -> IO RecompileRequired
+checkMaybeHash dflags reason maybe_old_hash new_hash doc continue
   | Just hash <- maybe_old_hash, hash /= new_hash
-  = out_of_date_hash reason doc hash new_hash
+  = out_of_date_hash dflags reason doc hash new_hash
   | otherwise
   = continue
 
 ------------------------
-checkEntityUsage :: String
+checkEntityUsage :: DynFlags
+                 -> String
                  -> (OccName -> Maybe (OccName, Fingerprint))
                  -> (OccName, Fingerprint)
-                 -> IfG RecompileRequired
-checkEntityUsage reason new_hash (name,old_hash)
-  = case new_hash name of
-
-        Nothing       ->        -- We used it before, but it ain't there now
-                          out_of_date reason (sep [text "No longer exported:", ppr name])
-
-        Just (_, new_hash)      -- It's there, but is it up to date?
-          | new_hash == old_hash -> do traceHiDiffs (text "  Up to date" <+> ppr name <+> parens (ppr new_hash))
-                                       return UpToDate
-          | otherwise            -> out_of_date_hash reason (text "  Out of date:" <+> ppr name)
-                                                     old_hash new_hash
-
-up_to_date :: SDoc -> IfG RecompileRequired
-up_to_date  msg = traceHiDiffs msg >> return UpToDate
-
-out_of_date :: String -> SDoc -> IfG RecompileRequired
-out_of_date reason msg = traceHiDiffs msg >> return (RecompBecause reason)
-
-out_of_date_hash :: String -> SDoc -> Fingerprint -> Fingerprint -> IfG RecompileRequired
-out_of_date_hash reason msg old_hash new_hash
-  = out_of_date reason (hsep [msg, ppr old_hash, text "->", ppr new_hash])
+                 -> IO RecompileRequired
+checkEntityUsage dflags reason new_hash (name,old_hash) = do
+  case new_hash name of
+    -- We used it before, but it ain't there now
+    Nothing       -> out_of_date dflags reason (sep [text "No longer exported:", ppr name])
+    -- It's there, but is it up to date?
+    Just (_, new_hash)
+      | new_hash == old_hash
+      -> do trace_hi_diffs dflags (text "  Up to date" <+> ppr name <+> parens (ppr new_hash))
+            return UpToDate
+      | otherwise
+      -> out_of_date_hash dflags reason (text "  Out of date:" <+> ppr name) old_hash new_hash
+
+up_to_date :: DynFlags -> SDoc -> IO RecompileRequired
+up_to_date dflags msg = trace_hi_diffs dflags msg >> return UpToDate
+
+out_of_date :: DynFlags -> String -> SDoc -> IO RecompileRequired
+out_of_date dflags reason msg = trace_hi_diffs dflags msg >> return (RecompBecause reason)
+
+out_of_date_hash :: DynFlags -> String -> SDoc -> Fingerprint -> Fingerprint -> IO RecompileRequired
+out_of_date_hash dflags reason msg old_hash new_hash
+  = out_of_date dflags reason (hsep [msg, ppr old_hash, text "->", ppr new_hash])
 
 ----------------------
-checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
+checkList :: Monad m => [m RecompileRequired] -> m RecompileRequired
 -- This helper is used in two places
 checkList []             = return UpToDate
 checkList (check:checks) = do recompile <- check
@@ -1161,12 +1172,13 @@ getOrphanHashes hsc_env mods = do
   eps <- hscEPS hsc_env
   let
     hpt        = hsc_HPT hsc_env
+    dflags     = hsc_dflags hsc_env
     pit        = eps_PIT eps
     get_orph_hash mod =
           case lookupIfaceByModule hpt pit mod of
             Just iface -> return (mi_orphan_hash (mi_final_exts iface))
             Nothing    -> do -- similar to 'mkHashFun'
-                iface <- initIfaceLoad hsc_env . withException
+                iface <- initIfaceLoad hsc_env . withException dflags
                             $ loadInterface (text "getOrphanHashes") mod ImportBySystem
                 return (mi_orphan_hash (mi_final_exts iface))
 
@@ -1454,6 +1466,7 @@ mkHashFun hsc_env eps name
   = lookup orig_mod
   where
       home_unit = hsc_home_unit hsc_env
+      dflags = hsc_dflags hsc_env
       hpt = hsc_HPT hsc_env
       pit = eps_PIT eps
       occ = nameOccName name
@@ -1467,7 +1480,7 @@ mkHashFun hsc_env eps name
                       -- requirements; we didn't do any /real/ typechecking
                       -- so there's no guarantee everything is loaded.
                       -- Kind of a heinous hack.
-                      initIfaceLoad hsc_env . withException
+                      initIfaceLoad hsc_env . withException dflags
                           $ withoutDynamicNow
                             -- For some unknown reason, we need to reset the
                             -- dynamicNow bit, otherwise only dynamic
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index ee604d8436..6f4ea646a0 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -543,7 +543,8 @@ tcHiBootIface hsc_src mod
         -- Re #9245, we always check if there is an hi-boot interface
         -- to check consistency against, rather than just when we notice
         -- that an hi-boot is necessary due to a circular import.
-        { read_result <- findAndReadIface
+        { hsc_env <- getTopEnv
+        ; read_result <- liftIO $ findAndReadIface hsc_env
                                 need (fst (getModuleInstantiation mod)) mod
                                 IsBoot  -- Hi-boot file
 
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index 707d936504..544f38c908 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -274,10 +274,11 @@ findExtraSigImports' :: HscEnv
 findExtraSigImports' hsc_env HsigFile modname =
     fmap unionManyUniqDSets (forM reqs $ \(Module iuid mod_name) ->
         (initIfaceLoad hsc_env
-            . withException
+            . withException dflags
             $ moduleFreeHolesPrecise (text "findExtraSigImports")
                 (mkModule (VirtUnit iuid) mod_name)))
   where
+    dflags = hsc_dflags hsc_env
     unit_state = hsc_units hsc_env
     reqs = requirementMerges unit_state modname
 
@@ -564,6 +565,7 @@ mergeSignatures
         mod_name   = moduleName (tcg_mod tcg_env)
         unit_state = hsc_units hsc_env
         home_unit  = hsc_home_unit hsc_env
+        dflags     = hsc_dflags hsc_env
 
     -- STEP 1: Figure out all of the external signature interfaces
     -- we are going to merge in.
@@ -572,12 +574,12 @@ mergeSignatures
     addErrCtxt (pprWithUnitState unit_state $ merge_msg mod_name reqs) $ do
 
     -- STEP 2: Read in the RAW forms of all of these interfaces
-    ireq_ifaces0 <- forM reqs $ \(Module iuid mod_name) ->
+    ireq_ifaces0 <- liftIO $ forM reqs $ \(Module iuid mod_name) -> do
         let m = mkModule (VirtUnit iuid) mod_name
             im = fst (getModuleInstantiation m)
-        in fmap fst
-         . withException
-         $ findAndReadIface (text "mergeSignatures") im m NotBoot
+        fmap fst
+         . withException dflags
+         $ findAndReadIface hsc_env (text "mergeSignatures") im m NotBoot
 
     -- STEP 3: Get the unrenamed exports of all these interfaces,
     -- thin it according to the export list, and do shaping on them.
@@ -987,7 +989,8 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do
     -- instantiation is correct.
     let sig_mod = mkModule (VirtUnit uid) mod_name
         isig_mod = fst (getModuleInstantiation sig_mod)
-    mb_isig_iface <- findAndReadIface (text "checkImplements 2") isig_mod sig_mod NotBoot
+    hsc_env <- getTopEnv
+    mb_isig_iface <- liftIO $ findAndReadIface hsc_env (text "checkImplements 2") isig_mod sig_mod NotBoot
     isig_iface <- case mb_isig_iface of
         Succeeded (iface, _) -> return iface
         Failed err -> failWithTc $
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index b79200c288..a3d5b15c98 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -28,7 +28,7 @@ module GHC.Tc.Utils.Monad(
   whenDOptM, whenGOptM, whenWOptM,
   whenXOptM, unlessXOptM,
   getGhcMode,
-  withDynamicNow, withoutDynamicNow,
+  withoutDynamicNow,
   getEpsVar,
   getEps,
   updateEps, updateEps_,
@@ -49,7 +49,7 @@ module GHC.Tc.Utils.Monad(
   dumpTcRn,
   getPrintUnqualified,
   printForUserTcRn,
-  traceIf, traceHiDiffs, traceOptIf,
+  traceIf, traceOptIf,
   debugTc,
 
   -- * Typechecker global environment
@@ -551,11 +551,6 @@ unlessXOptM flag thing_inside = do b <- xoptM flag
 getGhcMode :: TcRnIf gbl lcl GhcMode
 getGhcMode = do { env <- getTopEnv; return (ghcMode (hsc_dflags env)) }
 
-withDynamicNow :: TcRnIf gbl lcl a -> TcRnIf gbl lcl a
-withDynamicNow =
-  updTopEnv (\top@(HscEnv { hsc_dflags = dflags }) ->
-              top { hsc_dflags = setDynamicNow dflags })
-
 withoutDynamicNow :: TcRnIf gbl lcl a -> TcRnIf gbl lcl a
 withoutDynamicNow =
   updTopEnv (\top@(HscEnv { hsc_dflags = dflags }) ->
@@ -596,10 +591,9 @@ getEpsAndHpt = do { env <- getTopEnv; eps <- readMutVar (hsc_EPS env)
 
 -- | A convenient wrapper for taking a @MaybeErr SDoc a@ and throwing
 -- an exception if it is an error.
-withException :: TcRnIf gbl lcl (MaybeErr SDoc a) -> TcRnIf gbl lcl a
-withException do_this = do
+withException :: MonadIO m => DynFlags -> m (MaybeErr SDoc a) -> m a
+withException dflags do_this = do
     r <- do_this
-    dflags <- getDynFlags
     case r of
         Failed err -> liftIO $ throwGhcExceptionIO (ProgramError (showSDoc dflags err))
         Succeeded result -> return result
@@ -813,16 +807,14 @@ printForUserTcRn doc = do
     liftIO (printOutputForUser logger dflags printer doc)
 
 {-
-traceIf and traceHiDiffs work in the TcRnIf monad, where no RdrEnv is
+traceIf works in the TcRnIf monad, where no RdrEnv is
 available.  Alas, they behave inconsistently with the other stuff;
 e.g. are unaffected by -dump-to-file.
 -}
 
-traceIf, traceHiDiffs :: SDoc -> TcRnIf m n ()
-traceIf      = traceOptIf Opt_D_dump_if_trace
-traceHiDiffs = traceOptIf Opt_D_dump_hi_diffs
+traceIf :: SDoc -> TcRnIf m n ()
+traceIf = traceOptIf Opt_D_dump_if_trace
 {-# INLINE traceIf #-}
-{-# INLINE traceHiDiffs #-}
   -- see Note [INLINE conditional tracing utilities]
 
 traceOptIf :: DumpFlag -> SDoc -> TcRnIf m n ()