Refactor FinderCache

3 files changed, 180 insertions, 140 deletions

diff --git a/compiler/GHC/Iface/Env.hs b/compiler/GHC/Iface/Env.hs
index ad62a6232b..2290b5f8bf 100644
--- a/compiler/GHC/Iface/Env.hs
+++ b/compiler/GHC/Iface/Env.hs
@@ -15,7 +15,7 @@ module GHC.Iface.Env (
 
         ifaceExportNames,
 
-        trace_if, trace_hi_diffs, -- FIXME: temporary
+        trace_if, trace_hi_diffs,
 
         -- Name-cache stuff
         allocateGlobalBinder,
@@ -48,6 +48,7 @@ import GHC.Types.SrcLoc
 
 import GHC.Utils.Outputable
 import GHC.Utils.Error
+import GHC.Utils.Logger
 
 import Data.List     ( partition )
 import Control.Monad
@@ -276,10 +277,10 @@ newIfaceNames occs
         ; return [ mkInternalName uniq occ noSrcSpan
                  | (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }
 
-trace_if :: DynFlags -> SDoc -> IO ()
+trace_if :: Logger -> DynFlags -> SDoc -> IO ()
 {-# INLINE trace_if #-}
-trace_if dflags doc = when (dopt Opt_D_dump_if_trace dflags) $ putMsg dflags doc
+trace_if logger dflags doc = when (dopt Opt_D_dump_if_trace dflags) $ putMsg logger dflags doc
 
-trace_hi_diffs :: DynFlags -> SDoc -> IO ()
+trace_hi_diffs :: Logger -> DynFlags -> SDoc -> IO ()
 {-# INLINE trace_hi_diffs #-}
-trace_hi_diffs dflags doc = when (dopt Opt_D_dump_hi_diffs dflags) $ putMsg dflags doc
+trace_hi_diffs logger dflags doc = when (dopt Opt_D_dump_hi_diffs dflags) $ putMsg logger dflags doc
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 6e9ac0b548..534af94d28 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -169,7 +169,8 @@ importDecl :: Name -> IfM lcl (MaybeErr SDoc TyThing)
 importDecl name
   = ASSERT( not (isWiredInName name) )
     do  { dflags <- getDynFlags
-        ; liftIO $ trace_if dflags nd_doc
+        ; logger <- getLogger
+        ; liftIO $ trace_if logger dflags nd_doc
 
         -- Load the interface, which should populate the PTE
         ; mb_iface <- ASSERT2( isExternalName name, ppr name )
@@ -244,7 +245,8 @@ checkWiredInTyCon tc
   | otherwise
   = do  { mod <- getModule
         ; dflags <- getDynFlags
-        ; liftIO $ trace_if dflags (text "checkWiredInTyCon" <+> ppr tc_name $$ ppr mod)
+        ; logger <- getLogger
+        ; liftIO $ trace_if logger dflags (text "checkWiredInTyCon" <+> ppr tc_name $$ ppr mod)
         ; ASSERT( isExternalName tc_name )
           when (mod /= nameModule tc_name)
                (initIfaceTcRn (loadWiredInHomeIface tc_name))
@@ -315,12 +317,16 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg
   -- and create a ModLocation.  If successful, loadIface will read the
   -- interface; it will call the Finder again, but the ModLocation will be
   -- cached from the first search.
-  = do { hsc_env <- getTopEnv
-       ; res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
-       ; case res of
+  = do hsc_env <- getTopEnv
+       let fc = hsc_FC hsc_env
+       let dflags = hsc_dflags hsc_env
+       let units = hsc_units hsc_env
+       let home_unit = hsc_home_unit hsc_env
+       res <- liftIO $ findImportedModule fc units home_unit dflags mod maybe_pkg
+       case res of
            Found _ mod -> initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
            -- TODO: Make sure this error message is good
-           err         -> return (Failed (cannotFindModule hsc_env mod err)) }
+           err         -> return (Failed (cannotFindModule hsc_env mod err))
 
 -- | Load interface directly for a fully qualified 'Module'.  (This is a fairly
 -- rare operation, but in particular it is used to load orphan modules
@@ -445,8 +451,9 @@ loadInterface doc_str mod from
           (eps,hpt) <- getEpsAndHpt
         ; gbl_env <- getGblEnv
         ; dflags <- getDynFlags
+        ; logger <- getLogger
 
-        ; liftIO $ trace_if dflags (text "Considering whether to load" <+> ppr mod <+> ppr from)
+        ; liftIO $ trace_if logger dflags (text "Considering whether to load" <+> ppr mod <+> ppr from)
 
                 -- Check whether we have the interface already
         ; hsc_env <- getTopEnv
@@ -681,20 +688,25 @@ computeInterface
   -> Module
   -> IO (MaybeErr SDoc (ModIface, FilePath))
 computeInterface hsc_env doc_str hi_boot_file mod0 = do
-    MASSERT( not (isHoleModule mod0) )
-    let home_unit = hsc_home_unit hsc_env
-    case getModuleInstantiation mod0 of
-        (imod, Just indef) | isHomeUnitIndefinite home_unit -> do
-            r <- findAndReadIface hsc_env doc_str imod mod0 hi_boot_file
-            case r of
-                Succeeded (iface0, path) -> do
-                    r <- rnModIface hsc_env (instUnitInsts (moduleUnit indef))
-                                   Nothing iface0
-                    case r of
-                        Right x -> return (Succeeded (x, path))
-                        Left errs -> throwIO . mkSrcErr $ errs
-                Failed err -> return (Failed err)
-        (mod, _) -> findAndReadIface hsc_env doc_str mod mod0 hi_boot_file
+  MASSERT( not (isHoleModule mod0) )
+  let name_cache = hsc_NC hsc_env
+  let fc         = hsc_FC hsc_env
+  let home_unit  = hsc_home_unit hsc_env
+  let units      = hsc_units hsc_env
+  let dflags     = hsc_dflags hsc_env
+  let logger     = hsc_logger hsc_env
+  let hooks      = hsc_hooks hsc_env
+  let find_iface m = findAndReadIface logger name_cache fc hooks units home_unit dflags doc_str
+                                      m mod0 hi_boot_file
+  case getModuleInstantiation mod0 of
+      (imod, Just indef) | isHomeUnitIndefinite home_unit ->
+        find_iface imod >>= \case
+          Succeeded (iface0, path) ->
+            rnModIface hsc_env (instUnitInsts (moduleUnit indef)) Nothing iface0 >>= \case
+              Right x   -> return (Succeeded (x, path))
+              Left errs -> throwIO . mkSrcErr $ errs
+          Failed err -> return (Failed err)
+      (mod, _) -> find_iface mod
 
 -- | Compute the signatures which must be compiled in order to
 -- load the interface for a 'Module'.  The output of this function
@@ -714,8 +726,9 @@ moduleFreeHolesPrecise doc_str mod
    case getModuleInstantiation mod of
     (imod, Just indef) -> do
         dflags <- getDynFlags
+        logger <- getLogger
         let insts = instUnitInsts (moduleUnit indef)
-        liftIO $ trace_if dflags (text "Considering whether to load" <+> ppr mod <+>
+        liftIO $ trace_if logger 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
@@ -731,7 +744,16 @@ moduleFreeHolesPrecise doc_str mod
             _otherwise -> Nothing
     readAndCache imod insts = do
         hsc_env <- getTopEnv
-        mb_iface <- liftIO $ findAndReadIface hsc_env (text "moduleFreeHolesPrecise" <+> doc_str) imod mod NotBoot
+        let nc        = hsc_NC hsc_env
+        let fc        = hsc_FC hsc_env
+        let home_unit = hsc_home_unit hsc_env
+        let units     = hsc_units hsc_env
+        let dflags    = hsc_dflags hsc_env
+        let logger    = hsc_logger hsc_env
+        let hooks     = hsc_hooks hsc_env
+        mb_iface <- liftIO $ findAndReadIface logger nc fc hooks units home_unit dflags
+                                              (text "moduleFreeHolesPrecise" <+> doc_str)
+                                              imod mod NotBoot
         case mb_iface of
             Succeeded (iface, _) -> do
                 let ifhs = mi_free_holes iface
@@ -820,32 +842,25 @@ This actually happened with P=base, Q=ghc-prim, via the AMP warnings.
 See #8320.
 -}
 
-findAndReadIface :: HscEnv
-                 -> SDoc
-                 -- The unique identifier of the on-disk module we're
-                 -- looking for
-                 -> InstalledModule
-                 -- The *actual* module we're looking for.  We use
-                 -- this to check the consistency of the requirements
-                 -- of the module we read out.
-                 -> Module
-                 -> IsBootInterface     -- True  <=> Look for a .hi-boot file
-                                        -- False <=> Look for .hi file
-                 -> 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 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 = hsc_NC hsc_env
-  let unit_state = hsc_units hsc_env
+findAndReadIface
+  :: Logger
+  -> NameCache
+  -> FinderCache
+  -> Hooks
+  -> UnitState
+  -> HomeUnit
+  -> DynFlags
+  -> SDoc            -- ^ Reason for loading the iface (used for tracing)
+  -> InstalledModule -- ^ The unique identifier of the on-disk module we're looking for
+  -> Module          -- ^ The *actual* module we're looking for.  We use
+                     -- this to check the consistency of the requirements of the
+                     -- module we read out.
+  -> IsBootInterface -- ^ Looking for .hi-boot or .hi file
+  -> IO (MaybeErr SDoc (ModIface, FilePath))
+findAndReadIface logger name_cache fc hooks unit_state home_unit dflags doc_str mod wanted_mod hi_boot_file = do
+  let profile = targetProfile dflags
 
-  trace_if dflags (sep [hsep [text "Reading",
+  trace_if logger dflags (sep [hsep [text "Reading",
                            if hi_boot_file == IsBoot
                              then text "[boot]"
                              else Outputable.empty,
@@ -858,14 +873,13 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
   -- 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)
+          mb_found <- liftIO (findExactModule fc dflags unit_state home_unit mod)
           case mb_found of
               InstalledFound loc mod -> do
                   -- Found file, so read it
@@ -875,53 +889,54 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
                      not (isOneShot (ghcMode dflags))
                       then return (Failed (homeModError mod loc))
                       else do
-                        r <- read_file name_cache unit_state dflags wanted_mod file_path
+                        r <- read_file logger 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
+                            -> load_dynamic_too_maybe logger name_cache unit_state
                                                       dflags wanted_mod
                                                       hi_boot_file iface fp
                         return r
               err -> do
-                  trace_if dflags (text "...not found")
+                  trace_if logger dflags (text "...not found")
                   return $ Failed $ cannotFindInterface
-                                      unit_env
+                                      unit_state
+                                      home_unit
                                       profile
-                                      (may_show_locations (hsc_dflags hsc_env))
+                                      (may_show_locations dflags)
                                       (moduleName mod)
                                       err
 
 -- | Check if we need to try the dynamic interface for -dynamic-too
-load_dynamic_too_maybe :: NameCache -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> FilePath -> IO ()
-load_dynamic_too_maybe name_cache unit_state dflags wanted_mod is_boot iface file_path
+load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> FilePath -> IO ()
+load_dynamic_too_maybe logger 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
+      DT_Dyn    -> load_dynamic_too logger name_cache unit_state dflags wanted_mod is_boot iface file_path
+      DT_OK     -> load_dynamic_too logger name_cache unit_state (setDynamicNow dflags) wanted_mod is_boot iface file_path
 
-load_dynamic_too :: NameCache -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> FilePath -> IO ()
-load_dynamic_too name_cache unit_state dflags wanted_mod is_boot iface file_path = do
+load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> FilePath -> IO ()
+load_dynamic_too logger 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
+  read_file logger 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")
+        do trace_if logger dflags (text "Dynamic hash doesn't match")
            setDynamicTooFailed dflags
     Failed err ->
-        do trace_if dflags (text "Failed to load dynamic interface file:" $$ err)
+        do trace_if logger dflags (text "Failed to load dynamic interface file:" $$ err)
            setDynamicTooFailed dflags
 
-read_file :: NameCache -> 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)
+read_file :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath -> IO (MaybeErr SDoc (ModIface, FilePath))
+read_file logger name_cache unit_state dflags wanted_mod file_path = do
+  trace_if logger 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
@@ -1282,25 +1297,24 @@ homeModError mod location
 -- -----------------------------------------------------------------------------
 -- Error messages
 
-cannotFindInterface :: UnitEnv -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc
+cannotFindInterface :: UnitState -> HomeUnit -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc
 cannotFindInterface = cantFindInstalledErr (sLit "Failed to load interface for")
                                            (sLit "Ambiguous interface for")
 
 cantFindInstalledErr
     :: PtrString
     -> PtrString
-    -> UnitEnv
+    -> UnitState
+    -> HomeUnit
     -> Profile
     -> ([FilePath] -> SDoc)
     -> ModuleName
     -> InstalledFindResult
     -> SDoc
-cantFindInstalledErr cannot_find _ unit_env profile tried_these mod_name find_result
+cantFindInstalledErr cannot_find _ unit_state home_unit profile tried_these mod_name find_result
   = ptext cannot_find <+> quotes (ppr mod_name)
     $$ more_info
   where
-    home_unit  = ue_home_unit unit_env
-    unit_state = ue_units unit_env
     build_tag  = waysBuildTag (profileWays profile)
 
     more_info
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index e211f221ab..409cb712f2 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -41,6 +41,7 @@ import GHC.Utils.Misc as Utils hiding ( eqListBy )
 import GHC.Utils.Binary
 import GHC.Utils.Fingerprint
 import GHC.Utils.Exception
+import GHC.Utils.Logger
 
 import GHC.Types.Annotations
 import GHC.Types.Name
@@ -157,10 +158,11 @@ check_old_iface
 
 check_old_iface hsc_env mod_summary src_modified maybe_iface
   = let dflags = hsc_dflags hsc_env
+        logger = hsc_logger hsc_env
         getIface =
             case maybe_iface of
                 Just _  -> do
-                    trace_if dflags (text "We already have the old interface for" <+>
+                    trace_if logger dflags (text "We already have the old interface for" <+>
                       ppr (ms_mod mod_summary))
                     return maybe_iface
                 Nothing -> loadIface
@@ -171,20 +173,20 @@ check_old_iface hsc_env mod_summary src_modified maybe_iface
              read_result <- readIface dflags ncu (ms_mod mod_summary) iface_path
              case read_result of
                  Failed err -> do
-                     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)
+                     trace_if logger dflags (text "FYI: cannot read old interface file:" $$ nest 4 err)
+                     trace_hi_diffs logger dflags (text "Old interface file was invalid:" $$ nest 4 err)
                      return Nothing
                  Succeeded iface -> do
-                     trace_if dflags (text "Read the interface file" <+> text iface_path)
+                     trace_if logger dflags (text "Read the interface file" <+> text iface_path)
                      return $ Just iface
 
         src_changed
-            | gopt Opt_ForceRecomp (hsc_dflags hsc_env) = True
+            | gopt Opt_ForceRecomp dflags    = True
             | SourceModified <- src_modified = True
             | otherwise = False
     in do
         when src_changed $
-            liftIO $ trace_hi_diffs dflags (nest 4 $ text "Source file changed or recompilation check turned off")
+            liftIO $ trace_hi_diffs logger 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,
@@ -227,7 +229,7 @@ checkVersions :: HscEnv
               -> ModIface       -- Old interface
               -> IfG (RecompileRequired, Maybe ModIface)
 checkVersions hsc_env mod_summary iface
-  = do { liftIO $ trace_hi_diffs dflags
+  = do { liftIO $ trace_hi_diffs logger dflags
                         (text "Considering whether compilation is required for" <+>
                         ppr (mi_module iface) <> colon)
 
@@ -245,7 +247,7 @@ checkVersions hsc_env mod_summary iface
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
        ; recomp <- liftIO $ checkMergedSignatures hsc_env mod_summary iface
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
-       ; recomp <- liftIO $ checkHsig hsc_env mod_summary iface
+       ; recomp <- liftIO $ checkHsig logger home_unit dflags mod_summary iface
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
        ; recomp <- pure (checkHie dflags mod_summary)
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
@@ -274,6 +276,7 @@ checkVersions hsc_env mod_summary iface
        ; return (recomp, Just iface)
     }}}}}}}}}}
   where
+    logger = hsc_logger hsc_env
     dflags = hsc_dflags hsc_env
     home_unit = hsc_home_unit hsc_env
     -- This is a bit of a hack really
@@ -352,15 +355,13 @@ pluginRecompileToRecompileRequired old_fp new_fp pr
 
 -- | Check if an hsig file needs recompilation because its
 -- implementing module has changed.
-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
+checkHsig :: Logger -> HomeUnit -> DynFlags -> ModSummary -> ModIface -> IO RecompileRequired
+checkHsig logger home_unit dflags mod_summary iface = do
+    let 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 dflags (text "implementing module unchanged")
+        True -> up_to_date logger dflags (text "implementing module unchanged")
         False -> return (RecompBecause "implementing module changed")
 
 -- | Check if @.hie@ file is out of date or missing.
@@ -382,11 +383,12 @@ checkHie dflags mod_summary =
 checkFlagHash :: HscEnv -> ModIface -> IO RecompileRequired
 checkFlagHash hsc_env iface = do
     let dflags   = hsc_dflags hsc_env
+    let logger   = hsc_logger hsc_env
     let old_hash = mi_flag_hash (mi_final_exts iface)
     new_hash <- fingerprintDynFlags hsc_env (mi_module iface) putNameLiterally
     case old_hash == new_hash of
-        True  -> up_to_date dflags (text "Module flags unchanged")
-        False -> out_of_date_hash dflags "flags changed"
+        True  -> up_to_date logger dflags (text "Module flags unchanged")
+        False -> out_of_date_hash logger dflags "flags changed"
                      (text "  Module flags have changed")
                      old_hash new_hash
 
@@ -394,15 +396,16 @@ checkFlagHash hsc_env iface = do
 checkOptimHash :: HscEnv -> ModIface -> IO RecompileRequired
 checkOptimHash hsc_env iface = do
     let dflags   = hsc_dflags hsc_env
+    let logger   = hsc_logger hsc_env
     let old_hash = mi_opt_hash (mi_final_exts iface)
     new_hash <- fingerprintOptFlags (hsc_dflags hsc_env)
                                                putNameLiterally
     if | old_hash == new_hash
-         -> up_to_date dflags (text "Optimisation flags unchanged")
+         -> up_to_date logger dflags (text "Optimisation flags unchanged")
        | gopt Opt_IgnoreOptimChanges (hsc_dflags hsc_env)
-         -> up_to_date dflags (text "Optimisation flags changed; ignoring")
+         -> up_to_date logger dflags (text "Optimisation flags changed; ignoring")
        | otherwise
-         -> out_of_date_hash dflags "Optimisation flags changed"
+         -> out_of_date_hash logger dflags "Optimisation flags changed"
                      (text "  Optimisation flags have changed")
                      old_hash new_hash
 
@@ -410,15 +413,16 @@ checkOptimHash hsc_env iface = do
 checkHpcHash :: HscEnv -> ModIface -> IO RecompileRequired
 checkHpcHash hsc_env iface = do
     let dflags   = hsc_dflags hsc_env
+    let logger   = hsc_logger hsc_env
     let old_hash = mi_hpc_hash (mi_final_exts iface)
     new_hash <- fingerprintHpcFlags (hsc_dflags hsc_env)
                                                putNameLiterally
     if | old_hash == new_hash
-         -> up_to_date dflags (text "HPC flags unchanged")
+         -> up_to_date logger dflags (text "HPC flags unchanged")
        | gopt Opt_IgnoreHpcChanges (hsc_dflags hsc_env)
-         -> up_to_date dflags (text "HPC flags changed; ignoring")
+         -> up_to_date logger dflags (text "HPC flags changed; ignoring")
        | otherwise
-         -> out_of_date_hash dflags "HPC flags changed"
+         -> out_of_date_hash logger dflags "HPC flags changed"
                      (text "  HPC flags have changed")
                      old_hash new_hash
 
@@ -427,6 +431,7 @@ checkHpcHash hsc_env iface = do
 checkMergedSignatures :: HscEnv -> ModSummary -> ModIface -> IO RecompileRequired
 checkMergedSignatures hsc_env mod_summary iface = do
     let dflags     = hsc_dflags hsc_env
+    let logger     = hsc_logger 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)
@@ -434,7 +439,7 @@ checkMergedSignatures hsc_env mod_summary iface = do
                         Nothing -> []
                         Just r -> sort $ map (instModuleToModule unit_state) r
     if old_merged == new_merged
-        then up_to_date dflags (text "signatures to merge in unchanged" $$ ppr new_merged)
+        then up_to_date logger 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
@@ -470,20 +475,23 @@ checkDependencies hsc_env summary iface
              checkIfAllOldHomeDependenciesAreSeen seen_home_deps
            _ -> return recomp]
  where
-   dflags = hsc_dflags hsc_env
+   dflags        = hsc_dflags hsc_env
+   logger        = hsc_logger hsc_env
+   fc            = hsc_FC hsc_env
+   home_unit     = hsc_home_unit hsc_env
+   units         = hsc_units 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 <- findImportedModule hsc_env mod (mb_pkg)
+     find_res <- findImportedModule fc units home_unit dflags 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 trace_hi_diffs dflags $
+                 then do trace_hi_diffs logger dflags $
                            text "imported module " <> quotes (ppr mod) <>
                            text " not among previous dependencies"
                          return (RecompBecause reason)
@@ -491,7 +499,7 @@ checkDependencies hsc_env summary iface
                          return UpToDate
           | otherwise
            -> if toUnitId pkg `notElem` (map fst prev_dep_pkgs)
-                 then do trace_hi_diffs dflags $
+                 then do trace_hi_diffs logger dflags $
                            text "imported module " <> quotes (ppr mod) <>
                            text " is from package " <> quotes (ppr pkg) <>
                            text ", which is not among previous dependencies"
@@ -517,13 +525,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 -> liftIO $ do
+         mb_result <- getFromModIface "need mi_deps for" mod $ \imported_iface -> 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
-               trace_hi_diffs dflags $
+               trace_hi_diffs logger dflags $
                  text "imported home module " <> quotes (ppr mod) <>
                  text " has a new dependency " <> quotes (ppr new_dep_mname)
                return (RecompBecause reason, [])
@@ -548,7 +556,7 @@ checkDependencies hsc_env summary iface
      if not (null unseen_old_deps)
        then do
          let missing_dep = Set.elemAt 0 unseen_old_deps
-         trace_hi_diffs dflags $
+         trace_hi_diffs logger dflags $
            text "missing old home dependency " <> quotes (ppr missing_dep)
          return $ RecompBecause "missing old dependency"
        else return UpToDate
@@ -560,18 +568,19 @@ needInterface mod continue
       mb_recomp <- getFromModIface
         "need version info for"
         mod
-        (liftIO . continue)
+        continue
       case mb_recomp of
         Nothing -> return MustCompile
         Just recomp -> return recomp
 
-getFromModIface :: String -> Module -> (ModIface -> IfG a)
+getFromModIface :: String -> Module -> (ModIface -> IO a)
               -> IfG (Maybe a)
 getFromModIface doc_msg mod getter
   = do  -- Load the imported interface if possible
     dflags <- getDynFlags
+    logger <- getLogger
     let doc_str = sep [text doc_msg, ppr mod]
-    liftIO $ trace_hi_diffs dflags (text "Checking innterface for module" <+> ppr mod)
+    liftIO $ trace_hi_diffs logger dflags (text "Checking interface for module" <+> ppr mod)
 
     mb_iface <- loadInterface doc_str mod ImportBySystem
         -- Load the interface, but don't complain on failure;
@@ -579,13 +588,13 @@ getFromModIface doc_msg mod getter
 
     case mb_iface of
       Failed _ -> do
-        liftIO $ trace_hi_diffs dflags (sep [text "Couldn't load interface for module", ppr mod])
+        liftIO $ trace_hi_diffs logger 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
                   -- just be that the current module doesn't need that
                   -- import and it's been deleted
-      Succeeded iface -> Just <$> getter iface
+      Succeeded iface -> Just <$> liftIO (getter iface)
 
 -- | Given the usage information extracted from the old
 -- M.hi file for the module being compiled, figure out
@@ -595,9 +604,10 @@ checkModUsage _this_pkg UsagePackageModule{
                                 usg_mod = mod,
                                 usg_mod_hash = old_mod_hash } = do
   dflags <- getDynFlags
+  logger <- getLogger
   needInterface mod $ \iface -> do
     let reason = moduleNameString (moduleName mod) ++ " changed"
-    checkModuleFingerprint dflags reason old_mod_hash (mi_mod_hash (mi_final_exts iface))
+    checkModuleFingerprint logger 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
@@ -605,9 +615,10 @@ checkModUsage _this_pkg UsagePackageModule{
 
 checkModUsage _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_hash } = do
   dflags <- getDynFlags
+  logger <- getLogger
   needInterface mod $ \iface -> do
     let reason = moduleNameString (moduleName mod) ++ " changed (raw)"
-    checkModuleFingerprint dflags reason old_mod_hash (mi_mod_hash (mi_final_exts iface))
+    checkModuleFingerprint logger dflags reason old_mod_hash (mi_mod_hash (mi_final_exts iface))
 
 checkModUsage this_pkg UsageHomeModule{
                                 usg_mod_name = mod_name,
@@ -617,6 +628,7 @@ checkModUsage this_pkg UsageHomeModule{
   = do
     let mod = mkModule this_pkg mod_name
     dflags <- getDynFlags
+    logger <- getLogger
     needInterface mod $ \iface -> do
      let
          new_mod_hash    = mi_mod_hash (mi_final_exts iface)
@@ -627,20 +639,20 @@ checkModUsage this_pkg UsageHomeModule{
 
      liftIO $ do
            -- CHECK MODULE
-       recompile <- checkModuleFingerprint dflags reason old_mod_hash new_mod_hash
+       recompile <- checkModuleFingerprint logger dflags reason old_mod_hash new_mod_hash
        if not (recompileRequired recompile)
          then return UpToDate
          else
            -- CHECK EXPORT LIST
-           checkMaybeHash dflags reason maybe_old_export_hash new_export_hash
+           checkMaybeHash logger dflags reason maybe_old_export_hash new_export_hash
                (text "  Export list changed") $ do
 
                  -- CHECK ITEMS ONE BY ONE
-                 recompile <- checkList [ checkEntityUsage dflags reason new_decl_hash u
+                 recompile <- checkList [ checkEntityUsage logger 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 dflags (text "  Great!  The bits I use are up to date")
+                   else up_to_date logger dflags (text "  Great!  The bits I use are up to date")
 
 
 checkModUsage _this_pkg UsageFile{ usg_file_path = file,
@@ -661,52 +673,65 @@ checkModUsage _this_pkg UsageFile{ usg_file_path = file,
 #endif
 
 ------------------------
-checkModuleFingerprint :: DynFlags -> String -> Fingerprint -> Fingerprint
-                       -> IO RecompileRequired
-checkModuleFingerprint dflags reason old_mod_hash new_mod_hash
+checkModuleFingerprint
+  :: Logger
+  -> DynFlags
+  -> String
+  -> Fingerprint
+  -> Fingerprint
+  -> IO RecompileRequired
+checkModuleFingerprint logger dflags reason old_mod_hash new_mod_hash
   | new_mod_hash == old_mod_hash
-  = up_to_date dflags (text "Module fingerprint unchanged")
+  = up_to_date logger dflags (text "Module fingerprint unchanged")
 
   | otherwise
-  = out_of_date_hash dflags reason (text "  Module fingerprint has changed")
+  = out_of_date_hash logger dflags reason (text "  Module fingerprint has changed")
                      old_mod_hash new_mod_hash
 
 ------------------------
-checkMaybeHash :: DynFlags -> String -> Maybe Fingerprint -> Fingerprint -> SDoc
-               -> IO RecompileRequired -> IO RecompileRequired
-checkMaybeHash dflags reason maybe_old_hash new_hash doc continue
+checkMaybeHash
+  :: Logger
+  -> DynFlags
+  -> String
+  -> Maybe Fingerprint
+  -> Fingerprint
+  -> SDoc
+  -> IO RecompileRequired
+  -> IO RecompileRequired
+checkMaybeHash logger dflags reason maybe_old_hash new_hash doc continue
   | Just hash <- maybe_old_hash, hash /= new_hash
-  = out_of_date_hash dflags reason doc hash new_hash
+  = out_of_date_hash logger dflags reason doc hash new_hash
   | otherwise
   = continue
 
 ------------------------
-checkEntityUsage :: DynFlags
+checkEntityUsage :: Logger
+                 -> DynFlags
                  -> String
                  -> (OccName -> Maybe (OccName, Fingerprint))
                  -> (OccName, Fingerprint)
                  -> IO RecompileRequired
-checkEntityUsage dflags reason new_hash (name,old_hash) = do
+checkEntityUsage logger 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])
+    Nothing       -> out_of_date logger 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))
+      -> do trace_hi_diffs logger 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
+      -> out_of_date_hash logger 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
+up_to_date :: Logger -> DynFlags -> SDoc -> IO RecompileRequired
+up_to_date logger dflags msg = trace_hi_diffs logger 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 :: Logger -> DynFlags -> String -> SDoc -> IO RecompileRequired
+out_of_date logger dflags reason msg = trace_hi_diffs logger 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])
+out_of_date_hash :: Logger -> DynFlags -> String -> SDoc -> Fingerprint -> Fingerprint -> IO RecompileRequired
+out_of_date_hash logger dflags reason msg old_hash new_hash
+  = out_of_date logger dflags reason (hsep [msg, ppr old_hash, text "->", ppr new_hash])
 
 ----------------------
 checkList :: Monad m => [m RecompileRequired] -> m RecompileRequired