[commit: ghc] master: Use a deterministic map for imp_dep_mods (7fea712)

git at git.haskell.org git at git.haskell.org
Tue Jun 7 12:52:31 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/7fea7121ce195e562a5443c0a8ef3861504ef1b3/ghc

>---------------------------------------------------------------

commit 7fea7121ce195e562a5443c0a8ef3861504ef1b3
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Tue Jun 7 05:55:50 2016 -0700

    Use a deterministic map for imp_dep_mods
    
    This lets us remove some normalization and makes it
    less brittle for the future.
    
    Test Plan: ./validate
    
    Reviewers: ezyang, austin, bgamari, simonmar
    
    Reviewed By: simonmar
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2311
    
    GHC Trac Issues: #4012


>---------------------------------------------------------------

7fea7121ce195e562a5443c0a8ef3861504ef1b3
 compiler/deSugar/Desugar.hs      |  7 ++++---
 compiler/iface/MkIface.hs        |  5 +++--
 compiler/typecheck/TcRnDriver.hs | 16 ++++++----------
 compiler/typecheck/TcRnTypes.hs  | 13 +++++++------
 4 files changed, 20 insertions(+), 21 deletions(-)

diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index c7a869d..7ce0c6d 100644
--- a/compiler/deSugar/Desugar.hs
+++ b/compiler/deSugar/Desugar.hs
@@ -61,11 +61,11 @@ import Util
 import MonadUtils
 import OrdList
 import UniqFM
+import UniqDFM
 import ListSetOps
 import Fingerprint
 import Maybes
 
-import Data.Function
 import Data.List
 import Data.IORef
 import Control.Monad( when )
@@ -83,7 +83,8 @@ mkDependencies
  = do
       -- Template Haskell used?
       th_used <- readIORef th_var
-      let dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
+      let dep_mods = eltsUDFM (delFromUDFM (imp_dep_mods imports)
+                                           (moduleName mod))
                 -- M.hi-boot can be in the imp_dep_mods, but we must remove
                 -- it before recording the modules on which this one depends!
                 -- (We want to retain M.hi-boot in imp_dep_mods so that
@@ -100,7 +101,7 @@ mkDependencies
           trust_pkgs  = imp_trust_pkgs imports
           dep_pkgs'   = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs
 
-      return Deps { dep_mods   = sortBy (stableModuleNameCmp `on` fst) dep_mods,
+      return Deps { dep_mods   = dep_mods,
                     dep_pkgs   = dep_pkgs',
                     dep_orphs  = sortBy stableModuleCmp (imp_orphs  imports),
                     dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index 88bc662..67bbd95 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -107,6 +107,7 @@ import Binary
 import Fingerprint
 import Exception
 import UniqFM
+import UniqDFM
 
 import Control.Monad
 import Data.Function
@@ -1055,14 +1056,14 @@ checkVersions hsc_env mod_summary iface
        -- We do this regardless of compilation mode, although in --make mode
        -- all the dependent modules should be in the HPT already, so it's
        -- quite redundant
-       ; updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
+       ; updateEps_ $ \eps  -> eps { eps_is_boot = udfmToUfm mod_deps }
        ; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface]
        ; return (recomp, Just iface)
     }}}}
   where
     this_pkg = thisPackage (hsc_dflags hsc_env)
     -- This is a bit of a hack really
-    mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
+    mod_deps :: DModuleNameEnv (ModuleName, IsBootInterface)
     mod_deps = mkModDeps (dep_mods (mi_deps iface))
 
 -- | Check the flags haven't changed
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index cb7bb69..5e83305 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -83,7 +83,7 @@ import Id
 import IdInfo
 import VarEnv
 import Module
-import UniqFM
+import UniqDFM
 import Name
 import NameEnv
 import NameSet
