From bb8f9dc0f3addd24c58bc97d840421d4e3119129 Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Tue, 15 Oct 2024 13:46:03 -0400
Subject: [PATCH] Revert "finder: Add `IsBootInterface` to finder cache keys"
There are objections raised on the MR (!13237) and the interface change
makes me rather uncomfortable.
This reverts commit fb82ee70d9f7fe43cd1cd2aa7263e9aef6cf9238.
---
compiler/GHC/Driver/Backpack.hs | 4 +-
compiler/GHC/Driver/Make.hs | 43 ++++---------
compiler/GHC/Driver/Pipeline/Execute.hs | 2 +-
compiler/GHC/Unit/Finder.hs | 45 +++++++-------
compiler/GHC/Unit/Finder/Types.hs | 2 +-
compiler/GHC/Unit/Module/Env.hs | 64 --------------------
compiler/GHC/Unit/Types.hs | 7 ---
testsuite/tests/driver/boot-target/A.hs | 5 --
testsuite/tests/driver/boot-target/A.hs-boot | 3 -
testsuite/tests/driver/boot-target/B.hs | 5 --
testsuite/tests/driver/boot-target/Makefile | 8 ---
testsuite/tests/driver/boot-target/all.T | 10 ---
12 files changed, 39 insertions(+), 159 deletions(-)
delete mode 100644 testsuite/tests/driver/boot-target/A.hs
delete mode 100644 testsuite/tests/driver/boot-target/A.hs-boot
delete mode 100644 testsuite/tests/driver/boot-target/B.hs
delete mode 100644 testsuite/tests/driver/boot-target/Makefile
delete mode 100644 testsuite/tests/driver/boot-target/all.T
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 3af9f6feab3..416fe1659d8 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -781,7 +781,7 @@ summariseRequirement pn mod_name = do
let loc = srcLocSpan (mkSrcLoc (mkFastString (bkp_filename env)) 1 1)
let fc = hsc_FC hsc_env
- mod <- liftIO $ addHomeModuleToFinder fc home_unit (notBoot mod_name) location
+ mod <- liftIO $ addHomeModuleToFinder fc home_unit mod_name location
extra_sig_imports <- liftIO $ findExtraSigImports hsc_env HsigFile mod_name
@@ -893,7 +893,7 @@ hsModuleToModSummary home_keys pn hsc_src modname
this_mod <- liftIO $ do
let home_unit = hsc_home_unit hsc_env
let fc = hsc_FC hsc_env
- addHomeModuleToFinder fc home_unit (GWIB modname (hscSourceToIsBoot hsc_src)) location
+ addHomeModuleToFinder fc home_unit modname location
let ms = ModSummary {
ms_mod = this_mod,
ms_hsc_src = hsc_src,
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 3ec69fb04b2..7c0c1216878 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -2055,43 +2055,25 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
<- getPreprocessedImports hsc_env src_fn mb_phase maybe_buf
let fopts = initFinderOpts (hsc_dflags hsc_env)
- src_path = src_fn
-
- is_boot = case takeExtension src_fn of
- ".hs-boot" -> IsBoot
- ".lhs-boot" -> IsBoot
- _ -> NotBoot
-
- (path_without_boot, hsc_src)
- | isHaskellSigFilename src_fn = (src_path, HsigFile)
- | IsBoot <- is_boot = (removeBootSuffix src_path, HsBootFile)
- | otherwise = (src_path, HsSrcFile)
-
- -- Make a ModLocation for the Finder, who only has one entry for
- -- each @ModuleName@, and therefore needs to use the locations for
- -- the non-boot files.
- location_without_boot =
- mkHomeModLocation fopts pi_mod_name path_without_boot
-
- -- Make a ModLocation for this file, adding the @-boot@ suffix to
- -- all paths if the original was a boot file.
- location
- | IsBoot <- is_boot
- = addBootSuffixLocn location_without_boot
- | otherwise
- = location_without_boot
+
+ -- Make a ModLocation for this file
+ let location = mkHomeModLocation fopts pi_mod_name src_fn
-- Tell the Finder cache where it is, so that subsequent calls
-- to findModule will find it, even if it's not on any search path
mod <- liftIO $ do
let home_unit = hsc_home_unit hsc_env
let fc = hsc_FC hsc_env
- addHomeModuleToFinder fc home_unit (GWIB pi_mod_name is_boot) location
+ addHomeModuleToFinder fc home_unit pi_mod_name location
liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
{ nms_src_fn = src_fn
, nms_src_hash = src_hash
- , nms_hsc_src = hsc_src
+ , nms_is_boot = NotBoot
+ , nms_hsc_src =
+ if isHaskellSigFilename src_fn
+ then HsigFile
+ else HsSrcFile
, nms_location = location
, nms_mod = mod
, nms_preimps = preimps
@@ -2119,10 +2101,9 @@ checkSummaryHash
-- Also, only add to finder cache for non-boot modules as the finder cache
-- makes sure to add a boot suffix for boot files.
_ <- do
- let fc = hsc_FC hsc_env
- gwib = GWIB (ms_mod old_summary) (isBootSummary old_summary)
+ let fc = hsc_FC hsc_env
case ms_hsc_src old_summary of
- HsSrcFile -> addModuleToFinder fc gwib location
+ HsSrcFile -> addModuleToFinder fc (ms_mod old_summary) location
_ -> return ()
hi_timestamp <- modificationTimeIfExists (ml_hi_file location)
@@ -2260,6 +2241,7 @@ summariseModule hsc_env' home_unit old_summary_map is_boot (L _ wanted_mod) mb_p
liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
{ nms_src_fn = src_fn
, nms_src_hash = src_hash
+ , nms_is_boot = is_boot
, nms_hsc_src = hsc_src
, nms_location = location
, nms_mod = mod
@@ -2272,6 +2254,7 @@ data MakeNewModSummary
= MakeNewModSummary
{ nms_src_fn :: FilePath
, nms_src_hash :: Fingerprint
+ , nms_is_boot :: IsBootInterface
, nms_hsc_src :: HscSource
, nms_location :: ModLocation
, nms_mod :: Module
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index a0fe18b759c..5e26d48b36e 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -743,7 +743,7 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do
mod <- do
let home_unit = hsc_home_unit hsc_env
let fc = hsc_FC hsc_env
- addHomeModuleToFinder fc home_unit (GWIB mod_name (hscSourceToIsBoot src_flavour)) location
+ addHomeModuleToFinder fc home_unit mod_name location
-- Make the ModSummary to hand to hscMain
let
diff --git a/compiler/GHC/Unit/Finder.hs b/compiler/GHC/Unit/Finder.hs
index 78a8e5c383c..c113e2592f9 100644
--- a/compiler/GHC/Unit/Finder.hs
+++ b/compiler/GHC/Unit/Finder.hs
@@ -89,7 +89,7 @@ type BaseName = String -- Basename of file
initFinderCache :: IO FinderCache
-initFinderCache = FinderCache <$> newIORef emptyInstalledModuleWithIsBootEnv
+initFinderCache = FinderCache <$> newIORef emptyInstalledModuleEnv
<*> newIORef M.empty
-- remove all the home modules from the cache; package modules are
@@ -97,23 +97,23 @@ initFinderCache = FinderCache <$> newIORef emptyInstalledModuleWithIsBootEnv
-- cache
flushFinderCaches :: FinderCache -> UnitEnv -> IO ()
flushFinderCaches (FinderCache ref file_ref) ue = do
- atomicModifyIORef' ref $ \fm -> (filterInstalledModuleWithIsBootEnv is_ext fm, ())
+ atomicModifyIORef' ref $ \fm -> (filterInstalledModuleEnv is_ext fm, ())
atomicModifyIORef' file_ref $ \_ -> (M.empty, ())
where
- is_ext mod _ = not (isUnitEnvInstalledModule ue (gwib_mod mod))
+ is_ext mod _ = not (isUnitEnvInstalledModule ue mod)
-addToFinderCache :: FinderCache -> InstalledModuleWithIsBoot -> InstalledFindResult -> IO ()
+addToFinderCache :: FinderCache -> InstalledModule -> InstalledFindResult -> IO ()
addToFinderCache (FinderCache ref _) key val =
- atomicModifyIORef' ref $ \c -> (extendInstalledModuleWithIsBootEnv c key val, ())
+ atomicModifyIORef' ref $ \c -> (extendInstalledModuleEnv c key val, ())
-removeFromFinderCache :: FinderCache -> InstalledModuleWithIsBoot -> IO ()
+removeFromFinderCache :: FinderCache -> InstalledModule -> IO ()
removeFromFinderCache (FinderCache ref _) key =
- atomicModifyIORef' ref $ \c -> (delInstalledModuleWithIsBootEnv c key, ())
+ atomicModifyIORef' ref $ \c -> (delInstalledModuleEnv c key, ())
-lookupFinderCache :: FinderCache -> InstalledModuleWithIsBoot -> IO (Maybe InstalledFindResult)
+lookupFinderCache :: FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult)
lookupFinderCache (FinderCache ref _) key = do
c <- readIORef ref
- return $! lookupInstalledModuleWithIsBootEnv c key
+ return $! lookupInstalledModuleEnv c key
lookupFileCache :: FinderCache -> FilePath -> IO Fingerprint
lookupFileCache (FinderCache _ ref) key = do
@@ -262,7 +262,7 @@ orIfNotFound this or_this = do
homeSearchCache :: FinderCache -> UnitId -> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult
homeSearchCache fc home_unit mod_name do_this = do
let mod = mkModule home_unit mod_name
- modLocationCache fc (notBoot mod) do_this
+ modLocationCache fc mod do_this
findExposedPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> PkgQual -> IO FindResult
findExposedPackageModule fc fopts units mod_name mb_pkg =
@@ -319,7 +319,7 @@ findLookupResult fc fopts r = case r of
, fr_unusables = []
, fr_suggestions = suggest' })
-modLocationCache :: FinderCache -> InstalledModuleWithIsBoot -> IO InstalledFindResult -> IO InstalledFindResult
+modLocationCache :: FinderCache -> InstalledModule -> IO InstalledFindResult -> IO InstalledFindResult
modLocationCache fc mod do_this = do
m <- lookupFinderCache fc mod
case m of
@@ -329,23 +329,22 @@ modLocationCache fc mod do_this = do
addToFinderCache fc mod result
return result
-addModuleToFinder :: FinderCache -> ModuleWithIsBoot -> ModLocation -> IO ()
+addModuleToFinder :: FinderCache -> Module -> ModLocation -> IO ()
addModuleToFinder fc mod loc = do
- let imod = fmap toUnitId <$> mod
- addToFinderCache fc imod (InstalledFound loc (gwib_mod imod))
+ let imod = toUnitId <$> mod
+ addToFinderCache fc imod (InstalledFound loc imod)
-- This returns a module because it's more convenient for users
-addHomeModuleToFinder :: FinderCache -> HomeUnit -> ModuleNameWithIsBoot -> ModLocation -> IO Module
+addHomeModuleToFinder :: FinderCache -> HomeUnit -> ModuleName -> ModLocation -> IO Module
addHomeModuleToFinder fc home_unit mod_name loc = do
- let mod = mkHomeInstalledModule home_unit <$> mod_name
- addToFinderCache fc mod (InstalledFound loc (gwib_mod mod))
- return (mkHomeModule home_unit (gwib_mod mod_name))
+ let mod = mkHomeInstalledModule home_unit mod_name
+ addToFinderCache fc mod (InstalledFound loc mod)
+ return (mkHomeModule home_unit mod_name)
-uncacheModule :: FinderCache -> HomeUnit -> ModuleNameWithIsBoot -> IO ()
+uncacheModule :: FinderCache -> HomeUnit -> ModuleName -> IO ()
uncacheModule fc home_unit mod_name = do
- let mod = mkHomeInstalledModule home_unit (gwib_mod mod_name)
- removeFromFinderCache fc (GWIB mod (gwib_isBoot mod_name))
-
+ let mod = mkHomeInstalledModule home_unit mod_name
+ removeFromFinderCache fc mod
-- -----------------------------------------------------------------------------
-- The internal workers
@@ -478,7 +477,7 @@ findPackageModule_ :: FinderCache -> FinderOpts -> InstalledModule -> UnitInfo -
findPackageModule_ fc fopts mod pkg_conf = do
massertPpr (moduleUnit mod == unitId pkg_conf)
(ppr (moduleUnit mod) <+> ppr (unitId pkg_conf))
- modLocationCache fc (notBoot mod) $
+ modLocationCache fc mod $
-- special case for GHC.Prim; we won't find it in the filesystem.
if mod `installedModuleEq` gHC_PRIM
diff --git a/compiler/GHC/Unit/Finder/Types.hs b/compiler/GHC/Unit/Finder/Types.hs
index 8f33fc54ac7..fceb4b03648 100644
--- a/compiler/GHC/Unit/Finder/Types.hs
+++ b/compiler/GHC/Unit/Finder/Types.hs
@@ -22,7 +22,7 @@ import qualified Data.Set as Set
-- modules along the search path. On @:load@, we flush the entire
-- contents of this cache.
--
-type FinderCacheState = InstalledModuleWithIsBootEnv InstalledFindResult
+type FinderCacheState = InstalledModuleEnv InstalledFindResult
type FileCacheState = M.Map FilePath Fingerprint
data FinderCache = FinderCache { fcModuleCache :: (IORef FinderCacheState)
, fcFileCache :: (IORef FileCacheState)
diff --git a/compiler/GHC/Unit/Module/Env.hs b/compiler/GHC/Unit/Module/Env.hs
index 6b16a7c3fed..c9825396882 100644
--- a/compiler/GHC/Unit/Module/Env.hs
+++ b/compiler/GHC/Unit/Module/Env.hs
@@ -33,17 +33,6 @@ module GHC.Unit.Module.Env
, mergeInstalledModuleEnv
, plusInstalledModuleEnv
, installedModuleEnvElts
-
- -- * InstalledModuleWithIsBootEnv
- , InstalledModuleWithIsBootEnv
- , emptyInstalledModuleWithIsBootEnv
- , lookupInstalledModuleWithIsBootEnv
- , extendInstalledModuleWithIsBootEnv
- , filterInstalledModuleWithIsBootEnv
- , delInstalledModuleWithIsBootEnv
- , mergeInstalledModuleWithIsBootEnv
- , plusInstalledModuleWithIsBootEnv
- , installedModuleWithIsBootEnvElts
)
where
@@ -294,56 +283,3 @@ plusInstalledModuleEnv :: (elt -> elt -> elt)
plusInstalledModuleEnv f (InstalledModuleEnv xm) (InstalledModuleEnv ym) =
InstalledModuleEnv $ Map.unionWith f xm ym
-
-
---------------------------------------------------------------------
--- InstalledModuleWithIsBootEnv
---------------------------------------------------------------------
-
--- | A map keyed off of 'InstalledModuleWithIsBoot'
-newtype InstalledModuleWithIsBootEnv elt = InstalledModuleWithIsBootEnv (Map InstalledModuleWithIsBoot elt)
-
-instance Outputable elt => Outputable (InstalledModuleWithIsBootEnv elt) where
- ppr (InstalledModuleWithIsBootEnv env) = ppr env
-
-
-emptyInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a
-emptyInstalledModuleWithIsBootEnv = InstalledModuleWithIsBootEnv Map.empty
-
-lookupInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBoot -> Maybe a
-lookupInstalledModuleWithIsBootEnv (InstalledModuleWithIsBootEnv e) m = Map.lookup m e
-
-extendInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBoot -> a -> InstalledModuleWithIsBootEnv a
-extendInstalledModuleWithIsBootEnv (InstalledModuleWithIsBootEnv e) m x = InstalledModuleWithIsBootEnv (Map.insert m x e)
-
-filterInstalledModuleWithIsBootEnv :: (InstalledModuleWithIsBoot -> a -> Bool) -> InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBootEnv a
-filterInstalledModuleWithIsBootEnv f (InstalledModuleWithIsBootEnv e) =
- InstalledModuleWithIsBootEnv (Map.filterWithKey f e)
-
-delInstalledModuleWithIsBootEnv :: InstalledModuleWithIsBootEnv a -> InstalledModuleWithIsBoot -> InstalledModuleWithIsBootEnv a
-delInstalledModuleWithIsBootEnv (InstalledModuleWithIsBootEnv e) m = InstalledModuleWithIsBootEnv (Map.delete m e)
-
-installedModuleWithIsBootEnvElts :: InstalledModuleWithIsBootEnv a -> [(InstalledModuleWithIsBoot, a)]
-installedModuleWithIsBootEnvElts (InstalledModuleWithIsBootEnv e) = Map.assocs e
-
-mergeInstalledModuleWithIsBootEnv
- :: (elta -> eltb -> Maybe eltc)
- -> (InstalledModuleWithIsBootEnv elta -> InstalledModuleWithIsBootEnv eltc) -- map X
- -> (InstalledModuleWithIsBootEnv eltb -> InstalledModuleWithIsBootEnv eltc) -- map Y
- -> InstalledModuleWithIsBootEnv elta
- -> InstalledModuleWithIsBootEnv eltb
- -> InstalledModuleWithIsBootEnv eltc
-mergeInstalledModuleWithIsBootEnv f g h (InstalledModuleWithIsBootEnv xm) (InstalledModuleWithIsBootEnv ym)
- = InstalledModuleWithIsBootEnv $ Map.mergeWithKey
- (\_ x y -> (x `f` y))
- (coerce g)
- (coerce h)
- xm ym
-
-plusInstalledModuleWithIsBootEnv :: (elt -> elt -> elt)
- -> InstalledModuleWithIsBootEnv elt
- -> InstalledModuleWithIsBootEnv elt
- -> InstalledModuleWithIsBootEnv elt
-plusInstalledModuleWithIsBootEnv f (InstalledModuleWithIsBootEnv xm) (InstalledModuleWithIsBootEnv ym) =
- InstalledModuleWithIsBootEnv $ Map.unionWith f xm ym
-
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
index f7f3f531ea2..80fc3675375 100644
--- a/compiler/GHC/Unit/Types.hs
+++ b/compiler/GHC/Unit/Types.hs
@@ -86,8 +86,6 @@ module GHC.Unit.Types
, GenWithIsBoot (..)
, ModuleNameWithIsBoot
, ModuleWithIsBoot
- , InstalledModuleWithIsBoot
- , notBoot
)
where
@@ -715,8 +713,6 @@ type ModuleNameWithIsBoot = GenWithIsBoot ModuleName
type ModuleWithIsBoot = GenWithIsBoot Module
-type InstalledModuleWithIsBoot = GenWithIsBoot InstalledModule
-
instance Binary a => Binary (GenWithIsBoot a) where
put_ bh (GWIB { gwib_mod, gwib_isBoot }) = do
put_ bh gwib_mod
@@ -730,6 +726,3 @@ instance Outputable a => Outputable (GenWithIsBoot a) where
ppr (GWIB { gwib_mod, gwib_isBoot }) = hsep $ ppr gwib_mod : case gwib_isBoot of
IsBoot -> [ text "{-# SOURCE #-}" ]
NotBoot -> []
-
-notBoot :: mod -> GenWithIsBoot mod
-notBoot gwib_mod = GWIB {gwib_mod, gwib_isBoot = NotBoot}
diff --git a/testsuite/tests/driver/boot-target/A.hs b/testsuite/tests/driver/boot-target/A.hs
deleted file mode 100644
index 0a2f230d1fe..00000000000
--- a/testsuite/tests/driver/boot-target/A.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-module A where
-
-import B
-
-data A = A B
diff --git a/testsuite/tests/driver/boot-target/A.hs-boot b/testsuite/tests/driver/boot-target/A.hs-boot
deleted file mode 100644
index fb541bf67e8..00000000000
--- a/testsuite/tests/driver/boot-target/A.hs-boot
+++ /dev/null
@@ -1,3 +0,0 @@
-module A where
-
-data A
diff --git a/testsuite/tests/driver/boot-target/B.hs b/testsuite/tests/driver/boot-target/B.hs
deleted file mode 100644
index 024ed67b718..00000000000
--- a/testsuite/tests/driver/boot-target/B.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-module B where
-
-import {-# source #-} A
-
-data B = B A
diff --git a/testsuite/tests/driver/boot-target/Makefile b/testsuite/tests/driver/boot-target/Makefile
deleted file mode 100644
index d9404ccc8c1..00000000000
--- a/testsuite/tests/driver/boot-target/Makefile
+++ /dev/null
@@ -1,8 +0,0 @@
-boot1:
- $(TEST_HC) -c A.hs-boot B.hs
-
-boot2:
- $(TEST_HC) A.hs-boot A.hs B.hs -v0
-
-boot3:
- $(TEST_HC) A.hs-boot B.hs -v0
\ No newline at end of file
diff --git a/testsuite/tests/driver/boot-target/all.T b/testsuite/tests/driver/boot-target/all.T
deleted file mode 100644
index 5995bfb2827..00000000000
--- a/testsuite/tests/driver/boot-target/all.T
+++ /dev/null
@@ -1,10 +0,0 @@
-def test_boot(name):
- return test(name,
- [extra_files(['A.hs', 'A.hs-boot', 'B.hs']),
- ],
- makefile_test,
- [])
-
-test_boot('boot1')
-test_boot('boot2')
-test_boot('boot3')
--
GitLab