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: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: simonpj, austin

Subscribers: thomie

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

3 files changed, 20 insertions, 68 deletions

diff --git a/compiler/main/Finder.hs b/compiler/main/Finder.hs
index 7fde4c2460..befa0304ab 100644
--- a/compiler/main/Finder.hs
+++ b/compiler/main/Finder.hs
@@ -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,47 +67,25 @@ 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
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index c1675dd299..381b902018 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -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 }
 
 
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 2f635305f9..09f643cc2e 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -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
-
 {-
 ************************************************************************
 *                                                                      *