Use UniqDFM for HomePackageTable

This isn't strictly necessary for deterministic ABIs.
The results of eltsHpt are consumed in two ways:
1) they determine the order of linking
2) if you track the data flow all the family instances get put in
   FamInstEnvs, so the nondeterministic order is forgotten.
3) same for VectInfo stuff
4) same for Annotations

The problem is that I haven't found a nice way to do 2. in
a local way and 1. is nice to have if we went for deterministic
object files. Besides these maps are keyed on ModuleNames so they
should be small relative to other things and the overhead should
be negligible.

As a bonus we also get more specific names.

Test Plan: ./validate

Reviewers: bgamari, austin, hvr, ezyang, simonmar

Reviewed By: simonmar

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2300

GHC Trac Issues: #4012

10 files changed, 104 insertions, 49 deletions

diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs
index 5755c28501..aa886bb6d9 100644
--- a/compiler/basicTypes/Module.hs
+++ b/compiler/basicTypes/Module.hs
@@ -72,7 +72,7 @@ module Module
         foldModuleEnv, extendModuleEnvWith, filterModuleEnv,
 
         -- * ModuleName mappings
-        ModuleNameEnv,
+        ModuleNameEnv, DModuleNameEnv,
 
         -- * Sets of Modules
         ModuleSet,
@@ -83,6 +83,7 @@ import Config
 import Outputable
 import Unique
 import UniqFM
+import UniqDFM
 import FastString
 import Binary
 import Util
@@ -600,3 +601,8 @@ UniqFM.
 
 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
 type ModuleNameEnv elt = UniqFM elt
+
+
+-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
+-- Has deterministic folds and can be deterministically converted to a list
+type DModuleNameEnv elt = UniqDFM elt
diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index 0f15ea2877..2df8840c1c 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -37,7 +37,6 @@ import Finder
 import HscTypes
 import Name
 import NameEnv
-import UniqFM
 import Module
 import ListSetOps
 import DynFlags
@@ -658,7 +657,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
         -- This one is a build-system bug
 
     get_linkable osuf mod_name      -- A home-package module
-        | Just mod_info <- lookupUFM hpt mod_name
+        | Just mod_info <- lookupHpt hpt mod_name
         = adjust_linkable (Maybes.expectJust "getLinkDeps" (hm_linkable mod_info))
         | otherwise
         = do    -- It's not in the HPT because we are in one shot mode,
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index 12980475b2..694bbd7c92 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -189,7 +189,7 @@ tcHiBootIface hsc_src mod
                 -- And that's fine, because if M's ModInfo is in the HPT, then
                 -- it's been compiled once, and we don't need to check the boot iface
           then do { hpt <- getHpt
-                 ; case lookupUFM hpt (moduleName mod) of
+                 ; case lookupHpt hpt (moduleName mod) of
                       Just info | mi_boot (hm_iface info)
                                 -> return (mkSelfBootInfo (hm_details info))
                       _ -> return NoSelfBoot }
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 586754fe1c..5d648e60f9 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -46,7 +46,6 @@ import Finder
 import HscTypes hiding ( Hsc )
 import Outputable
 import Module
-import UniqFM           ( eltsUFM )
 import ErrUtils
 import DynFlags
 import Config
@@ -353,7 +352,7 @@ link' dflags batch_attempt_linking hpt
                           LinkStaticLib -> True
                           _ -> platformBinariesAreStaticLibs (targetPlatform dflags)
 
-            home_mod_infos = eltsUFM hpt
+            home_mod_infos = eltsHpt hpt
 
             -- the packages we depend on
             pkg_deps  = concatMap (map fst . dep_pkgs . mi_deps . hm_iface) home_mod_infos
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 0105607ffb..40aa7dfa01 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -329,7 +329,6 @@ import StaticFlags
 import SysTools
 import Annotations
 import Module
-import UniqFM
 import Panic
 import Platform
 import Bag              ( unitBag )
@@ -943,7 +942,7 @@ loadModule tcm = do
                                     hsc_env ms 1 1 Nothing mb_linkable
                                     source_modified
 
-   modifySession $ \e -> e{ hsc_HPT = addToUFM (hsc_HPT e) mod mod_info }
+   modifySession $ \e -> e{ hsc_HPT = addToHpt (hsc_HPT e) mod mod_info }
    return tcm
 
 
