Cheng Shao pushed to branch wip/floatout-verbosity-check at Glasgow Haskell Compiler / GHC
Commits:
8da5121c by Cheng Shao at 2026-03-02T21:42:28+00:00
compiler: avoid unneeded traversals in GHC.Unit.State
Following !15591, this patch avoids unneeded traversals in
`reportCycles`/`reportUnusable` when log verbosity is below given
threshold. Also applies `logVerbAtLeast` when appropriate.
Co-authored-by: Codex
- - - - -
2 changed files:
- compiler/GHC/Unit/State.hs
- compiler/GHC/Utils/Error.hs
Changes:
=====================================
compiler/GHC/Unit/State.hs
=====================================
@@ -1279,7 +1279,7 @@ pprReason pref reason = case reason of
nest 2 (hsep (map ppr deps))
reportCycles :: Logger -> [SCC UnitInfo] -> IO ()
-reportCycles logger sccs = mapM_ report sccs
+reportCycles logger sccs = when (logVerbAtLeast logger 2) $ mapM_ report sccs
where
report (AcyclicSCC _) = return ()
report (CyclicSCC vs) =
@@ -1288,7 +1288,7 @@ reportCycles logger sccs = mapM_ report sccs
nest 2 (hsep (map (ppr . unitId) vs))
reportUnusable :: Logger -> UnusableUnits -> IO ()
-reportUnusable logger pkgs = mapM_ report (nonDetUniqMapToList pkgs)
+reportUnusable logger pkgs = when (logVerbAtLeast logger 2) $ mapM_ report (nonDetUniqMapToList pkgs)
where
report (ipid, (_, reason)) =
debugTraceMsg logger 2 $
@@ -1389,7 +1389,7 @@ mergeDatabases logger = foldM merge (emptyUniqMap, emptyUniqMap) . zip [1..]
merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do
debugTraceMsg logger 2 $
text "loading package database" <+> ppr db_path
- when (log_verbosity (logFlags logger) >= 2) $
+ when (logVerbAtLeast logger 2) $
forM_ (Set.toList override_set) $ \pkg ->
debugTraceMsg logger 2 $
text "package" <+> ppr pkg <+>
=====================================
compiler/GHC/Utils/Error.hs
=====================================
@@ -463,7 +463,7 @@ withTiming' logger what force_result prtimings action
debugTraceMsg :: Logger -> Int -> SDoc -> IO ()
debugTraceMsg logger val msg =
- when (log_verbosity (logFlags logger) >= val) $
+ when (logVerbAtLeast logger val) $
logInfo logger (withPprStyle defaultDumpStyle msg)
{-# INLINE debugTraceMsg #-} -- see Note [INLINE conditional tracing utilities]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8da5121cf870d86854281e69c4308474...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8da5121cf870d86854281e69c4308474...
You're receiving this email because of your account on gitlab.haskell.org.
