Commit ea3b4cff authored by Edward Z. Yang's avatar Edward Z. Yang

Axe ModFinderCache, folding it into a generalized FinderCache.

Summary:
FinderCache is now keyed by a module, ModuleNames in the home package are
turned into Modules using thisPackage in the dynamic flags.  Simplifies some
code!
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D634
parent 7a3d7c0e
......@@ -38,10 +38,9 @@ import Util
import PrelNames ( gHC_PRIM )
import DynFlags
import Outputable
import UniqFM
import Maybes ( expectJust )
import Data.IORef ( IORef, writeIORef, readIORef, atomicModifyIORef' )
import Data.IORef ( IORef, readIORef, atomicModifyIORef' )
import System.Directory
import System.FilePath
import Control.Monad
......@@ -68,46 +67,24 @@ type BaseName = String -- Basename of file
-- remove all the home modules from the cache; package modules are
-- assumed to not move around during a session.
flushFinderCaches :: HscEnv -> IO ()
flushFinderCaches hsc_env = do
-- Ideally the update to both caches be a single atomic operation.
writeIORef fc_ref emptyUFM
flushModLocationCache this_pkg mlc_ref
flushFinderCaches hsc_env =
atomicModifyIORef' fc_ref $ \fm -> (filterModuleEnv is_ext fm, ())
where
this_pkg = thisPackage (hsc_dflags hsc_env)
fc_ref = hsc_FC hsc_env
mlc_ref = hsc_MLC hsc_env
flushModLocationCache :: PackageKey -> IORef ModLocationCache -> IO ()
flushModLocationCache this_pkg ref = do
atomicModifyIORef' ref $ \fm -> (filterModuleEnv is_ext fm, ())
return ()
where is_ext mod _ | modulePackageKey mod /= this_pkg = True
is_ext mod _ | modulePackageKey mod /= this_pkg = True
| otherwise = False
addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO ()
addToFinderCache :: IORef FinderCache -> Module -> FindResult -> IO ()
addToFinderCache ref key val =
atomicModifyIORef' ref $ \c -> (addToUFM c key val, ())
addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO ()
addToModLocationCache ref key val =
atomicModifyIORef' ref $ \c -> (extendModuleEnv c key val, ())
removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO ()
removeFromFinderCache :: IORef FinderCache -> Module -> IO ()
removeFromFinderCache ref key =
atomicModifyIORef' ref $ \c -> (delFromUFM c key, ())
removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO ()
removeFromModLocationCache ref key =
atomicModifyIORef' ref $ \c -> (delModuleEnv c key, ())
lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult)
lookupFinderCache :: IORef FinderCache -> Module -> IO (Maybe FindResult)
lookupFinderCache ref key = do
c <- readIORef ref
return $! lookupUFM c key
lookupModLocationCache :: IORef ModLocationCache -> Module
-> IO (Maybe ModLocation)
lookupModLocationCache ref key = do
c <- readIORef ref
return $! lookupModuleEnv c key
......@@ -177,16 +154,8 @@ orIfNotFound this or_this = do
-- was successful.)
homeSearchCache :: HscEnv -> ModuleName -> IO FindResult -> IO FindResult
homeSearchCache hsc_env mod_name do_this = do
m <- lookupFinderCache (hsc_FC hsc_env) mod_name
case m of
Just result -> return result
Nothing -> do
result <- do_this
addToFinderCache (hsc_FC hsc_env) mod_name result
case result of
Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
_other -> return ()
return result
let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
modLocationCache hsc_env mod do_this
findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
-> IO FindResult
......@@ -209,30 +178,24 @@ findExposedPackageModule hsc_env mod_name mb_pkg
modLocationCache :: HscEnv -> Module -> IO FindResult -> IO FindResult
modLocationCache hsc_env mod do_this = do
mb_loc <- lookupModLocationCache mlc mod
case mb_loc of
Just loc -> return (Found loc mod)
Nothing -> do
m <- lookupFinderCache (hsc_FC hsc_env) mod
case m of
Just result -> return result
Nothing -> do
result <- do_this
case result of
Found loc mod -> addToModLocationCache (hsc_MLC hsc_env) mod loc
_other -> return ()
addToFinderCache (hsc_FC hsc_env) mod result
return result
where
mlc = hsc_MLC hsc_env
addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder hsc_env mod_name loc = do
let mod = mkModule (thisPackage (hsc_dflags hsc_env)) mod_name
addToFinderCache (hsc_FC hsc_env) mod_name (Found loc mod)
addToModLocationCache (hsc_MLC hsc_env) mod loc
addToFinderCache (hsc_FC hsc_env) mod (Found loc mod)
return mod
uncacheModule :: HscEnv -> ModuleName -> IO ()
uncacheModule hsc_env mod = do
let this_pkg = thisPackage (hsc_dflags hsc_env)
removeFromFinderCache (hsc_FC hsc_env) mod
removeFromModLocationCache (hsc_MLC hsc_env) (mkModule this_pkg mod)
removeFromFinderCache (hsc_FC hsc_env) (mkModule this_pkg mod)
-- -----------------------------------------------------------------------------
-- The internal workers
......
......@@ -150,7 +150,6 @@ import Outputable
import HscStats ( ppSourceStats )
import HscTypes
import FastString
import UniqFM ( emptyUFM )
import UniqSupply
import Bag
import Exception
......@@ -181,8 +180,7 @@ newHscEnv dflags = do
eps_var <- newIORef initExternalPackageState
us <- mkSplitUniqSupply 'r'
nc_var <- newIORef (initNameCache us knownKeyNames)
fc_var <- newIORef emptyUFM
mlc_var <- newIORef emptyModuleEnv
fc_var <- newIORef emptyModuleEnv
return HscEnv { hsc_dflags = dflags,
hsc_targets = [],
hsc_mod_graph = [],
......@@ -191,7 +189,6 @@ newHscEnv dflags = do
hsc_EPS = eps_var,
hsc_NC = nc_var,
hsc_FC = fc_var,
hsc_MLC = mlc_var,
hsc_type_env_var = Nothing }
......
......@@ -10,7 +10,7 @@
module HscTypes (
-- * compilation state
HscEnv(..), hscEPS,
FinderCache, FindResult(..), ModLocationCache,
FinderCache, FindResult(..),
Target(..), TargetId(..), pprTarget, pprTargetId,
ModuleGraph, emptyMG,
HscStatus(..),
......@@ -388,9 +388,6 @@ data HscEnv
hsc_FC :: {-# UNPACK #-} !(IORef FinderCache),
-- ^ The cached result of performing finding in the file system
hsc_MLC :: {-# UNPACK #-} !(IORef ModLocationCache),
-- ^ This caches the location of modules, so we don't have to
-- search the filesystem multiple times. See also 'hsc_FC'.
hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
-- ^ Used for one-shot compilation only, to initialise
......@@ -673,7 +670,7 @@ prepareAnnotations hsc_env mb_guts = do
************************************************************************
-}
-- | The 'FinderCache' maps home module names to the result of
-- | The 'FinderCache' maps modules to the result of
-- searching for that module. It records the results of searching for
-- modules along the search path. On @:load@, we flush the entire
-- contents of this cache.
......@@ -681,7 +678,7 @@ prepareAnnotations hsc_env mb_guts = do
-- Although the @FinderCache@ range is 'FindResult' for convenience,
-- in fact it will only ever contain 'Found' or 'NotFound' entries.
--
type FinderCache = ModuleNameEnv FindResult
type FinderCache = ModuleEnv FindResult
-- | The result of searching for an imported module.
data FindResult
......@@ -709,11 +706,6 @@ data FindResult
, fr_suggestions :: [ModuleSuggestion] -- Possible mis-spelled modules
}
-- | Cache that remembers where we found a particular module. Contains both
-- home modules and package modules. On @:load@, only home modules are
-- purged from this cache.
type ModLocationCache = ModuleEnv ModLocation
{-
************************************************************************
* *
......
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