DynFlags: merge_databases

1 files changed, 11 insertions, 9 deletions

diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index 2a68c36f12..9e441eaf4d 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -1273,15 +1273,15 @@ type UnitPrecedenceMap = Map UnitId Int
 -- packages with the same unit id in later databases override
 -- earlier ones.  This does NOT check if the resulting database
 -- makes sense (that's done by 'validateDatabase').
-mergeDatabases :: DynFlags -> [UnitDatabase UnitId]
+mergeDatabases :: (SDoc -> IO ()) -> [UnitDatabase UnitId]
                -> IO (UnitInfoMap, UnitPrecedenceMap)
-mergeDatabases dflags = foldM merge (Map.empty, Map.empty) . zip [1..]
+mergeDatabases printer = foldM merge (Map.empty, Map.empty) . zip [1..]
   where
     merge (pkg_map, prec_map) (i, UnitDatabase db_path db) = do
-      debugTraceMsg dflags 2 $
+      printer $
           text "loading package database" <+> text db_path
       forM_ (Set.toList override_set) $ \pkg ->
-          debugTraceMsg dflags 2 $
+          printer $
               text "package" <+> ppr pkg <+>
               text "overrides a previously defined package"
       return (pkg_map', prec_map')
@@ -1423,22 +1423,24 @@ mkUnitState dflags dbs = do
           we build a mapping saying what every in scope module name points to.
 -}
 
+  let printer = debugTraceMsg dflags 2
+
   -- This, and the other reverse's that you will see, are due to the fact that
   -- packageFlags, pluginPackageFlags, etc. are all specified in *reverse* order
   -- than they are on the command line.
   let other_flags = reverse (packageFlags dflags)
-  debugTraceMsg dflags 2 $
+  printer $
       text "package flags" <+> ppr other_flags
 
   -- Merge databases together, without checking validity
-  (pkg_map1, prec_map) <- mergeDatabases dflags dbs
+  (pkg_map1, prec_map) <- mergeDatabases printer dbs
 
   -- Now that we've merged everything together, prune out unusable
   -- packages.
   let (pkg_map2, unusable, sccs) = validateDatabase dflags pkg_map1
 
-  reportCycles (debugTraceMsg dflags 2) sccs
-  reportUnusable (debugTraceMsg dflags 2) unusable
+  reportCycles   printer sccs
+  reportUnusable printer unusable
 
   -- Apply trust flags (these flags apply regardless of whether
   -- or not packages are visible or not)
@@ -1509,7 +1511,7 @@ mkUnitState dflags dbs = do
   -- it modifies the unit ids of wired in packages, but when we process
   -- package arguments we need to key against the old versions.
   --
-  (pkgs2, wired_map) <- findWiredInUnits (debugTraceMsg dflags 2) prec_map pkgs1 vis_map2
+  (pkgs2, wired_map) <- findWiredInUnits printer prec_map pkgs1 vis_map2
   let pkg_db = mkUnitInfoMap pkgs2
 
   -- Update the visibility map, so we treat wired packages as visible.