[Git][ghc/ghc][wip/sv/T25246-b] More boot-file awareness in Finder
Sjoerd Visscher (@trac-sjoerd_visscher)
gitlab at gitlab.haskell.org
Thu Oct 10 12:09:43 UTC 2024
Sjoerd Visscher pushed to branch wip/sv/T25246-b at Glasgow Haskell Compiler / GHC
Commits:
49532ac1 by Sjoerd Visscher at 2024-10-10T14:09:30+02:00
More boot-file awareness in Finder
Finishes work started in fff55592
Adds findImportedModuleWithIsBoot and findHomeModuleWithIsBoot so that callers don't have to call addBootSuffix on the result.
Removes InstalledModule field from InstalledFound constructor since it's already part of the key that was searched for.
- - - - -
8 changed files:
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/MakeFile.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Unit/Finder.hs
- compiler/GHC/Unit/Finder/Types.hs
- compiler/GHC/Unit/Module/Location.hs
Changes:
=====================================
compiler/GHC/Driver/Backpack.hs
=====================================
@@ -771,7 +771,7 @@ summariseRequirement pn mod_name = do
let fopts = initFinderOpts dflags
let PackageName pn_fs = pn
- let location = mkHomeModLocation2 fopts mod_name
+ let location = mkHomeModLocation2 fopts (notBoot mod_name)
(unsafeEncodeUtf $ unpackFS pn_fs </> moduleNameSlashes mod_name) (os "hsig")
env <- getBkpEnv
@@ -848,23 +848,20 @@ hsModuleToModSummary home_keys pn hsc_src modname
let PackageName unit_fs = pn
dflags = hsc_dflags hsc_env
fopts = initFinderOpts dflags
+ modWithIsBoot = GWIB modname (hscSourceToIsBoot hsc_src)
-- Unfortunately, we have to define a "fake" location in
-- order to appease the various code which uses the file
-- name to figure out where to put, e.g. object files.
-- To add insult to injury, we don't even actually use
-- these filenames to figure out where the hi files go.
-- A travesty!
- let location0 = mkHomeModLocation2 fopts modname
+ let location = mkHomeModLocation2 fopts modWithIsBoot
(unsafeEncodeUtf $ unpackFS unit_fs </>
moduleNameSlashes modname)
(case hsc_src of
HsigFile -> os "hsig"
HsBootFile -> os "hs-boot"
HsSrcFile -> os "hs")
- -- DANGEROUS: bootifying can POISON the module finder cache
- let location = case hsc_src of
- HsBootFile -> addBootSuffixLocnOut location0
- _ -> location0
-- This duplicates a pile of logic in GHC.Driver.Make
hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file location)
hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file location)
@@ -893,7 +890,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 modWithIsBoot location
let ms = ModSummary {
ms_mod = this_mod,
ms_hsc_src = hsc_src,
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -2126,31 +2126,21 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
".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
+ modWithIsBoot = GWIB pi_mod_name is_boot
+
+ hsc_src
+ | IsBoot <- is_boot = HsBootFile
+ | isHaskellSigFilename src_fn = HsigFile
+ | otherwise = HsSrcFile
+
+ location = mkHomeModLocation fopts modWithIsBoot src_path
-- 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 modWithIsBoot location
liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary
{ nms_src_fn = src_fn
@@ -2180,14 +2170,10 @@ checkSummaryHash
-- and it was likely flushed in depanal. This is not technically
-- needed when we're called from sumariseModule but it shouldn't
-- hurt.
- -- 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)
- case ms_hsc_src old_summary of
- HsSrcFile -> addModuleToFinder fc gwib location
- _ -> return ()
+ addModuleToFinder fc gwib location
hi_timestamp <- modificationTimeIfExists (ml_hi_file location)
hie_timestamp <- modificationTimeIfExists (ml_hie_file location)
@@ -2239,7 +2225,7 @@ summariseModule hsc_env' home_unit old_summary_map is_boot (L _ wanted_mod) mb_p
find_it :: IO SummariseResult
find_it = do
- found <- findImportedModule hsc_env wanted_mod mb_pkg
+ found <- findImportedModuleWithIsBoot hsc_env (GWIB wanted_mod is_boot) mb_pkg
case found of
Found location mod
| isJust (ml_hs_file location) ->
@@ -2257,10 +2243,7 @@ summariseModule hsc_env' home_unit old_summary_map is_boot (L _ wanted_mod) mb_p
just_found location mod = do
-- Adjust location to point to the hs-boot source file,
-- hi file, object file, when is_boot says so
- let location' = case is_boot of
- IsBoot -> addBootSuffixLocn location
- NotBoot -> location
- src_fn = expectJust "summarise2" (ml_hs_file location')
+ let src_fn = expectJust "summarise2" (ml_hs_file location)
-- Check that it exists
-- It might have been deleted since the Finder last found it
@@ -2270,7 +2253,7 @@ summariseModule hsc_env' home_unit old_summary_map is_boot (L _ wanted_mod) mb_p
-- .hs-boot file doesn't exist.
Nothing -> return NotThere
Just h -> do
- fresult <- new_summary_cache_check location' mod src_fn h
+ fresult <- new_summary_cache_check location mod src_fn h
return $ case fresult of
Left err -> FoundHomeWithError (moduleUnitId mod, err)
Right ms -> FoundHome ms
=====================================
compiler/GHC/Driver/MakeFile.hs
=====================================
@@ -292,12 +292,12 @@ findDependency :: HscEnv
findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do
-- Find the module; this will be fast because
-- we've done it once during downsweep
- r <- findImportedModule hsc_env imp pkg
+ r <- findImportedModuleWithIsBoot hsc_env (GWIB imp is_boot) pkg
case r of
Found loc _
-- Home package: just depend on the .hi or hi-boot file
| isJust (ml_hs_file loc) || include_pkg_deps
- -> return (Just (unsafeDecodeUtf $ addBootSuffix_maybe is_boot (ml_hi_file_ospath loc)))
+ -> return (Just (unsafeDecodeUtf $ ml_hi_file_ospath loc))
-- Not in this package: we don't need a dependency
| otherwise
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -777,24 +777,19 @@ mkOneShotModLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO Mod
mkOneShotModLocation pipe_env dflags src_flavour mod_name = do
let PipeEnv{ src_basename=basename,
src_suffix=suff } = pipe_env
- let location1 = mkHomeModLocation2 fopts mod_name (unsafeEncodeUtf basename) (unsafeEncodeUtf suff)
-
- -- Boot-ify it if necessary
- let location2
- | HsBootFile <- src_flavour = addBootSuffixLocnOut location1
- | otherwise = location1
-
+ modWithIsBoot = GWIB mod_name (hscSourceToIsBoot src_flavour)
+ let location1 = mkHomeModLocation2 fopts modWithIsBoot (unsafeEncodeUtf basename) (unsafeEncodeUtf suff)
-- Take -ohi into account if present
-- This can't be done in mkHomeModuleLocation because
-- it only applies to the module being compiles
let ohi = outputHi dflags
- location3 | Just fn <- ohi = location2{ ml_hi_file_ospath = unsafeEncodeUtf fn }
- | otherwise = location2
+ location2 | Just fn <- ohi = location1{ ml_hi_file_ospath = unsafeEncodeUtf fn }
+ | otherwise = location1
let dynohi = dynOutputHi dflags
- location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file_ospath = unsafeEncodeUtf fn }
- | otherwise = location3
+ location3 | Just fn <- dynohi = location2{ ml_dyn_hi_file_ospath = unsafeEncodeUtf fn }
+ | otherwise = location2
-- Take -o into account if present
-- Very like -ohi, but we must *only* do this if we aren't linking
@@ -804,15 +799,15 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do
-- above
let expl_o_file = outputFile_ dflags
expl_dyn_o_file = dynOutputFile_ dflags
- location5 | Just ofile <- expl_o_file
+ location4 | Just ofile <- expl_o_file
, let dyn_ofile = fromMaybe (ofile -<.> dynObjectSuf_ dflags) expl_dyn_o_file
, isNoLink (ghcLink dflags)
- = location4 { ml_obj_file_ospath = unsafeEncodeUtf ofile
+ = location3 { ml_obj_file_ospath = unsafeEncodeUtf ofile
, ml_dyn_obj_file_ospath = unsafeEncodeUtf dyn_ofile }
| Just dyn_ofile <- expl_dyn_o_file
- = location4 { ml_dyn_obj_file_ospath = unsafeEncodeUtf dyn_ofile }
- | otherwise = location4
- return location5
+ = location3 { ml_dyn_obj_file_ospath = unsafeEncodeUtf dyn_ofile }
+ | otherwise = location3
+ return location4
where
fopts = initFinderOpts dflags
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -317,7 +317,7 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg
-- interface; it will call the Finder again, but the ModLocation will be
-- cached from the first search.
= do hsc_env <- getTopEnv
- res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
+ res <- liftIO $ findImportedModuleWithIsBoot hsc_env (GWIB mod want_boot) maybe_pkg
case res of
Found _ mod -> initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
-- TODO: Make sure this error message is good
@@ -895,9 +895,9 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
else do
let fopts = initFinderOpts dflags
-- Look for the file
- mb_found <- liftIO (findExactModule fc fopts other_fopts unit_state mhome_unit mod)
+ mb_found <- liftIO (findExactModule fc fopts other_fopts unit_state mhome_unit (GWIB mod hi_boot_file))
case mb_found of
- InstalledFound (addBootSuffixLocn_maybe hi_boot_file -> loc) mod -> do
+ InstalledFound loc -> do
-- See Note [Home module load error]
case mhome_unit of
Just home_unit
=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -15,9 +15,11 @@ module GHC.Unit.Finder (
FinderCache(..),
initFinderCache,
findImportedModule,
+ findImportedModuleWithIsBoot,
findPluginModule,
findExactModule,
findHomeModule,
+ findHomeModuleWithIsBoot,
findExposedPackageModule,
mkHomeModLocation,
mkHomeModLocation2,
@@ -148,7 +150,10 @@ initFinderCache = do
-- that package is searched for the module.
findImportedModule :: HscEnv -> ModuleName -> PkgQual -> IO FindResult
-findImportedModule hsc_env mod pkg_qual =
+findImportedModule hsc_env = findImportedModuleWithIsBoot hsc_env . notBoot
+
+findImportedModuleWithIsBoot :: HscEnv -> ModuleNameWithIsBoot -> PkgQual -> IO FindResult
+findImportedModuleWithIsBoot hsc_env mod pkg_qual =
let fc = hsc_FC hsc_env
mhome_unit = hsc_home_unit_maybe hsc_env
dflags = hsc_dflags hsc_env
@@ -161,10 +166,10 @@ findImportedModuleNoHsc
-> FinderOpts
-> UnitEnv
-> Maybe HomeUnit
- -> ModuleName
+ -> ModuleNameWithIsBoot
-> PkgQual
-> IO FindResult
-findImportedModuleNoHsc fc fopts ue mhome_unit mod_name mb_pkg =
+findImportedModuleNoHsc fc fopts ue mhome_unit gwib at GWIB { gwib_mod = mod_name } mb_pkg =
case mb_pkg of
NoPkgQual -> unqual_import
ThisPkg uid | (homeUnitId <$> mhome_unit) == Just uid -> home_import
@@ -178,7 +183,7 @@ findImportedModuleNoHsc fc fopts ue mhome_unit mod_name mb_pkg =
home_import = case mhome_unit of
- Just home_unit -> findHomeModule fc fopts home_unit mod_name
+ Just home_unit -> findHomeModuleWithIsBoot fc fopts home_unit gwib
Nothing -> pure $ NoPackage (panic "findImportedModule: no home-unit")
@@ -186,11 +191,11 @@ findImportedModuleNoHsc fc fopts ue mhome_unit mod_name mb_pkg =
-- If the module is reexported, then look for it as if it was from the perspective
-- of that package which reexports it.
| Just real_mod_name <- mod_name `M.lookup` finder_reexportedModules opts =
- findImportedModuleNoHsc fc opts ue (Just $ DefiniteHomeUnit uid Nothing) real_mod_name NoPkgQual
+ findImportedModuleNoHsc fc opts ue (Just $ DefiniteHomeUnit uid Nothing) gwib{ gwib_mod = real_mod_name } NoPkgQual
| mod_name `Set.member` finder_hiddenModules opts =
return (mkHomeHidden uid)
| otherwise =
- findHomePackageModule fc opts uid mod_name
+ findHomePackageModule fc opts uid gwib
-- Do not be smart and change this to `foldr orIfNotFound home_import hs` as
-- that is not the same!! home_import is first because we need to look within ourselves
@@ -228,15 +233,15 @@ findPluginModule fc fopts units Nothing mod_name =
-- reading the interface for a module mentioned by another interface,
-- for example (a "system import").
-findExactModule :: FinderCache -> FinderOpts -> UnitEnvGraph FinderOpts -> UnitState -> Maybe HomeUnit -> InstalledModule -> IO InstalledFindResult
-findExactModule fc fopts other_fopts unit_state mhome_unit mod = do
+findExactModule :: FinderCache -> FinderOpts -> UnitEnvGraph FinderOpts -> UnitState -> Maybe HomeUnit -> InstalledModuleWithIsBoot -> IO InstalledFindResult
+findExactModule fc fopts other_fopts unit_state mhome_unit gwib at GWIB { gwib_mod = mod } = do
case mhome_unit of
Just home_unit
| isHomeInstalledModule home_unit mod
- -> findInstalledHomeModule fc fopts (homeUnitId home_unit) (moduleName mod)
+ -> findInstalledHomeModule fc fopts (homeUnitId home_unit) (moduleName <$> gwib)
| Just home_fopts <- unitEnv_lookup_maybe (moduleUnit mod) other_fopts
- -> findInstalledHomeModule fc home_fopts (moduleUnit mod) (moduleName mod)
- _ -> findPackageModule fc unit_state fopts mod
+ -> findInstalledHomeModule fc home_fopts (moduleUnit mod) (moduleName <$> gwib)
+ _ -> findPackageModule fc unit_state fopts gwib
-- -----------------------------------------------------------------------------
-- Helpers
@@ -271,10 +276,10 @@ orIfNotFound this or_this = do
-- been done. Otherwise, do the lookup (with the IO action) and save
-- the result in the finder cache and the module location cache (if it
-- was successful.)
-homeSearchCache :: FinderCache -> UnitId -> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult
+homeSearchCache :: FinderCache -> UnitId -> ModuleNameWithIsBoot -> 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
+ let mod = mkModule home_unit <$> mod_name
+ modLocationCache fc mod do_this
findExposedPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> PkgQual -> IO FindResult
findExposedPackageModule fc fopts units mod_name mb_pkg =
@@ -290,13 +295,13 @@ findLookupResult :: FinderCache -> FinderOpts -> LookupResult -> IO FindResult
findLookupResult fc fopts r = case r of
LookupFound m pkg_conf -> do
let im = fst (getModuleInstantiation m)
- r' <- findPackageModule_ fc fopts im (fst pkg_conf)
+ r' <- findPackageModule_ fc fopts (notBoot im) (fst pkg_conf)
case r' of
-- TODO: ghc -M is unlikely to do the right thing
-- with just the location of the thing that was
-- instantiated; you probably also need all of the
-- implicit locations from the instances
- InstalledFound loc _ -> return (Found loc m)
+ InstalledFound loc -> return (Found loc m)
InstalledNoPackage _ -> return (NoPackage (moduleUnit m))
InstalledNotFound fp _ -> return (NotFound{ fr_paths = fmap unsafeDecodeUtf fp, fr_pkg = Just (moduleUnit m)
, fr_pkgs_hidden = []
@@ -344,24 +349,27 @@ modLocationCache fc mod do_this = do
addModuleToFinder :: FinderCache -> ModuleWithIsBoot -> ModLocation -> IO ()
addModuleToFinder fc mod loc = do
let imod = fmap toUnitId <$> mod
- addToFinderCache fc imod (InstalledFound loc (gwib_mod imod))
+ addToFinderCache fc imod (InstalledFound loc)
-- This returns a module because it's more convenient for users
addHomeModuleToFinder :: FinderCache -> HomeUnit -> ModuleNameWithIsBoot -> 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))
+ addToFinderCache fc mod (InstalledFound loc)
return (mkHomeModule home_unit (gwib_mod mod_name))
-- -----------------------------------------------------------------------------
-- The internal workers
findHomeModule :: FinderCache -> FinderOpts -> HomeUnit -> ModuleName -> IO FindResult
-findHomeModule fc fopts home_unit mod_name = do
+findHomeModule fc fopts home_unit = findHomeModuleWithIsBoot fc fopts home_unit . notBoot
+
+findHomeModuleWithIsBoot :: FinderCache -> FinderOpts -> HomeUnit -> ModuleNameWithIsBoot -> IO FindResult
+findHomeModuleWithIsBoot fc fopts home_unit mod_name = do
let uid = homeUnitAsUnit home_unit
r <- findInstalledHomeModule fc fopts (homeUnitId home_unit) mod_name
return $ case r of
- InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name)
+ InstalledFound loc -> Found loc (mkHomeModule home_unit (gwib_mod mod_name))
InstalledNoPackage _ -> NoPackage uid -- impossible
InstalledNotFound fps _ -> NotFound {
fr_paths = fmap unsafeDecodeUtf fps,
@@ -381,12 +389,12 @@ mkHomeHidden uid =
, fr_unusables = []
, fr_suggestions = []}
-findHomePackageModule :: FinderCache -> FinderOpts -> UnitId -> ModuleName -> IO FindResult
+findHomePackageModule :: FinderCache -> FinderOpts -> UnitId -> ModuleNameWithIsBoot -> IO FindResult
findHomePackageModule fc fopts home_unit mod_name = do
let uid = RealUnit (Definite home_unit)
r <- findInstalledHomeModule fc fopts home_unit mod_name
return $ case r of
- InstalledFound loc _ -> Found loc (mkModule uid mod_name)
+ InstalledFound loc -> Found loc (mkModule uid (gwib_mod mod_name))
InstalledNoPackage _ -> NoPackage uid -- impossible
InstalledNotFound fps _ -> NotFound {
fr_paths = fmap unsafeDecodeUtf fps,
@@ -414,9 +422,9 @@ findHomePackageModule fc fopts home_unit mod_name = do
--
-- 4. Some special-case code in GHCi (ToDo: Figure out why that needs to
-- call this.)
-findInstalledHomeModule :: FinderCache -> FinderOpts -> UnitId -> ModuleName -> IO InstalledFindResult
-findInstalledHomeModule fc fopts home_unit mod_name = do
- homeSearchCache fc home_unit mod_name $
+findInstalledHomeModule :: FinderCache -> FinderOpts -> UnitId -> ModuleNameWithIsBoot -> IO InstalledFindResult
+findInstalledHomeModule fc fopts home_unit gwib at GWIB { gwib_mod = mod_name } = do
+ homeSearchCache fc home_unit gwib $
let
maybe_working_dir = finder_workingDirectory fopts
home_path = case maybe_working_dir of
@@ -432,16 +440,13 @@ findInstalledHomeModule fc fopts home_unit mod_name = do
mod = mkModule home_unit mod_name
source_exts =
- [ (os "hs", mkHomeModLocationSearched fopts mod_name $ os "hs")
- , (os "lhs", mkHomeModLocationSearched fopts mod_name $ os "lhs")
- , (os "hsig", mkHomeModLocationSearched fopts mod_name $ os "hsig")
- , (os "lhsig", mkHomeModLocationSearched fopts mod_name $ os "lhsig")
- ]
+ [ (ext, mkHomeModLocationSearched fopts (notBoot mod_name) ext)
+ | ext <- map os ["hs", "lhs", "hsig", "lhsig"]]
-- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that
-- when hiDir field is set in dflags, we know to look there (see #16500)
- hi_exts = [ (hisuf, mkHomeModHiOnlyLocation fopts mod_name)
- , (addBootSuffix hisuf, mkHomeModHiOnlyLocation fopts mod_name)
+ hi_exts = [ (hisuf, mkHomeModHiOnlyLocation fopts (GWIB mod_name NotBoot))
+ , (addBootSuffix hisuf, mkHomeModHiOnlyLocation fopts (GWIB mod_name NotBoot))
]
-- In compilation manager modes, we look for source files in the home
@@ -456,7 +461,7 @@ findInstalledHomeModule fc fopts home_unit mod_name = do
-- This is important only when compiling the base package (where GHC.Prim
-- is a home module).
if mod `installedModuleEq` gHC_PRIM
- then return (InstalledFound (error "GHC.Prim ModLocation") mod)
+ then return (InstalledFound (error "GHC.Prim ModLocation"))
else searchPathExts search_dirs mod exts
-- | Prepend the working directory to the search path.
@@ -467,9 +472,9 @@ augmentImports work_dir (fp:fps)
| otherwise = (work_dir </> fp) : augmentImports work_dir fps
-- | Search for a module in external packages only.
-findPackageModule :: FinderCache -> UnitState -> FinderOpts -> InstalledModule -> IO InstalledFindResult
+findPackageModule :: FinderCache -> UnitState -> FinderOpts -> InstalledModuleWithIsBoot -> IO InstalledFindResult
findPackageModule fc unit_state fopts mod = do
- let pkg_id = moduleUnit mod
+ let pkg_id = moduleUnit (gwib_mod mod)
case lookupUnitId unit_state pkg_id of
Nothing -> return (InstalledNoPackage pkg_id)
Just u -> findPackageModule_ fc fopts mod u
@@ -481,15 +486,15 @@ findPackageModule fc unit_state fopts mod = do
-- the 'UnitInfo' must be consistent with the unit id in the 'Module'.
-- The redundancy is to avoid an extra lookup in the package state
-- for the appropriate config.
-findPackageModule_ :: FinderCache -> FinderOpts -> InstalledModule -> UnitInfo -> IO InstalledFindResult
-findPackageModule_ fc fopts mod pkg_conf = do
+findPackageModule_ :: FinderCache -> FinderOpts -> InstalledModuleWithIsBoot -> UnitInfo -> IO InstalledFindResult
+findPackageModule_ fc fopts gwib at GWIB { gwib_mod = mod } pkg_conf = do
massertPpr (moduleUnit mod == unitId pkg_conf)
(ppr (moduleUnit mod) <+> ppr (unitId pkg_conf))
- modLocationCache fc (notBoot mod) $
+ modLocationCache fc gwib $
-- special case for GHC.Prim; we won't find it in the filesystem.
if mod `installedModuleEq` gHC_PRIM
- then return (InstalledFound (error "GHC.Prim ModLocation") mod)
+ then return (InstalledFound (error "GHC.Prim ModLocation"))
else
let
@@ -513,7 +518,7 @@ findPackageModule_ fc fopts mod pkg_conf = do
-- don't bother looking for it.
let basename = unsafeEncodeUtf $ moduleNameSlashes (moduleName mod)
loc = mk_hi_loc one basename
- in return $ InstalledFound loc mod
+ in return $ InstalledFound loc
_otherwise ->
searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
@@ -547,10 +552,10 @@ searchPathExts paths mod exts = search to_search
search ((file, loc) : rest) = do
b <- doesFileExist file
if b
- then return $ InstalledFound loc mod
+ then return $ InstalledFound loc
else search rest
-mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt
+mkHomeModLocationSearched :: FinderOpts -> ModuleNameWithIsBoot -> FileExt
-> OsPath -> BaseName -> ModLocation
mkHomeModLocationSearched fopts mod suff path basename =
mkHomeModLocation2 fopts mod (path </> basename) suff
@@ -589,34 +594,35 @@ mkHomeModLocationSearched fopts mod suff path basename =
-- ext
-- The filename extension of the source file (usually "hs" or "lhs").
-mkHomeModLocation :: FinderOpts -> ModuleName -> OsPath -> ModLocation
+mkHomeModLocation :: FinderOpts -> ModuleNameWithIsBoot -> OsPath -> ModLocation
mkHomeModLocation dflags mod src_filename =
- let (basename,extension) = OsPath.splitExtension src_filename
+ let (basename, extension) = OsPath.splitExtension src_filename
in mkHomeModLocation2 dflags mod basename extension
mkHomeModLocation2 :: FinderOpts
- -> ModuleName
+ -> ModuleNameWithIsBoot
-> OsPath -- Of source module, without suffix
-> FileExt -- Suffix
-> ModLocation
-mkHomeModLocation2 fopts mod src_basename ext =
+mkHomeModLocation2 fopts (GWIB mod is_boot) src_basename ext =
let mod_basename = unsafeEncodeUtf $ moduleNameSlashes mod
-
- obj_fn = mkObjPath fopts src_basename mod_basename
- dyn_obj_fn = mkDynObjPath fopts src_basename mod_basename
- hi_fn = mkHiPath fopts src_basename mod_basename
- dyn_hi_fn = mkDynHiPath fopts src_basename mod_basename
- hie_fn = mkHiePath fopts src_basename mod_basename
-
- in (OsPathModLocation{ ml_hs_file_ospath = Just (src_basename <.> ext),
- ml_hi_file_ospath = hi_fn,
- ml_dyn_hi_file_ospath = dyn_hi_fn,
- ml_obj_file_ospath = obj_fn,
+ bootify = if is_boot == IsBoot then addBootSuffix else id
+
+ obj_fn = bootify $ mkObjPath fopts src_basename mod_basename
+ dyn_obj_fn = bootify $ mkDynObjPath fopts src_basename mod_basename
+ hi_fn = bootify $ mkHiPath fopts src_basename mod_basename
+ dyn_hi_fn = bootify $ mkDynHiPath fopts src_basename mod_basename
+ hie_fn = bootify $ mkHiePath fopts src_basename mod_basename
+
+ in (OsPathModLocation{ ml_hs_file_ospath = Just (src_basename <.> ext),
+ ml_hi_file_ospath = hi_fn,
+ ml_dyn_hi_file_ospath = dyn_hi_fn,
+ ml_obj_file_ospath = obj_fn,
ml_dyn_obj_file_ospath = dyn_obj_fn,
- ml_hie_file_ospath = hie_fn })
+ ml_hie_file_ospath = hie_fn })
mkHomeModHiOnlyLocation :: FinderOpts
- -> ModuleName
+ -> ModuleNameWithIsBoot
-> OsPath
-> BaseName
-> ModLocation
=====================================
compiler/GHC/Unit/Finder/Types.hs
=====================================
@@ -40,7 +40,7 @@ data FinderCache = FinderCache { flushFinderCaches :: UnitEnv -> IO ()
}
data InstalledFindResult
- = InstalledFound ModLocation InstalledModule
+ = InstalledFound ModLocation
| InstalledNoPackage UnitId
| InstalledNotFound [OsPath] (Maybe UnitId)
=====================================
compiler/GHC/Unit/Module/Location.hs
=====================================
@@ -13,10 +13,6 @@ module GHC.Unit.Module.Location
)
, pattern ModLocation
, addBootSuffix
- , addBootSuffix_maybe
- , addBootSuffixLocn_maybe
- , addBootSuffixLocn
- , addBootSuffixLocnOut
, removeBootSuffix
, mkFileSrcSpan
)
@@ -99,38 +95,6 @@ removeBootSuffix pathWithBootSuffix =
Just path -> path
Nothing -> error "removeBootSuffix: no -boot suffix"
--- | Add the @-boot@ suffix if the @Bool@ argument is @True@
-addBootSuffix_maybe :: IsBootInterface -> OsPath -> OsPath
-addBootSuffix_maybe is_boot path = case is_boot of
- IsBoot -> addBootSuffix path
- NotBoot -> path
-
-addBootSuffixLocn_maybe :: IsBootInterface -> ModLocation -> ModLocation
-addBootSuffixLocn_maybe is_boot locn = case is_boot of
- IsBoot -> addBootSuffixLocn locn
- _ -> locn
-
--- | Add the @-boot@ suffix to all file paths associated with the module
-addBootSuffixLocn :: ModLocation -> ModLocation
-addBootSuffixLocn locn
- = locn { ml_hs_file_ospath = fmap addBootSuffix (ml_hs_file_ospath locn)
- , ml_hi_file_ospath = addBootSuffix (ml_hi_file_ospath locn)
- , ml_dyn_hi_file_ospath = addBootSuffix (ml_dyn_hi_file_ospath locn)
- , ml_obj_file_ospath = addBootSuffix (ml_obj_file_ospath locn)
- , ml_dyn_obj_file_ospath = addBootSuffix (ml_dyn_obj_file_ospath locn)
- , ml_hie_file_ospath = addBootSuffix (ml_hie_file_ospath locn) }
-
--- | Add the @-boot@ suffix to all output file paths associated with the
--- module, not including the input file itself
-addBootSuffixLocnOut :: ModLocation -> ModLocation
-addBootSuffixLocnOut locn
- = locn { ml_hi_file_ospath = addBootSuffix (ml_hi_file_ospath locn)
- , ml_dyn_hi_file_ospath = addBootSuffix (ml_dyn_hi_file_ospath locn)
- , ml_obj_file_ospath = addBootSuffix (ml_obj_file_ospath locn)
- , ml_dyn_obj_file_ospath = addBootSuffix (ml_dyn_obj_file_ospath locn)
- , ml_hie_file_ospath = addBootSuffix (ml_hie_file_ospath locn)
- }
-
-- | Compute a 'SrcSpan' from a 'ModLocation'.
mkFileSrcSpan :: ModLocation -> SrcSpan
mkFileSrcSpan mod_loc
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/49532ac118cdd11f078d2de1054ac59237cead77
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/49532ac118cdd11f078d2de1054ac59237cead77
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/20241010/a1e98cc7/attachment-0001.html>
More information about the ghc-commits
mailing list