diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2021-01-07 16:43:18 +0100 |
---|---|---|
committer | Sylvain Henry <sylvain@haskus.fr> | 2021-02-08 11:36:38 +0100 |
commit | 05e2666af785f2b33395673839a5edf549901d36 (patch) | |
tree | 66337086a5d3f765877fa7e2341efb58803c575e /haddock-api/src/Haddock/Interface.hs | |
parent | 010f0320dff64e3f86091ba4691bc69ce6999647 (diff) |
Update for Logger
Diffstat (limited to 'haddock-api/src/Haddock/Interface.hs')
-rw-r--r-- | haddock-api/src/Haddock/Interface.hs | 18 |
1 files changed, 11 insertions, 7 deletions
diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index fa1f3ee5..f3377965 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -59,15 +59,15 @@ import GHC.Data.Graph.Directed import GHC.Driver.Session hiding (verbosity) import GHC hiding (verbosity) import GHC.Driver.Env -import GHC.Driver.Monad (Session(..), modifySession, reflectGhc) +import GHC.Driver.Monad import GHC.Data.FastString (unpackFS) +import GHC.Utils.Error import GHC.Tc.Types (TcM, TcGblEnv(..)) import GHC.Tc.Utils.Monad (getTopEnv, setGblEnv) import GHC.Tc.Utils.Env (tcLookupGlobal) import GHC.Types.Name (nameIsFromExternalPackage, nameOccName) import GHC.Types.Name.Occurrence (isTcOcc) import GHC.Types.Name.Reader (unQualOK, greMangledName, globalRdrEnvElts) -import GHC.Utils.Error (withTimingD) import GHC.HsToCore.Docs import GHC.Runtime.Loader (initializePlugins) import GHC.Plugins (Outputable, StaticPlugin(..), Plugin(..), PluginWithArgs(..), @@ -113,7 +113,7 @@ processModules verbosity modules flags extIfaces = do mods = Set.fromList $ map ifaceMod interfaces out verbosity verbose "Attaching instances..." interfaces' <- {-# SCC attachInstances #-} - withTimingD "attachInstances" (const ()) $ do + withTimingM "attachInstances" (const ()) $ do attachInstances (exportedNames, mods) interfaces instIfaceMap ms out verbosity verbose "Building cross-linking environment..." @@ -161,7 +161,7 @@ createIfaces verbosity modules flags instIfaceMap = do targets <- mapM (\filePath -> guessTarget filePath Nothing) modules setTargets targets - loadOk <- withTimingD "load" (const ()) $ + loadOk <- withTimingM "load" (const ()) $ {-# SCC load #-} GHC.load LoadAllTargets case loadOk of @@ -212,7 +212,8 @@ plugin verbosity flags instIfaceMap = liftIO $ do | otherwise = do hsc_env <- getTopEnv ifaces <- liftIO $ readIORef ifaceMapRef - (iface, modules) <- withTimingD "processModule" (const ()) $ + (iface, modules) <- withTiming (hsc_logger hsc_env) (hsc_dflags hsc_env) + "processModule" (const ()) $ processModule1 verbosity flags ifaces instIfaceMap hsc_env mod_summary tc_gbl_env liftIO $ do @@ -263,8 +264,11 @@ processModule1 verbosity flags ifaces inst_ifaces hsc_env mod_summary tc_gbl_env unit_state = hsc_units hsc_env - (!interface, messages) <- {-# SCC createInterface #-} - withTimingD "createInterface" (const ()) $ runIfM (fmap Just . tcLookupGlobal) $ + (!interface, messages) <- do + logger <- getLogger + dflags <- getDynFlags + {-# SCC createInterface #-} + withTiming logger dflags "createInterface" (const ()) $ runIfM (fmap Just . tcLookupGlobal) $ createInterface1 flags unit_state mod_summary tc_gbl_env ifaces inst_ifaces |