@@ -1058,7 +1057,7 @@ needsTemplateHaskell ms =
 -- | Return @True@ <==> module is loaded.
 isLoaded :: GhcMonad m => ModuleName -> m Bool
 isLoaded m = withSession $ \hsc_env ->
-  return $! isJust (lookupUFM (hsc_HPT hsc_env) m)
+  return $! isJust (lookupHpt (hsc_HPT hsc_env) m)
 
 -- | Return the bindings for the current interactive session.
 getBindings :: GhcMonad m => m [TyThing]
@@ -1134,7 +1133,7 @@ getPackageModuleInfo _hsc_env _mdl = do
 
 getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
 getHomeModuleInfo hsc_env mdl =
-  case lookupUFM (hsc_HPT hsc_env) (moduleName mdl) of
+  case lookupHpt (hsc_HPT hsc_env) (moduleName mdl) of
     Nothing  -> return Nothing
     Just hmi -> do
       let details = hm_details hmi
@@ -1419,7 +1418,7 @@ lookupModule mod_name Nothing = withSession $ \hsc_env -> do
 
 lookupLoadedHomeModule :: GhcMonad m => ModuleName -> m (Maybe Module)
 lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
-  case lookupUFM (hsc_HPT hsc_env) mod_name of
+  case lookupHpt (hsc_HPT hsc_env) mod_name of
     Just mod_info      -> return (Just (mi_module (hm_iface mod_info)))
     _not_a_home_module -> return Nothing
 
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index af78065bde..c02ad7a671 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -222,7 +222,7 @@ load how_much = do
     -- Unload any modules which are going to be re-linked this time around.
     let stable_linkables = [ linkable
                            | m <- stable_obj++stable_bco,
-                             Just hmi <- [lookupUFM pruned_hpt m],
+                             Just hmi <- [lookupHpt pruned_hpt m],
                              Just linkable <- [hm_linkable hmi] ]
     liftIO $ unload hsc_env stable_linkables
 
@@ -370,9 +370,9 @@ load how_much = do
           -- there should be no Nothings where linkables should be, now
           let just_linkables =
                     isNoLink (ghcLink dflags)
-                 || all (isJust.hm_linkable)
-                        (filter ((== HsSrcFile).mi_hsc_src.hm_iface)
-                                (eltsUFM hpt4))
+                 || allHpt (isJust.hm_linkable)
+                        (filterHpt ((== HsSrcFile).mi_hsc_src.hm_iface)
+                                hpt4)
           ASSERT( just_linkables ) do
 
           -- Link everything together
@@ -498,7 +498,7 @@ pruneHomePackageTable :: HomePackageTable
                       -> ([ModuleName],[ModuleName])
                       -> HomePackageTable
 pruneHomePackageTable hpt summ (stable_obj, stable_bco)
-  = mapUFM prune hpt
+  = mapHpt prune hpt
   where prune hmi
           | is_stable modl = hmi'
           | otherwise      = hmi'{ hm_details = emptyModDetails }
@@ -639,7 +639,7 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
                                          && same_as_prev t
           | otherwise = False
           where
-             same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
+             same_as_prev t = case lookupHpt hpt (ms_mod_name ms) of
                                 Just hmi  | Just l <- hm_linkable hmi
                                  -> isObjectLinkable l && t == linkableTime l
                                 _other  -> True
@@ -655,7 +655,7 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
 
         bco_ok ms
           | gopt Opt_ForceRecomp (ms_hspp_opts ms) = False
-          | otherwise = case lookupUFM hpt (ms_mod_name ms) of
+          | otherwise = case lookupHpt hpt (ms_mod_name ms) of
                 Just hmi  | Just l <- hm_linkable hmi ->
                         not (isObjectLinkable l) &&
                         linkableTime l >= ms_hs_date ms
@@ -1060,12 +1060,13 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags cleanup par_sem
                 -- Prune the old HPT unless this is an hs-boot module.
                 unless (isBootSummary mod) $
                     atomicModifyIORef' old_hpt_var $ \old_hpt ->
-                        (delFromUFM old_hpt this_mod, ())
+                        (delFromHpt old_hpt this_mod, ())
 
                 -- Update and fetch the global HscEnv.
                 lcl_hsc_env' <- modifyMVar hsc_env_var $ \hsc_env -> do
