[Git][ghc/ghc][ghc-9.8] 2 commits: Revert "finder: Add `IsBootInterface` to finder cache keys"
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Tue Oct 15 21:30:32 UTC 2024
Ben Gamari pushed to branch ghc-9.8 at Glasgow Haskell Compiler / GHC
Commits:
bb8f9dc0 by Ben Gamari at 2024-10-15T13:46:09-04:00
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.
- - - - -
036044df by Ben Gamari at 2024-10-15T17:30:09-04:00
Revert "gitlab-ci: Update bootstrap_matrix"
This reverts commit c332cb09f1bc767536bd2afd12c9ccbcf0a34289.
- - - - -
13 changed files:
- .gitlab-ci.yml
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Finder/Types.hs
- compiler/GHC/Unit/Module/Env.hs
- compiler/GHC/Unit/Types.hs
- − testsuite/tests/driver/boot-target/A.hs
- − testsuite/tests/driver/boot-target/A.hs-boot
- − testsuite/tests/driver/boot-target/B.hs
- − testsuite/tests/driver/boot-target/Makefile
- − testsuite/tests/driver/boot-target/all.T
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -84,7 +84,7 @@ workflow:
matrix:
- GHC_VERSION: 9.4.3
DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV"
- - GHC_VERSION: 9.6.5
+ - GHC_VERSION: 9.6.2
DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10-ghc9_6:$DOCKER_REV"
# Allow linters to fail on draft MRs.
=====================================
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,
=====================================
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
=====================================
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
=====================================
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
=====================================
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)
=====================================
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
-
=====================================
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}
=====================================
testsuite/tests/driver/boot-target/A.hs deleted
=====================================
@@ -1,5 +0,0 @@
-module A where
-
-import B
-
-data A = A B
=====================================
testsuite/tests/driver/boot-target/A.hs-boot deleted
=====================================
@@ -1,3 +0,0 @@
-module A where
-
-data A
=====================================
testsuite/tests/driver/boot-target/B.hs deleted
=====================================
@@ -1,5 +0,0 @@
-module B where
-
-import {-# source #-} A
-
-data B = B A
=====================================
testsuite/tests/driver/boot-target/Makefile deleted
=====================================
@@ -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
=====================================
testsuite/tests/driver/boot-target/all.T deleted
=====================================
@@ -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')
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c332cb09f1bc767536bd2afd12c9ccbcf0a34289...036044dffaa555f217fdd696d425dc877e21d9b9
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c332cb09f1bc767536bd2afd12c9ccbcf0a34289...036044dffaa555f217fdd696d425dc877e21d9b9
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241015/f161ca35/attachment-0001.html>
More information about the ghc-commits
mailing list