@@ -400,7 +400,7 @@ tcRnImports hsc_env import_decls
   = do  { (rn_imports, rdr_env, imports, hpc_info) <- rnImports import_decls ;
 
         ; this_mod <- getModule
-        ; let { dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface)
+        ; let { dep_mods :: DModuleNameEnv (ModuleName, IsBootInterface)
               ; dep_mods = imp_dep_mods imports
 
                 -- We want instance declarations from all home-package
@@ -411,7 +411,7 @@ tcRnImports hsc_env import_decls
                 -- modules batch (@--make@) compiled before this one, but
                 -- which are not below this one.
               ; want_instances :: ModuleName -> Bool
-              ; want_instances mod = mod `elemUFM` dep_mods
+              ; want_instances mod = mod `elemUDFM` dep_mods
                                    && mod /= moduleName this_mod
               ; (home_insts, home_fam_insts) = hptInstances hsc_env
                                                             want_instances
@@ -420,7 +420,7 @@ tcRnImports hsc_env import_decls
                 -- Record boot-file info in the EPS, so that it's
                 -- visible to loadHiBootInterface in tcRnSrcDecls,
                 -- and any other incrementally-performed imports
-        ; updateEps_ (\eps -> eps { eps_is_boot = dep_mods }) ;
+        ; updateEps_ (\eps -> eps { eps_is_boot = udfmToUfm dep_mods }) ;
 
                 -- Update the gbl env
         ; updGblEnv ( \ gbl ->
@@ -2434,15 +2434,11 @@ pprTcGblEnv (TcGblEnv { tcg_type_env  = type_env,
          , vcat (map ppr rules)
          , vcat (map ppr vects)
          , text "Dependent modules:" <+>
-                pprUFM (imp_dep_mods imports) (ppr . sortBy cmp_mp)
+                pprUDFM (imp_dep_mods imports) ppr
          , text "Dependent packages:" <+>
                 ppr (sortBy stableUnitIdCmp $ imp_dep_pkgs imports)]
-  where         -- The two uses of sortBy are just to reduce unnecessary
+  where         -- The use of sortBy is just to reduce unnecessary
                 -- wobbling in testsuite output
-    cmp_mp (mod_name1, is_boot1) (mod_name2, is_boot2)
-        = (mod_name1 `stableModuleNameCmp` mod_name2)
-                  `thenCmp`
-          (is_boot1 `compare` is_boot2)
 
 ppr_types :: TypeEnv -> SDoc
 ppr_types type_env
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 4017688..a416c74 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -163,6 +163,7 @@ import SrcLoc
 import VarSet
 import ErrUtils
 import UniqFM
+import UniqDFM
 import UniqSupply
 import BasicTypes
 import Bag
@@ -1042,7 +1043,7 @@ data ImportAvails
           -- different packages. (currently not the case, but might be in the
           -- future).
 
-        imp_dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface),
+        imp_dep_mods :: DModuleNameEnv (ModuleName, IsBootInterface),
           -- ^ Home-package modules needed by the module being compiled
           --
           -- It doesn't matter whether any of these dependencies
@@ -1084,14 +1085,14 @@ data ImportAvails
       }
 
 mkModDeps :: [(ModuleName, IsBootInterface)]
-          -> ModuleNameEnv (ModuleName, IsBootInterface)
-mkModDeps deps = foldl add emptyUFM deps
+          -> DModuleNameEnv (ModuleName, IsBootInterface)
+mkModDeps deps = foldl add emptyUDFM deps
                where
-                 add env elt@(m,_) = addToUFM env m elt
+                 add env elt@(m,_) = addToUDFM env m elt
 
 emptyImportAvails :: ImportAvails
 emptyImportAvails = ImportAvails { imp_mods          = emptyModuleEnv,
-                                   imp_dep_mods      = emptyUFM,
+                                   imp_dep_mods      = emptyUDFM,
                                    imp_dep_pkgs      = [],
                                    imp_trust_pkgs    = [],
                                    imp_trust_own_pkg = False,
@@ -1114,7 +1115,7 @@ plusImportAvails
                   imp_trust_pkgs = tpkgs2, imp_trust_own_pkg = tself2,
                   imp_orphs = orphs2, imp_finsts = finsts2 })
   = ImportAvails { imp_mods          = plusModuleEnv_C (++) mods1 mods2,
-                   imp_dep_mods      = plusUFM_C plus_mod_dep dmods1 dmods2,
+                   imp_dep_mods      = plusUDFM_C plus_mod_dep dmods1 dmods2,
                    imp_dep_pkgs      = dpkgs1 `unionLists` dpkgs2,
                    imp_trust_pkgs    = tpkgs1 `unionLists` tpkgs2,
                    imp_trust_own_pkg = tself1 || tself2,



More information about the ghc-commits mailing list