GitLab

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 <codex@openai.com>

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]