Make UnitIdMap a deterministic map

This impacts at least the order in which version macros are
generated. It's pretty hard to track what kind of nondeterminism
is benign and this should have no performance impact as the number
of packages should be relatively small.

Test Plan: ./validate

Reviewers: simonmar, austin, bgamari, ezyang

Reviewed By: ezyang

Subscribers: thomie

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

GHC Trac Issues: #4012

1 files changed, 27 insertions, 26 deletions

diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index 2655c451d8..4710de1a20 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -57,6 +57,7 @@ import PackageConfig
 import DynFlags
 import Name             ( Name, nameModule_maybe )
 import UniqFM
+import UniqDFM
 import Module
 import Util
 import Panic
@@ -230,7 +231,7 @@ originEmpty (ModOrigin Nothing [] [] False) = True
 originEmpty _ = False
 
 -- | 'UniqFM' map from 'UnitId'
-type UnitIdMap = UniqFM
+type UnitIdMap = UniqDFM
 
 -- | 'UniqFM' map from 'UnitId' to 'PackageConfig'
 type PackageConfigMap = UnitIdMap PackageConfig
@@ -276,7 +277,7 @@ data PackageState = PackageState {
 
 emptyPackageState :: PackageState
 emptyPackageState = PackageState {
-    pkgIdMap = emptyUFM,
+    pkgIdMap = emptyPackageConfigMap,
     preloadPackages = [],
     explicitPackages = [],
     moduleToPkgConfAll = Map.empty,
@@ -287,14 +288,14 @@ type InstalledPackageIndex = Map UnitId PackageConfig
 
 -- | Empty package configuration map
 emptyPackageConfigMap :: PackageConfigMap
-emptyPackageConfigMap = emptyUFM
+emptyPackageConfigMap = emptyUDFM
 
 -- | Find the package we know about with the given key (e.g. @foo_HASH@), if any
 lookupPackage :: DynFlags -> UnitId -> Maybe PackageConfig
 lookupPackage dflags = lookupPackage' (pkgIdMap (pkgState dflags))
 
 lookupPackage' :: PackageConfigMap -> UnitId -> Maybe PackageConfig
-lookupPackage' = lookupUFM
+lookupPackage' = lookupUDFM
 
 -- | Search for packages with a given package ID (e.g. \"foo-0.1\")
 searchPackageId :: DynFlags -> SourcePackageId -> [PackageConfig]
@@ -306,7 +307,7 @@ extendPackageConfigMap
    :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap
 extendPackageConfigMap pkg_map new_pkgs
   = foldl add pkg_map new_pkgs
-  where add pkg_map p = addToUFM pkg_map (packageConfigId p) p
+  where add pkg_map p = addToUDFM pkg_map (packageConfigId p) p
 
 -- | Looks up the package with the given id in the package state, panicing if it is
 -- not found
@@ -319,7 +320,7 @@ getPackageDetails dflags pid =
 -- does not imply that the exposed-modules of the package are available
 -- (they may have been thinned or renamed).
 listPackageConfigMap :: DynFlags -> [PackageConfig]
-listPackageConfigMap dflags = eltsUFM (pkgIdMap (pkgState dflags))
+listPackageConfigMap dflags = eltsUDFM (pkgIdMap (pkgState dflags))
 
 -- ----------------------------------------------------------------------------
 -- Loading the package db files and building up the package state
@@ -549,7 +550,7 @@ applyPackageFlag dflags unusable no_hide_others pkgs vm flag =
          Right (p:_,_) -> return vm'
           where
            n = fsPackageName p
-           vm' = addToUFM_C edit vm_cleared (packageConfigId p) (b, rns, n)
+           vm' = addToUDFM_C edit vm_cleared (packageConfigId p) (b, rns, n)
            edit (b, rns, n) (b', rns', _) = (b || b', rns ++ rns', n)
            -- In the old days, if you said `ghc -package p-0.1 -package p-0.2`
            -- (or if p-0.1 was registered in the pkgdb as exposed: True),
@@ -572,7 +573,7 @@ applyPackageFlag dflags unusable no_hide_others pkgs vm flag =
            -- -hide-all-packages/-hide-all-plugin-packages depending on what
            -- flag is in question.
            vm_cleared | no_hide_others = vm
-                      | otherwise = filterUFM_Directly
+                      | otherwise = filterUDFM_Directly
                             (\k (_,_,n') -> k == getUnique (packageConfigId p)
                                                 || n /= n') vm
          _ -> panic "applyPackageFlag"
@@ -581,7 +582,7 @@ applyPackageFlag dflags unusable no_hide_others pkgs vm flag =
        case selectPackages (matchingStr str) pkgs unusable of
          Left ps       -> packageFlagErr dflags flag ps
          Right (ps,_) -> return vm'
-          where vm' = delListFromUFM vm (map packageConfigId ps)
+          where vm' = delListFromUDFM vm (map packageConfigId ps)
 
 selectPackages :: (PackageConfig -> Bool) -> [PackageConfig]
                -> UnusablePackages
@@ -710,7 +711,7 @@ findWiredInPackages dflags pkgs vis_map = do
            let all_ps = [ p | p <- pkgs, p `matches` wired_pkg ]
                all_exposed_ps =
                     [ p | p <- all_ps
-                        , elemUFM (packageConfigId p) vis_map ] in
+                        , elemUDFM (packageConfigId p) vis_map ] in
            case all_exposed_ps of
             [] -> case all_ps of
                        []   -> notfound
@@ -784,9 +785,9 @@ findWiredInPackages dflags pkgs vis_map = do
 
 updateVisibilityMap :: WiredPackagesMap -> VisibilityMap -> VisibilityMap
 updateVisibilityMap wiredInMap vis_map = foldl' f vis_map (Map.toList wiredInMap)
-  where f vm (from, to) = case lookupUFM vis_map from of
+  where f vm (from, to) = case lookupUDFM vis_map from of
                     Nothing -> vm
-                    Just r -> addToUFM vm to r
+                    Just r -> addToUDFM vm to r
 
 
 -- ----------------------------------------------------------------------------
@@ -1014,16 +1015,16 @@ mkPackageState dflags0 dbs preload0 = do
         case comparing packageVersion pkg pkg' of
             GT -> pkg
             _  -> pkg'
-      calcInitial m pkg = addToUFM_C preferLater m (fsPackageName pkg) pkg
+      calcInitial m pkg = addToUDFM_C preferLater m (fsPackageName pkg) pkg
       initial = if gopt Opt_HideAllPackages dflags
-                    then emptyUFM
-                    else foldl' calcInitial emptyUFM pkgs1
-      vis_map1 = foldUFM (\p vm ->
+                    then emptyUDFM
+                    else foldl' calcInitial emptyUDFM pkgs1
+      vis_map1 = foldUDFM (\p vm ->
                             if exposed p
-                               then addToUFM vm (packageConfigId p)
-                                             (True, [], fsPackageName p)
+                               then addToUDFM vm (packageConfigId p)
+                                              (True, [], fsPackageName p)
                                else vm)
-                         emptyUFM initial
+                         emptyUDFM initial
 
   --
   -- Compute a visibility map according to the command-line flags (-package,
@@ -1049,9 +1050,9 @@ mkPackageState dflags0 dbs preload0 = do
     case pluginPackageFlags dflags of
         -- common case; try to share the old vis_map
         [] | not hide_plugin_pkgs -> return vis_map
-           | otherwise -> return emptyUFM
+           | otherwise -> return emptyUDFM
         _ -> do let plugin_vis_map1
-                        | hide_plugin_pkgs = emptyUFM
+                        | hide_plugin_pkgs = emptyUDFM
                         -- Use the vis_map PRIOR to wired in,
                         -- because otherwise applyPackageFlag
                         -- won't work.
@@ -1095,7 +1096,7 @@ mkPackageState dflags0 dbs preload0 = do
       -- add base & rts to the preload packages
       basicLinkedPackages
        | gopt Opt_AutoLinkPackages dflags
-          = filter (flip elemUFM pkg_db)
+          = filter (flip elemUDFM pkg_db)
                 [baseUnitId, rtsUnitId]
        | otherwise = []
       -- but in any case remove the current package from the set of
@@ -1111,8 +1112,8 @@ mkPackageState dflags0 dbs preload0 = do
   -- Force pstate to avoid leaking the dflags0 passed to mkPackageState
   let !pstate = PackageState{
     preloadPackages     = dep_preload,
-    explicitPackages    = foldUFM (\pkg xs ->
-                            if elemUFM (packageConfigId pkg) vis_map
+    explicitPackages    = foldUDFM (\pkg xs ->
+                            if elemUDFM (packageConfigId pkg) vis_map
                                 then packageConfigId pkg : xs
                                 else xs) [] pkg_db,
     pkgIdMap            = pkg_db,
@@ -1131,7 +1132,7 @@ mkModuleToPkgConfAll
   -> VisibilityMap
   -> ModuleToPkgConfAll
 mkModuleToPkgConfAll dflags pkg_db vis_map =
-    foldl' extend_modmap emptyMap (eltsUFM pkg_db)
+    foldl' extend_modmap emptyMap (eltsUDFM pkg_db)
  where
   emptyMap = Map.empty
   sing pk m _ = Map.singleton (mkModule pk m)
@@ -1141,7 +1142,7 @@ mkModuleToPkgConfAll dflags pkg_db vis_map =
   extend_modmap modmap pkg = addListTo modmap theBindings
    where
     theBindings :: [(ModuleName, Map Module ModuleOrigin)]
-    theBindings | Just (b,rns,_) <- lookupUFM vis_map (packageConfigId pkg)
+    theBindings | Just (b,rns,_) <- lookupUDFM vis_map (packageConfigId pkg)
                               = newBindings b rns
                 | otherwise   = newBindings False []