Commit 70ea94cb authored by Ben Gamari's avatar Ben Gamari 🐢

IfaceEnv: Clean up updNameCache a bit

parent 211b3497
......@@ -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
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment