[commit: ghc] master: IfaceEnv: Clean up updNameCache a bit (70ea94c)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/70ea94cb5e51701b44c9e3e598b0898fd87f8d31/ghc

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

commit 70ea94cb5e51701b44c9e3e598b0898fd87f8d31
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Wed Aug 26 18:10:21 2015 +0200

    IfaceEnv: Clean up updNameCache a bit


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

70ea94cb5e51701b44c9e3e598b0898fd87f8d31
 compiler/iface/IfaceEnv.hs | 21 ++++++++-------------
 compiler/main/HscTypes.hs  |  8 +++++++-
 2 files changed, 15 insertions(+), 14 deletions(-)

diff --git a/compiler/iface/IfaceEnv.hs b/compiler/iface/IfaceEnv.hs
index 2981550..645ceda 100644
--- a/compiler/iface/IfaceEnv.hs
+++ b/compiler/iface/IfaceEnv.hs
@@ -37,8 +37,6 @@ import Util
 
 import Outputable
 
-import Data.IORef    ( atomicModifyIORef' )
-
 {-
 *********************************************************
 *                                                      *
@@ -73,7 +71,7 @@ newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
 
 newGlobalBinder mod occ loc
   = do { mod `seq` occ `seq` return ()    -- See notes with lookupOrig
-       ; name <- updNameCacheTcRn $ \name_cache ->
+       ; name <- updNameCache $ \name_cache ->
                  allocateGlobalBinder name_cache mod occ loc
        ; traceIf (text "newGlobalBinder" <+>
                   (vcat [ ppr mod <+> ppr occ <+> ppr loc, ppr name]))
@@ -84,7 +82,7 @@ newInteractiveBinder :: HscEnv -> OccName -> SrcSpan -> IO Name
 -- from the interactive context
 newInteractiveBinder hsc_env occ loc
  = do { let mod = icInteractiveModule (hsc_IC hsc_env)
-       ; updNameCache hsc_env $ \name_cache ->
+       ; updNameCacheIO hsc_env $ \name_cache ->
          allocateGlobalBinder name_cache mod occ loc }
 
 allocateGlobalBinder
@@ -147,7 +145,7 @@ lookupOrig mod occ
           mod `seq` occ `seq` return ()
 --      ; traceIf (text "lookup_orig" <+> ppr mod <+> ppr occ)
 
-        ; updNameCacheTcRn $ \name_cache ->
+        ; updNameCache $ \name_cache ->
           case lookupOrigNameCache (nsNames name_cache) mod occ of {
               Just name -> (name_cache, name);
               Nothing   ->
@@ -167,7 +165,7 @@ externaliseName mod name
              loc = nameSrcSpan name
              uniq = nameUnique name
        ; occ `seq` return ()  -- c.f. seq in newGlobalBinder
-       ; updNameCacheTcRn $ \ ns ->
+       ; updNameCache $ \ ns ->
          let name' = mkExternalName uniq mod occ loc
              ns'   = ns { nsNames = extendNameCache (nsNames ns) mod occ name' }
          in (ns', name') }
@@ -224,12 +222,9 @@ extendNameCache nc mod occ name
   where
     combine _ occ_env = extendOccEnv occ_env occ name
 
-updNameCacheTcRn :: (NameCache -> (NameCache, c)) -> TcRnIf a b c
-updNameCacheTcRn upd_fn = do { hsc_env <- getTopEnv
-                             ; liftIO (updNameCache hsc_env upd_fn) }
-
-updNameCache :: HscEnv -> (NameCache -> (NameCache, c)) -> IO c
-updNameCache hsc_env upd_fn = atomicModifyIORef' (hsc_NC hsc_env) upd_fn
+updNameCache :: (NameCache -> (NameCache, c)) -> TcRnIf a b c
+updNameCache upd_fn = do { hsc_env <- getTopEnv
+                         ; liftIO $ updNameCacheIO hsc_env upd_fn }
 
 -- | A function that atomically updates the name cache given a modifier
 -- function.  The second result of the modifier function will be the result
@@ -240,7 +235,7 @@ newtype NameCacheUpdater
 -- | Return a function to atomically update the name cache.
 mkNameCacheUpdater :: TcRnIf a b NameCacheUpdater
 mkNameCacheUpdater = do { hsc_env <- getTopEnv
-                        ; return (NCU (updNameCache hsc_env)) }
+                        ; return (NCU (updNameCacheIO hsc_env)) }
 
 initNameCache :: UniqSupply -> [Name] -> NameCache
 initNameCache us names
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index b3ae671..3b47e4c 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -93,7 +93,7 @@ module HscTypes (
         -- * Information on imports and exports
         WhetherHasOrphans, IsBootInterface, Usage(..),
         Dependencies(..), noDependencies,
-        NameCache(..), OrigNameCache,
+        NameCache(..), OrigNameCache, updNameCacheIO,
         IfaceExport,
 
         -- * Warnings
@@ -2361,6 +2361,12 @@ data NameCache
                 -- ^ Ensures that one original name gets one unique
    }
 
+updNameCacheIO :: HscEnv
+               -> (NameCache -> (NameCache, c))  -- The updating function
+               -> IO c
+updNameCacheIO hsc_env upd_fn
+  = atomicModifyIORef' (hsc_NC hsc_env) upd_fn
+
 -- | Per-module cache of original 'OccName's given 'Name's
 type OrigNameCache   = ModuleEnv (OccEnv Name)