diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index f3f4dce66e39c710d1e42d3dbf1b04487c115056..cbbb55e3046417f954b30ac3e99411d455ab14d8 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -854,16 +854,14 @@ hsModuleToModSummary home_keys pn hsc_src modname
-- 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 = mkHomeModLocation fopts modname
(unsafeEncodeUtf $ unpackFS unit_fs </>
moduleNameSlashes modname)
- (case hsc_src of
+ (case hsc_src of
HsigFile -> os "hsig"
HsBootFile -> os "hs-boot"
HsSrcFile -> os "hs")
- let location = case hsc_src of
- HsBootFile -> addBootSuffixLocnOut location0
- _ -> location0
+ hsc_src
-- 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)
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index dfc1330247dcb9655cd1bbb8b3b4b154cfad52a3..cde5a3ec291b8899742f0211409ea7fb89387922 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -2123,31 +2123,16 @@ 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 = unsafeEncodeUtf src_fn
+ (basename, extension) = splitExtension 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
+ hsc_src
+ | isHaskellSigSuffix (drop 1 extension) = HsigFile
+ | isHaskellBootSuffix (drop 1 extension) = HsBootFile
+ | otherwise = HsSrcFile
-- 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
+ location = mkHomeModLocation fopts pi_mod_name (unsafeEncodeUtf basename) (unsafeEncodeUtf extension) hsc_src
-- 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
@@ -2239,7 +2224,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 wanted_mod is_boot mb_pkg
case found of
Found location mod
| isJust (ml_hs_file location) ->
@@ -2257,10 +2242,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 +2252,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
diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs
index e85b80f723dbd252c3c5c3e731dca801df4a1b4c..1c25e61559d90a8fbf21a6da438c33cb818a1dce 100644
--- a/compiler/GHC/Driver/MakeFile.hs
+++ b/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 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
diff --git a/compiler/GHC/Driver/Phases.hs b/compiler/GHC/Driver/Phases.hs
index 2cfcd6d9f63084ef33c6e04d217eb54a458365e8..6f29535d836b4d233d157af86c54f1f266030f0b 100644
--- a/compiler/GHC/Driver/Phases.hs
+++ b/compiler/GHC/Driver/Phases.hs
@@ -23,6 +23,7 @@ module GHC.Driver.Phases (
isDynLibSuffix,
isHaskellUserSrcSuffix,
isHaskellSigSuffix,
+ isHaskellBootSuffix,
isSourceSuffix,
isHaskellishTarget,
@@ -234,7 +235,7 @@ phaseInputExt Js = "js"
phaseInputExt StopLn = "o"
haskellish_src_suffixes, backpackish_suffixes, haskellish_suffixes, cish_suffixes,
- js_suffixes, haskellish_user_src_suffixes, haskellish_sig_suffixes
+ js_suffixes, haskellish_user_src_suffixes, haskellish_sig_suffixes, haskellish_boot_suffixes
:: [String]
-- When a file with an extension in the haskellish_src_suffixes group is
-- loaded in --make mode, its imports will be loaded too.
@@ -247,7 +248,8 @@ js_suffixes = [ "js" ]
-- Will not be deleted as temp files:
haskellish_user_src_suffixes =
- haskellish_sig_suffixes ++ [ "hs", "lhs", "hs-boot", "lhs-boot" ]
+ haskellish_sig_suffixes ++ haskellish_boot_suffixes ++ [ "hs", "lhs" ]
+haskellish_boot_suffixes = [ "hs-boot", "lhs-boot" ]
haskellish_sig_suffixes = [ "hsig", "lhsig" ]
backpackish_suffixes = [ "bkp" ]
@@ -265,11 +267,12 @@ dynlib_suffixes platform = case platformOS platform of
_ -> ["so"]
isHaskellishSuffix, isBackpackishSuffix, isHaskellSrcSuffix, isCishSuffix,
- isHaskellUserSrcSuffix, isJsSuffix, isHaskellSigSuffix
+ isHaskellUserSrcSuffix, isJsSuffix, isHaskellSigSuffix, isHaskellBootSuffix
:: String -> Bool
isHaskellishSuffix s = s `elem` haskellish_suffixes
isBackpackishSuffix s = s `elem` backpackish_suffixes
isHaskellSigSuffix s = s `elem` haskellish_sig_suffixes
+isHaskellBootSuffix s = s `elem` haskellish_boot_suffixes
isHaskellSrcSuffix s = s `elem` haskellish_src_suffixes
isCishSuffix s = s `elem` cish_suffixes
isJsSuffix s = s `elem` js_suffixes
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index fb19a75626347fe906f9004ed7dddd06afaa6374..9a7620108ac6f8c927777524c94161e53e86338e 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -777,24 +777,18 @@ 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
-
+ let location1 = mkHomeModLocation fopts mod_name (unsafeEncodeUtf basename) (unsafeEncodeUtf suff) src_flavour
-- 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
@@ -807,11 +801,11 @@ mkOneShotModLocation pipe_env dflags src_flavour mod_name = do
location5 | 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
+ = location3 { ml_dyn_obj_file_ospath = unsafeEncodeUtf dyn_ofile }
+ | otherwise = location3
return location5
where
fopts = initFinderOpts dflags
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index f5dc43d84e70fd00d15b0d83384a67070010939f..e2e76282344c7b17eeef788f07186f1f7753eba8 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -896,9 +896,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 mod hi_boot_file)
case mb_found of
- InstalledFound (addBootSuffixLocn_maybe hi_boot_file -> loc) -> do
+ InstalledFound loc -> do
-- See Note [Home module load error]
case mhome_unit of
Just home_unit
diff --git a/compiler/GHC/Unit/Finder.hs b/compiler/GHC/Unit/Finder.hs
index c10c1605a4d3bc7dc69765bc9e2649124bb26d93..507968f5fdf832c7259b765bc839df3cf3e76357 100644
--- a/compiler/GHC/Unit/Finder.hs
+++ b/compiler/GHC/Unit/Finder.hs
@@ -15,6 +15,7 @@ module GHC.Unit.Finder (
FinderCache(..),
initFinderCache,
findImportedModule,
+ findImportedModuleWithIsBoot,
findPluginModule,
findExactModule,
findHomeModule,
@@ -157,6 +158,13 @@ findImportedModule hsc_env mod pkg_qual =
in do
findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) mhome_unit mod pkg_qual
+findImportedModuleWithIsBoot :: HscEnv -> ModuleName -> IsBootInterface -> PkgQual -> IO FindResult
+findImportedModuleWithIsBoot hsc_env mod is_boot pkg_qual = do
+ res <- findImportedModule hsc_env mod pkg_qual
+ case (res, is_boot) of
+ (Found loc mod, IsBoot) -> return (Found (addBootSuffixLocn loc) mod)
+ _ -> return res
+
findImportedModuleNoHsc
:: FinderCache
-> FinderOpts
@@ -229,15 +237,19 @@ 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
- case mhome_unit of
+findExactModule :: FinderCache -> FinderOpts -> UnitEnvGraph FinderOpts -> UnitState -> Maybe HomeUnit -> InstalledModule -> IsBootInterface -> IO InstalledFindResult
+findExactModule fc fopts other_fopts unit_state mhome_unit mod is_boot = do
+ res <- case mhome_unit of
Just home_unit
| isHomeInstalledModule home_unit mod
-> findInstalledHomeModule fc fopts (homeUnitId home_unit) (moduleName mod)
| Just home_fopts <- unitEnv_lookup_maybe (moduleUnit mod) other_fopts
-> findInstalledHomeModule fc home_fopts (moduleUnit mod) (moduleName mod)
_ -> findPackageModule fc unit_state fopts mod
+ case (res, is_boot) of
+ (InstalledFound loc, IsBoot) -> return (InstalledFound (addBootSuffixLocn loc))
+ _ -> return res
+
-- -----------------------------------------------------------------------------
-- Helpers
@@ -592,10 +604,12 @@ mkHomeModLocationSearched fopts mod suff path basename =
-- ext
-- The filename extension of the source file (usually "hs" or "lhs").
-mkHomeModLocation :: FinderOpts -> ModuleName -> OsPath -> ModLocation
-mkHomeModLocation dflags mod src_filename =
- let (basename,extension) = OsPath.splitExtension src_filename
- in mkHomeModLocation2 dflags mod basename extension
+mkHomeModLocation :: FinderOpts -> ModuleName -> OsPath -> FileExt -> HscSource -> ModLocation
+mkHomeModLocation dflags mod src_basename ext hsc_src =
+ let loc = mkHomeModLocation2 dflags mod src_basename ext
+ in case hsc_src of
+ HsBootFile -> addBootSuffixLocnOut loc
+ _ -> loc
mkHomeModLocation2 :: FinderOpts
-> ModuleName
diff --git a/compiler/GHC/Unit/Module/Location.hs b/compiler/GHC/Unit/Module/Location.hs
index 9c965a814f44135a70453b2718fa5b02a24e2cb8..9d37cfc5062084cf05b1846369bcc2f5877fa0fa 100644
--- a/compiler/GHC/Unit/Module/Location.hs
+++ b/compiler/GHC/Unit/Module/Location.hs
@@ -13,8 +13,6 @@ module GHC.Unit.Module.Location
)
, pattern ModLocation
, addBootSuffix
- , addBootSuffix_maybe
- , addBootSuffixLocn_maybe
, addBootSuffixLocn
, addBootSuffixLocnOut
, removeBootSuffix
@@ -25,7 +23,6 @@ where
import GHC.Prelude
import GHC.Data.OsPath
-import GHC.Unit.Types
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
import GHC.Data.FastString (mkFastString)
@@ -99,26 +96,10 @@ 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) }
+ = addBootSuffixLocnOut locn { ml_hs_file_ospath = fmap addBootSuffix (ml_hs_file_ospath locn) }
-- | Add the @-boot@ suffix to all output file paths associated with the
-- module, not including the input file itself