-                    let hsc_env' = hsc_env { hsc_HPT = addToUFM (hsc_HPT hsc_env)
-                                                                this_mod mod_info }
+                    let hsc_env' = hsc_env
+                                     { hsc_HPT = addToHpt (hsc_HPT hsc_env)
+                                                           this_mod mod_info }
                     -- If this module is a loop finisher, now is the time to
                     -- re-typecheck the loop.
                     hsc_env'' <- case finish_loop of
@@ -1152,7 +1153,7 @@ upsweep old_hpt stable_mods cleanup sccs = do
                 let this_mod = ms_mod_name mod
 
                         -- Add new info to hsc_env
-                    hpt1     = addToUFM (hsc_HPT hsc_env) this_mod mod_info
+                    hpt1     = addToHpt (hsc_HPT hsc_env) this_mod mod_info
                     hsc_env1 = hsc_env { hsc_HPT = hpt1 }
 
                         -- Space-saving: delete the old HPT entry
@@ -1163,7 +1164,7 @@ upsweep old_hpt stable_mods cleanup sccs = do
                         -- would force the real module to be recompiled
                         -- every time.
                     old_hpt1 | isBootSummary mod = old_hpt
-                             | otherwise = delFromUFM old_hpt this_mod
+                             | otherwise = delFromHpt old_hpt this_mod
 
                     done' = mod:done
 
@@ -1204,7 +1205,7 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
             is_stable_obj = this_mod_name `elem` stable_obj
             is_stable_bco = this_mod_name `elem` stable_bco
 
-            old_hmi = lookupUFM old_hpt this_mod_name
+            old_hmi = lookupHpt old_hpt this_mod_name
 
             -- We're using the dflags for this module now, obtained by
             -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
@@ -1360,9 +1361,9 @@ upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
 -- Filter modules in the HPT
 retainInTopLevelEnvs :: [ModuleName] -> HomePackageTable -> HomePackageTable
 retainInTopLevelEnvs keep_these hpt
-   = listToUFM   [ (mod, expectJust "retain" mb_mod_info)
+   = listToHpt   [ (mod, expectJust "retain" mb_mod_info)
                  | mod <- keep_these
-                 , let mb_mod_info = lookupUFM hpt mod
+                 , let mb_mod_info = lookupHpt hpt mod
                  , isJust mb_mod_info ]
 
 -- ---------------------------------------------------------------------------
@@ -1423,14 +1424,14 @@ typecheckLoop dflags hsc_env mods = do
       let new_hsc_env = hsc_env{ hsc_HPT = new_hpt }
       mds <- initIfaceCheck new_hsc_env $
                 mapM (typecheckIface . hm_iface) hmis
-      let new_hpt = addListToUFM old_hpt
+      let new_hpt = addListToHpt old_hpt
                         (zip mods [ hmi{ hm_details = details }
                                   | (hmi,details) <- zip hmis mds ])
       return new_hpt
   return hsc_env{ hsc_HPT = new_hpt }
   where
     old_hpt = hsc_HPT hsc_env
-    hmis    = map (expectJust "typecheckLoop" . lookupUFM old_hpt) mods
+    hmis    = map (expectJust "typecheckLoop" . lookupHpt old_hpt) mods
 
 reachableBackwards :: ModuleName -> [ModSummary] -> [ModSummary]
 reachableBackwards mod summaries
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 53e40413ef..79e5f694cf 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -37,6 +37,8 @@ module HscTypes (
 
         -- * State relating to modules in this package
         HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
+        lookupHpt, eltsHpt, filterHpt, allHpt, mapHpt, delFromHpt,
+        addToHpt, addListToHpt, lookupHptDirectly, listToHpt,
         hptInstances, hptRules, hptVectInfo, pprHPT,
         hptObjs,
 
@@ -176,8 +178,9 @@ import CoreSyn          ( CoreRule, CoreVect )
 import Maybes
 import Outputable
 import SrcLoc
--- import Unique
+import Unique
 import UniqFM
+import UniqDFM
 import UniqSupply
 import FastString
 import StringBuffer     ( StringBuffer )
@@ -465,7 +468,7 @@ instance Outputable TargetId where
 -}
 
 -- | Helps us find information about modules in the home package
-type HomePackageTable  = ModuleNameEnv HomeModInfo
+type HomePackageTable  = DModuleNameEnv HomeModInfo
         -- Domain = modules in the home package that have been fully compiled
         -- "home" unit id cached here for convenience
 
@@ -475,7 +478,7 @@ type PackageIfaceTable = ModuleEnv ModIface
 
 -- | Constructs an empty HomePackageTable
 emptyHomePackageTable :: HomePackageTable
-emptyHomePackageTable  = emptyUFM
+emptyHomePackageTable  = emptyUDFM
 
 -- | Constructs an empty PackageIfaceTable
 emptyPackageIfaceTable :: PackageIfaceTable
@@ -483,16 +486,47 @@ emptyPackageIfaceTable = emptyModuleEnv
 
 pprHPT :: HomePackageTable -> SDoc
 -- A bit aribitrary for now
-pprHPT hpt = pprUFM hpt $ \hms ->
+pprHPT hpt = pprUDFM hpt $ \hms ->
     vcat [ hang (ppr (mi_module (hm_iface hm)))
               2 (ppr (md_types (hm_details hm)))
          | hm <- hms ]
 
+lookupHpt :: HomePackageTable -> ModuleName -> Maybe HomeModInfo
+lookupHpt = lookupUDFM
+
+lookupHptDirectly :: HomePackageTable -> Unique -> Maybe HomeModInfo
+lookupHptDirectly = lookupUDFM_Directly
+
+eltsHpt :: HomePackageTable -> [HomeModInfo]
+eltsHpt = eltsUDFM
+
+filterHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable
+filterHpt = filterUDFM
+
+allHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool
+allHpt = allUDFM
+
+mapHpt :: (HomeModInfo -> HomeModInfo) -> HomePackageTable -> HomePackageTable
+mapHpt = mapUDFM
+
+delFromHpt :: HomePackageTable -> ModuleName -> HomePackageTable
+delFromHpt = delFromUDFM
+
+addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable
+addToHpt = addToUDFM
+
+addListToHpt
+  :: HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable
+addListToHpt = addListToUDFM
+
+listToHpt :: [(ModuleName, HomeModInfo)] -> HomePackageTable
+listToHpt = listToUDFM
+
 lookupHptByModule :: HomePackageTable -> Module -> Maybe HomeModInfo
 -- The HPT is indexed by ModuleName, not Module,
 -- we must check for a hit on the right Module
 lookupHptByModule hpt mod
-  = case lookupUFM hpt (moduleName mod) of
+  = case lookupHpt hpt (moduleName mod) of
       Just hm | mi_module (hm_iface hm) == mod -> Just hm
       _otherwise                               -> Nothing
 
@@ -575,7 +609,7 @@ hptAnns hsc_env (Just deps) = hptSomeThingsBelowUs (md_anns . hm_details) False
 hptAnns hsc_env Nothing = hptAllThings (md_anns . hm_details) hsc_env
 
 hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
-hptAllThings extract hsc_env = concatMap extract (eltsUFM (hsc_HPT hsc_env))
+hptAllThings extract hsc_env = concatMap extract (eltsHpt (hsc_HPT hsc_env))
 
 -- | Get things from modules "below" this one (in the dependency sense)
 -- C.f Inst.hptInstances
@@ -598,7 +632,7 @@ hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
     , mod /= moduleName gHC_PRIM
 
         -- Look it up in the HPT
-    , let things = case lookupUFM hpt mod of
+    , let things = case lookupHpt hpt mod of
                     Just info -> extract info
                     Nothing -> pprTrace "WARNING in hptSomeThingsBelowUs" msg []
           msg = vcat [text "missing module" <+> ppr mod,
@@ -609,7 +643,7 @@ hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
     , thing <- things ]
 
 hptObjs :: HomePackageTable -> [FilePath]
-hptObjs hpt = concat (map (maybe [] linkableObjs . hm_linkable) (eltsUFM hpt))
+hptObjs hpt = concat (map (maybe [] linkableObjs . hm_linkable) (eltsHpt hpt))
 
 {-
 ************************************************************************
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 6ca5d24351..5d0d7e75f8 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -80,7 +80,6 @@ import MonadUtils
 import Module
 import PrelNames  ( toDynName, pretendNameIsInScope )
 import Panic
-import UniqFM
 import Maybes
 import ErrUtils
 import SrcLoc
@@ -118,7 +117,7 @@ getHistoryModule = breakInfo_module . historyBreakInfo
 getHistorySpan :: HscEnv -> History -> SrcSpan
 getHistorySpan hsc_env History{..} =
   let BreakInfo{..} = historyBreakInfo in
-  case lookupUFM (hsc_HPT hsc_env) (moduleName breakInfo_module) of
+  case lookupHpt (hsc_HPT hsc_env) (moduleName breakInfo_module) of
     Just hmi -> modBreaks_locs (getModBreaks hmi) ! breakInfo_number
     _ -> panic "getHistorySpan"
 
@@ -137,7 +136,7 @@ getModBreaks hmi
 findEnclosingDecls :: HscEnv -> BreakInfo -> [String]
 findEnclosingDecls hsc_env (BreakInfo modl ix) =
    let hmi = expectJust "findEnclosingDecls" $
-             lookupUFM (hsc_HPT hsc_env) (moduleName modl)
+             lookupHpt (hsc_HPT hsc_env) (moduleName modl)
        mb = getModBreaks hmi
    in modBreaks_decls mb ! ix
 
@@ -308,7 +307,8 @@ handleRunStatus step expr bindings final_ids status history
     = do
        hsc_env <- getSession
        let hmi = expectJust "handleRunStatus" $
-                   lookupUFM (hsc_HPT hsc_env) (mkUniqueGrimily mod_uniq)
+                   lookupHptDirectly (hsc_HPT hsc_env)
+                                     (mkUniqueGrimily mod_uniq)
            modl = mi_module (hm_iface hmi)
            breaks = getModBreaks hmi
 
@@ -338,7 +338,8 @@ handleRunStatus step expr bindings final_ids status history
          resume_ctxt_fhv <- liftIO $ mkFinalizedHValue hsc_env resume_ctxt
          apStack_fhv <- liftIO $ mkFinalizedHValue hsc_env apStack_ref
          let hmi = expectJust "handleRunStatus" $
-                     lookupUFM (hsc_HPT hsc_env) (mkUniqueGrimily mod_uniq)
+                     lookupHptDirectly (hsc_HPT hsc_env)
+                                       (mkUniqueGrimily mod_uniq)
              modl = mi_module (hm_iface hmi)
              bp | is_exception = Nothing
                 | otherwise = Just (BreakInfo modl ix)
@@ -509,7 +510,7 @@ bindLocalsAtBreakpoint hsc_env apStack Nothing = do
 bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
    let
        hmi       = expectJust "bindLocalsAtBreakpoint" $
-                     lookupUFM (hsc_HPT hsc_env) (moduleName breakInfo_module)
+                     lookupHpt (hsc_HPT hsc_env) (moduleName breakInfo_module)
        breaks    = getModBreaks hmi
        info      = expectJust "bindLocalsAtBreakpoint2" $
                      IntMap.lookup breakInfo_number (modBreaks_breakInfo breaks)
@@ -738,7 +739,7 @@ availsToGlobalRdrEnv mod_name avails
 
 mkTopLevEnv :: HomePackageTable -> ModuleName -> Either String GlobalRdrEnv
 mkTopLevEnv hpt modl
-  = case lookupUFM hpt modl of
+  = case lookupHpt hpt modl of
       Nothing -> Left "not a home module"
       Just details ->
          case mi_globals (hm_iface details) of
@@ -758,7 +759,7 @@ moduleIsInterpreted :: GhcMonad m => Module -> m Bool
 moduleIsInterpreted modl = withSession $ \h ->
  if moduleUnitId modl /= thisPackage (hsc_dflags h)
         then return False
-        else case lookupUFM (hsc_HPT h) (moduleName modl) of
+        else case lookupHpt (hsc_HPT h) (moduleName modl) of
                 Just details       -> return (isJust (mi_globals (hm_iface details)))
                 _not_a_home_module -> return False
 
@@ -950,7 +951,7 @@ showModule mod_summary =
 
 isModuleInterpreted :: GhcMonad m => ModSummary -> m Bool
 isModuleInterpreted mod_summary = withSession $ \hsc_env ->
-  case lookupUFM (hsc_HPT hsc_env) (ms_mod_name mod_summary) of
+  case lookupHpt (hsc_HPT hsc_env) (ms_mod_name mod_summary) of
         Nothing       -> panic "missing linkable"
         Just mod_info -> return (not obj_linkable)
                       where
diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs
index 69a110061e..a789a7b1a6 100644
--- a/compiler/typecheck/FamInst.hs
+++ b/compiler/typecheck/FamInst.hs
@@ -27,7 +27,6 @@ import CoAxiom
 import DynFlags
 import Module
 import Outputable
-import UniqFM
 import Util
 import RdrName
 import DataCon ( dataConName )
@@ -161,7 +160,7 @@ checkFamInstConsistency famInstMods directlyImpMods
              ; hmiFamInstEnv = extendFamInstEnvList emptyFamInstEnv
                                . md_fam_insts . hm_details
              ; hpt_fam_insts = mkModuleEnv [ (hmiModule hmi, hmiFamInstEnv hmi)
-                                           | hmi <- eltsUFM hpt]
+                                           | hmi <- eltsHpt hpt]
              ; groups        = map (dep_finsts . mi_deps . modIface)
                                    directlyImpMods
              ; okPairs       = listToSet $ concatMap allPairs groups
diff --git a/compiler/utils/UniqDFM.hs b/compiler/utils/UniqDFM.hs
index 8bd19ad7ff..6e6292ec3c 100644
--- a/compiler/utils/UniqDFM.hs
+++ b/compiler/utils/UniqDFM.hs
@@ -28,6 +28,7 @@ module UniqDFM (
         unitUDFM,
         addToUDFM,
         addToUDFM_C,
+        addListToUDFM,
         delFromUDFM,
         delListFromUDFM,
         adjustUDFM,
@@ -35,7 +36,7 @@ module UniqDFM (
         mapUDFM,
         plusUDFM,
         plusUDFM_C,
-        lookupUDFM,
+        lookupUDFM, lookupUDFM_Directly,
         elemUDFM,
         foldUDFM,
         eltsUDFM,
@@ -49,7 +50,8 @@ module UniqDFM (
         listToUDFM,
         udfmMinusUFM,
         partitionUDFM,
-        anyUDFM,
+        anyUDFM, allUDFM,
+        pprUDFM,
 
         udfmToList,
         udfmToUfm,
@@ -155,6 +157,9 @@ addToUDFM_Directly_C f (UDFM m i) u v =
   where
   tf (TaggedVal a j) (TaggedVal b _) = TaggedVal (f a b) j
 
+addListToUDFM :: Uniquable key => UniqDFM elt -> [(key,elt)] -> UniqDFM elt
+addListToUDFM = foldl (\m (k, v) -> addToUDFM m k v)
+
 addToUDFM_C
   :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
   -> UniqDFM elt -- old
@@ -235,6 +240,9 @@ insertUDFMIntoLeft_C f udfml udfmr =
 lookupUDFM :: Uniquable key => UniqDFM elt -> key -> Maybe elt
 lookupUDFM (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey $ getUnique k) m
 
+lookupUDFM_Directly :: UniqDFM elt -> Unique -> Maybe elt
+lookupUDFM_Directly (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey k) m
+
 elemUDFM :: Uniquable key => key -> UniqDFM elt -> Bool
 elemUDFM k (UDFM m _i) = M.member (getKey $ getUnique k) m
 
@@ -349,6 +357,9 @@ mapUDFM f (UDFM m i) = UDFM (M.map (fmap f) m) i
 anyUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool
 anyUDFM p (UDFM m _i) = M.fold ((||) . p . taggedFst) False m
 
+allUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool
+allUDFM p (UDFM m _i) = M.fold ((&&) . p . taggedFst) True m
+
 instance Monoid (UniqDFM a) where
   mempty = emptyUDFM
   mappend = plusUDFM
@@ -368,3 +379,9 @@ pprUniqDFM ppr_elt ufm
   = brackets $ fsep $ punctuate comma $
     [ ppr uq <+> text ":->" <+> ppr_elt elt
     | (uq, elt) <- udfmToList ufm ]
+
+pprUDFM :: UniqDFM a    -- ^ The things to be pretty printed
+       -> ([a] -> SDoc) -- ^ The pretty printing function to use on the elements
+       -> SDoc          -- ^ 'SDoc' where the things have been pretty
+                        -- printed
+pprUDFM ufm pp = pp (eltsUDFM ufm)