summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2021-09-30 11:12:10 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-10-19 03:30:16 -0400
commitdf419c1abd7daa3aa0231747582333357b8e9b85 (patch)
treea73aaf04830425c43afe525f22138ca58550301e
parent8144a92f5a73dd22c0d855d5b2bead930111511c (diff)
downloadhaskell-df419c1abd7daa3aa0231747582333357b8e9b85.tar.gz
driver: Cleanups related to ModLocation
ModLocation is the data type which tells you the locations of all the build products which can affect recompilation. It is now computed in one place and not modified through the pipeline. Important locations will now just consult ModLocation rather than construct the dynamic object path incorrectly. * Add paths for dynamic object and dynamic interface files to ModLocation. * Always use the paths from mod location when looking for where to find any interface or object file. * Always use the paths in a ModLocation when deciding where to write an interface and object file. * Remove `dynamicOutputFile` and `dynamicOutputHi` functions which *calculated* (incorrectly) the location of `dyn_o` and `dyn_hi` files. * Don't set `outputFile_` and so-on in `enableCodeGenWhen`, `-o` and hence `outputFile_` should not affect the location of object files in `--make` mode. It is now sufficient to just update the ModLocation with the temporary paths. * In `hscGenBackendPipeline` don't recompute the `ModLocation` to account for `-dynamic-too`, the paths are now accurate from the start of the run. * Rename `getLocation` to `mkOneShotModLocation`, as that's the only place it's used. Increase the locality of the definition by moving it close to the use-site. * Load the dynamic interface from ml_dyn_hi_file rather than attempting to reconstruct it in load_dynamic_too. * Add a variety of tests to check how -o -dyno etc interact with each other. Some other clean-ups * DeIOify mkHomeModLocation and friends, they are all pure functions. * Move FinderOpts into GHC.Driver.Config.Finder, next to initFinderOpts. * Be more precise about whether we mean outputFile or outputFile_: there were many places where outputFile was used but the result shouldn't have been affected by `-dyno` (for example the filename of the resulting executable). In these places dynamicNow would never be set but it's still more precise to not allow for this possibility. * Typo fixes suffices -> suffixes in the appropiate places.
-rw-r--r--compiler/GHC/Driver/Backpack.hs6
-rw-r--r--compiler/GHC/Driver/Config/Finder.hs9
-rw-r--r--compiler/GHC/Driver/Main.hs18
-rw-r--r--compiler/GHC/Driver/Make.hs28
-rw-r--r--compiler/GHC/Driver/Pipeline.hs19
-rw-r--r--compiler/GHC/Driver/Pipeline/Execute.hs89
-rw-r--r--compiler/GHC/Driver/Pipeline/Monad.hs40
-rw-r--r--compiler/GHC/Driver/Session.hs32
-rw-r--r--compiler/GHC/Iface/Load.hs20
-rw-r--r--compiler/GHC/Linker/Dynamic.hs2
-rw-r--r--compiler/GHC/Linker/Loader.hs4
-rw-r--r--compiler/GHC/Linker/Static.hs4
-rw-r--r--compiler/GHC/Unit/Finder.hs130
-rw-r--r--compiler/GHC/Unit/Finder/Types.hs34
-rw-r--r--compiler/GHC/Unit/Module/Graph.hs2
-rw-r--r--compiler/GHC/Unit/Module/Location.hs27
-rw-r--r--compiler/GHC/Unit/Module/ModSummary.hs4
-rw-r--r--testsuite/tests/count-deps/CountDepsAst.stdout4
-rw-r--r--testsuite/tests/count-deps/CountDepsParser.stdout4
-rw-r--r--testsuite/tests/driver/T20348/Makefile35
-rw-r--r--testsuite/tests/driver/T20348/all.T5
-rw-r--r--testsuite/tests/driver/recomp-boot-dyn-too/A.hs1
-rw-r--r--testsuite/tests/driver/recomp-boot-dyn-too/A.hs-boot1
-rw-r--r--testsuite/tests/driver/recomp-boot-dyn-too/B1.hs3
-rw-r--r--testsuite/tests/driver/recomp-boot-dyn-too/B2.hs3
-rw-r--r--testsuite/tests/driver/recomp-boot-dyn-too/Makefile18
-rw-r--r--testsuite/tests/driver/recomp-boot-dyn-too/all.T4
-rw-r--r--testsuite/tests/driver/recomp-boot-dyn-too/recomp-boot-dyn-too.stdout4
-rw-r--r--testsuite/tests/regalloc/regalloc_unit_tests.hs4
29 files changed, 351 insertions, 203 deletions
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index b966a08884..c4594329eb 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -757,8 +757,8 @@ summariseRequirement pn mod_name = do
let fopts = initFinderOpts dflags
let PackageName pn_fs = pn
- location <- liftIO $ mkHomeModLocation2 fopts mod_name
- (unpackFS pn_fs </> moduleNameSlashes mod_name) "hsig"
+ let location = mkHomeModLocation2 fopts mod_name
+ (unpackFS pn_fs </> moduleNameSlashes mod_name) "hsig"
env <- getBkpEnv
src_hash <- liftIO $ getFileHash (bkp_filename env)
@@ -848,7 +848,7 @@ hsModuleToModSummary 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!
- location0 <- liftIO $ mkHomeModLocation2 fopts modname
+ let location0 = mkHomeModLocation2 fopts modname
(unpackFS unit_fs </>
moduleNameSlashes modname)
(case hsc_src of
diff --git a/compiler/GHC/Driver/Config/Finder.hs b/compiler/GHC/Driver/Config/Finder.hs
index 4fa4278c09..3d830fc6d2 100644
--- a/compiler/GHC/Driver/Config/Finder.hs
+++ b/compiler/GHC/Driver/Config/Finder.hs
@@ -6,7 +6,8 @@ module GHC.Driver.Config.Finder (
import GHC.Prelude
import GHC.Driver.Session
-import GHC.Unit.Finder
+import GHC.Unit.Finder.Types
+
-- | Create a new 'FinderOpts' from DynFlags.
initFinderOpts :: DynFlags -> FinderOpts
@@ -19,8 +20,10 @@ initFinderOpts flags = FinderOpts
, finder_hieDir = hieDir flags
, finder_hieSuf = hieSuf flags
, finder_hiDir = hiDir flags
- , finder_hiSuf = hiSuf flags
+ , finder_hiSuf = hiSuf_ flags
+ , finder_dynHiSuf = dynHiSuf_ flags
, finder_objectDir = objectDir flags
- , finder_objectSuf = objectSuf flags
+ , finder_objectSuf = objectSuf_ flags
+ , finder_dynObjectSuf = dynObjectSuf_ flags
, finder_stubDir = stubDir flags
}
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 9aeb04e336..1d36a83445 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -962,18 +962,8 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do
Interpreter -> False
_ -> True
- -- mod_location only contains the base name, so we rebuild the
- -- correct file extension from the dynflags.
- baseName = ml_hi_file mod_location
- buildIfName suffix is_dynamic
- | Just name <- (if is_dynamic then dynOutputHi else outputHi) dflags
- = name
- | otherwise
- = let with_hi = replaceExtension baseName suffix
- in addBootSuffix_maybe (mi_boot iface) with_hi
-
write_iface dflags' iface =
- let !iface_name = buildIfName (hiSuf dflags') (dynamicNow dflags')
+ let !iface_name = if dynamicNow dflags' then ml_dyn_hi_file mod_location else ml_hi_file mod_location
profile = targetProfile dflags'
in
{-# SCC "writeIface" #-}
@@ -1714,6 +1704,8 @@ hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do
no_loc = ModLocation{ ml_hs_file = Just filename,
ml_hi_file = panic "hscCompileCmmFile: no hi file",
ml_obj_file = panic "hscCompileCmmFile: no obj file",
+ ml_dyn_obj_file = panic "hscCompileCmmFile: no dyn obj file",
+ ml_dyn_hi_file = panic "hscCompileCmmFile: no dyn obj file",
ml_hie_file = panic "hscCompileCmmFile: no hie file"}
-------------------- Stuff for new code gen ---------------------
@@ -1945,6 +1937,8 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do
let iNTERACTIVELoc = ModLocation{ ml_hs_file = Nothing,
ml_hi_file = panic "hsDeclsWithLocation:ml_hi_file",
ml_obj_file = panic "hsDeclsWithLocation:ml_obj_file",
+ ml_dyn_obj_file = panic "hsDeclsWithLocation:ml_dyn_obj_file",
+ ml_dyn_hi_file = panic "hsDeclsWithLocation:ml_dyn_hi_file",
ml_hie_file = panic "hsDeclsWithLocation:ml_hie_file" }
ds_result <- hscDesugar' iNTERACTIVELoc tc_gblenv
@@ -2155,6 +2149,8 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr
; let iNTERACTIVELoc = ModLocation{ ml_hs_file = Nothing,
ml_hi_file = panic "hscCompileCoreExpr':ml_hi_file",
ml_obj_file = panic "hscCompileCoreExpr':ml_obj_file",
+ ml_dyn_obj_file = panic "hscCompileCoreExpr': ml_obj_file",
+ ml_dyn_hi_file = panic "hscCompileCoreExpr': ml_dyn_hi_file",
ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" }
; let ictxt = hsc_IC hsc_env
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index fa1348bfe1..ba611db424 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -597,7 +597,7 @@ load' cache how_much mHscMessage mod_graph = do
-- called Main, or (b) the user said -no-hs-main, indicating
-- that main() is going to come from somewhere else.
--
- let ofile = outputFile dflags
+ let ofile = outputFile_ dflags
let no_hs_main = gopt Opt_NoHsMain dflags
let
main_mod = mainModIs hsc_env
@@ -1652,27 +1652,26 @@ enableCodeGenWhen logger tmpfs condition should_modify staticLife dynLife bcknd
tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf
let dyn_tn = tn -<.> dynsuf
addFilesToClean tmpfs dynLife [dyn_tn]
- return tn
+ return (tn, dyn_tn)
-- We don't want to create .o or .hi files unless we have been asked
-- to by the user. But we need them, so we patch their locations in
-- the ModSummary with temporary files.
--
- (hi_file, o_file) <-
+ ((hi_file, dyn_hi_file), (o_file, dyn_o_file)) <-
-- If ``-fwrite-interface` is specified, then the .o and .hi files
-- are written into `-odir` and `-hidir` respectively. #16670
if gopt Opt_WriteInterface dflags
- then return (ml_hi_file ms_location, ml_obj_file ms_location)
+ then return ((ml_hi_file ms_location, ml_dyn_hi_file ms_location)
+ , (ml_obj_file ms_location, ml_dyn_obj_file ms_location))
else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags))
<*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags))
let ms' = ms
{ ms_location =
- ms_location {ml_hi_file = hi_file, ml_obj_file = o_file}
- , ms_hspp_opts = updOptLevel 0 $
- setOutputFile (Just o_file) $
- setDynOutputFile (Just $ dynamicOutputFile dflags o_file) $
- setOutputHi (Just hi_file) $
- setDynOutputHi (Just $ dynamicOutputHi dflags hi_file) $
- dflags {backend = bcknd}
+ ms_location { ml_hi_file = hi_file
+ , ml_obj_file = o_file
+ , ml_dyn_hi_file = dyn_hi_file
+ , ml_dyn_obj_file = dyn_o_file }
+ , ms_hspp_opts = updOptLevel 0 $ dflags {backend = bcknd}
}
pure (ExtendedModSummary ms' bkp_deps)
| otherwise = return (ExtendedModSummary ms bkp_deps)
@@ -1789,7 +1788,7 @@ summariseFile hsc_env old_summaries src_fn mb_phase maybe_buf
let fopts = initFinderOpts (hsc_dflags hsc_env)
-- Make a ModLocation for this file
- location <- liftIO $ mkHomeModLocation fopts pi_mod_name src_fn
+ 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
@@ -1904,7 +1903,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
| otherwise = find_it
where
dflags = hsc_dflags hsc_env
- fopts = initFinderOpts dflags
+ fopts = initFinderOpts dflags
home_unit = hsc_home_unit hsc_env
fc = hsc_FC hsc_env
units = hsc_units hsc_env
@@ -1995,9 +1994,8 @@ data MakeNewModSummary
makeNewModSummary :: HscEnv -> MakeNewModSummary -> IO ExtendedModSummary
makeNewModSummary hsc_env MakeNewModSummary{..} = do
let PreprocessedImports{..} = nms_preimps
- let dflags = hsc_dflags hsc_env
obj_timestamp <- modificationTimeIfExists (ml_obj_file nms_location)
- dyn_obj_timestamp <- modificationTimeIfExists (dynamicOutputFile dflags (ml_obj_file nms_location))
+ dyn_obj_timestamp <- modificationTimeIfExists (ml_dyn_obj_file nms_location)
hi_timestamp <- modificationTimeIfExists (ml_hi_file nms_location)
hie_timestamp <- modificationTimeIfExists (ml_hie_file nms_location)
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 1255cc3df3..59cb28eccc 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -433,7 +433,7 @@ link' logger tmpfs dflags unit_env batch_attempt_linking hpt
let getOfiles LM{ linkableUnlinked } = map nameOfObject (filter isObject linkableUnlinked)
obj_files = concatMap getOfiles linkables
platform = targetPlatform dflags
- exe_file = exeFileName platform staticLink (outputFile dflags)
+ exe_file = exeFileName platform staticLink (outputFile_ dflags)
linking_needed <- linkingNeeded logger dflags unit_env staticLink linkables pkg_deps
@@ -470,7 +470,7 @@ linkingNeeded logger dflags unit_env staticLink linkables pkg_deps = do
-- linking (unless the -fforce-recomp flag was given).
let platform = ue_platform unit_env
unit_state = ue_units unit_env
- exe_file = exeFileName platform staticLink (outputFile dflags)
+ exe_file = exeFileName platform staticLink (outputFile_ dflags)
e_exe_time <- tryIO $ getModificationUTCTime exe_file
case e_exe_time of
Left _ -> return True
@@ -757,9 +757,12 @@ checkDynamicToo hsc_env dyn_too_rerun res = do
-- | Enable dynamic-too, reset EPS
resetHscEnv :: HscEnv -> IO HscEnv
resetHscEnv hsc_env = do
- let dflags0 = flip gopt_unset Opt_BuildDynamicToo
- $ setDynamicNow
- $ (hsc_dflags hsc_env)
+ let init_dflags = hsc_dflags hsc_env
+ dflags0 = flip gopt_unset Opt_BuildDynamicToo
+ $ setDynamicNow -- -dynamic
+ $ (init_dflags { hiSuf_ = dynHiSuf_ init_dflags -- -hisuf = -dynhisuf
+ , objectSuf_ = dynObjectSuf_ init_dflags -- -osuf = -dynosuf
+ })
hsc_env' <- newHscEnv dflags0
(dbs,unit_state,home_unit,mconstants) <- initUnits (hsc_logger hsc_env) dflags0 Nothing
dflags1 <- updatePlatformConstants dflags0 mconstants
@@ -814,11 +817,7 @@ hscGenBackendPipeline :: P m
hscGenBackendPipeline pipe_env hsc_env mod_sum result = do
let mod_name = moduleName (ms_mod mod_sum)
src_flavour = (ms_hsc_src mod_sum)
- dflags = hsc_dflags hsc_env
- -- MP: The ModLocation is recalculated here to get the right paths when
- -- -dynamic-too is enabled. `ModLocation` should be extended with a field for
- -- the location of the `dyn_o` file to avoid this recalculation.
- location <- liftIO (getLocation pipe_env dflags src_flavour mod_name)
+ let location = ms_location mod_sum
(fos, miface, mlinkable, o_file) <- use (T_HscBackend pipe_env hsc_env mod_name src_flavour location result)
final_fp <- hscPostBackendPipeline pipe_env hsc_env (ms_hsc_src mod_sum) (backend (hsc_dflags hsc_env)) (Just location) o_file
final_linkable <-
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index 370fde59a8..fcc6372509 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -81,6 +81,7 @@ import Data.Version
import GHC.Utils.Panic
import GHC.Unit.Module.Env
import GHC.Driver.Env.KnotVars
+import GHC.Driver.Config.Finder
newtype HookedUse a = HookedUse { runHookedUse :: (Hooks, PhaseHook) -> IO a }
deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch) via (ReaderT (Hooks, PhaseHook) IO)
@@ -494,7 +495,7 @@ runHscBackendPhase :: PipeEnv
runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do
let dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
- o_file = ml_obj_file location -- The real object file
+ o_file = if dynamicNow dflags then ml_dyn_obj_file location else ml_obj_file location -- The real object file
next_phase = hscPostBackendPhase src_flavour (backend dflags)
case result of
HscUpdate iface ->
@@ -649,11 +650,11 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do
-- (If we're linking then the -o applies to the linked thing, not to
-- the object file for one module.)
-- Note the nasty duplication with the same computation in compileFile above
- location <- getLocation pipe_env dflags src_flavour mod_name
+ location <- mkOneShotModLocation pipe_env dflags src_flavour mod_name
let o_file = ml_obj_file location -- The real object file
hi_file = ml_hi_file location
hie_file = ml_hie_file location
- dyn_o_file = dynamicOutputFile dflags o_file
+ dyn_o_file = ml_dyn_obj_file location
src_hash <- getFileHash (basename <.> suff)
hi_date <- modificationTimeIfExists hi_file
@@ -702,6 +703,52 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do
return (plugin_hsc_env, mod_summary, status)
+-- | Calculate the ModLocation from the provided DynFlags. This function is only used
+-- in one-shot mode and therefore takes into account the effect of -o/-ohi flags
+-- (which do nothing in --make mode)
+mkOneShotModLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO ModLocation
+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 basename suff
+
+ -- Boot-ify it if necessary
+ let location2
+ | HsBootFile <- src_flavour = addBootSuffixLocnOut location1
+ | otherwise = location1
+
+
+ -- 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 = fn }
+ | otherwise = location2
+
+ let dynohi = dynOutputHi dflags
+ location4 | Just fn <- dynohi = location3{ ml_dyn_hi_file = fn }
+ | otherwise = location3
+
+ -- Take -o into account if present
+ -- Very like -ohi, but we must *only* do this if we aren't linking
+ -- (If we're linking then the -o applies to the linked thing, not to
+ -- the object file for one module.)
+ -- Note the nasty duplication with the same computation in compileFile
+ -- above
+ let expl_o_file = outputFile_ dflags
+ expl_dyn_o_file = dynOutputFile_ dflags
+ location5 | Just ofile <- expl_o_file
+ , let dyn_ofile = fromMaybe (ofile -<.> dynObjectSuf_ dflags) expl_dyn_o_file
+ , isNoLink (ghcLink dflags)
+ = location4 { ml_obj_file = ofile
+ , ml_dyn_obj_file = dyn_ofile }
+ | Just dyn_ofile <- expl_dyn_o_file
+ = location4 { ml_dyn_obj_file = dyn_ofile }
+ | otherwise = location4
+ return location5
+ where
+ fopts = initFinderOpts dflags
+
runHscTcPhase :: HscEnv -> ModSummary -> IO (FrontendResult, Messages GhcMessage)
runHscTcPhase = hscTypecheckAndGetWarnings
@@ -728,7 +775,11 @@ runHsPpPhase hsc_env orig_fn input_fn output_fn = do
] )
return output_fn
-phaseOutputFilenameNew :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> IO FilePath
+phaseOutputFilenameNew :: Phase -- ^ The next phase
+ -> PipeEnv
+ -> HscEnv
+ -> Maybe ModLocation -- ^ A ModLocation, if we are compiling a Haskell source file
+ -> IO FilePath
phaseOutputFilenameNew next_phase pipe_env hsc_env maybe_loc = do
let PipeEnv{stop_phase, src_basename, output_spec} = pipe_env
let dflags = hsc_dflags hsc_env
@@ -764,16 +815,37 @@ getOutputFilename
-> Maybe ModLocation
-> IO FilePath
getOutputFilename logger tmpfs stop_phase output basename dflags next_phase maybe_location
+ -- 1. If we are generating object files for a .hs file, then return the odir as the ModLocation
+ -- will have been modified to point to the accurate locations
+ | StopLn <- next_phase, Just loc <- maybe_location =
+ return $ if dynamicNow dflags then ml_dyn_obj_file loc
+ else ml_obj_file loc
+ -- 2. If output style is persistant then
| is_last_phase, Persistent <- output = persistent_fn
- | is_last_phase, SpecificFile <- output = case outputFile dflags of
- Just f -> return f
- Nothing ->
- panic "SpecificFile: No filename"
+ -- 3. Specific file is only set when outputFile is set by -o
+ -- If we are in dynamic mode but -dyno is not set then write to the same path as
+ -- -o with a .dyn_* extension. This case is not triggered for object files which
+ -- are always handled by the ModLocation.
+ | is_last_phase, SpecificFile <- output =
+ return $
+ if dynamicNow dflags
+ then case dynOutputFile_ dflags of
+ Nothing -> let ofile = getOutputFile_ dflags
+ new_ext = case takeExtension ofile of
+ "" -> "dyn"
+ ext -> "dyn_" ++ tail ext
+ in replaceExtension ofile new_ext
+ Just fn -> fn
+ else getOutputFile_ dflags
| keep_this_output = persistent_fn
| Temporary lifetime <- output = newTempName logger tmpfs (tmpDir dflags) lifetime suffix
| otherwise = newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule
suffix
where
+ getOutputFile_ dflags = case outputFile_ dflags of
+ Nothing -> pprPanic "SpecificFile: No filename" (ppr $ (dynamicNow dflags, outputFile_ dflags, dynOutputFile_ dflags))
+ Just fn -> fn
+
hcsuf = hcSuf dflags
odir = objectDir dflags
osuf = objectSuf dflags
@@ -808,7 +880,6 @@ getOutputFilename logger tmpfs stop_phase output basename dflags next_phase mayb
persistent = basename <.> suffix
odir_persistent
- | Just loc <- maybe_location = ml_obj_file loc
| Just d <- odir = (d </> persistent)
| otherwise = persistent
diff --git a/compiler/GHC/Driver/Pipeline/Monad.hs b/compiler/GHC/Driver/Pipeline/Monad.hs
index f9067576ae..5415ecf2fe 100644
--- a/compiler/GHC/Driver/Pipeline/Monad.hs
+++ b/compiler/GHC/Driver/Pipeline/Monad.hs
@@ -7,19 +7,13 @@ module GHC.Driver.Pipeline.Monad (
, PipeEnv(..)
, PipelineOutput(..)
- , getLocation
) where
import GHC.Prelude
import Control.Monad.IO.Class
import qualified Data.Kind as K
import GHC.Driver.Phases
-import GHC.Driver.Config.Finder
import GHC.Utils.TmpFs
-import GHC.Driver.Session
-import GHC.Types.SourceFile
-import GHC.Unit.Module
-import GHC.Unit.Finder
-- The interface that the pipeline monad must implement.
type TPipelineClass (f :: K.Type -> K.Type) (m :: K.Type -> K.Type)
@@ -38,40 +32,6 @@ data PipeEnv = PipeEnv {
output_spec :: PipelineOutput -- ^ says where to put the pipeline output
}
--- | Calculate the ModLocation from the provided DynFlags
-getLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO ModLocation
-getLocation pipe_env dflags src_flavour mod_name = do
- let PipeEnv{ src_basename=basename,
- src_suffix=suff } = pipe_env
- location1 <- mkHomeModLocation2 fopts mod_name basename suff
-
- -- Boot-ify it if necessary
- let location2
- | HsBootFile <- src_flavour = addBootSuffixLocnOut location1
- | otherwise = location1
-
-
- -- 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 = fn }
- | otherwise = location2
-
- -- Take -o into account if present
- -- Very like -ohi, but we must *only* do this if we aren't linking
- -- (If we're linking then the -o applies to the linked thing, not to
- -- the object file for one module.)
- -- Note the nasty duplication with the same computation in compileFile
- -- above
- let expl_o_file = outputFile dflags
- location4 | Just ofile <- expl_o_file
- , isNoLink (ghcLink dflags)
- = location3 { ml_obj_file = ofile }
- | otherwise = location3
- return location4
- where
- fopts = initFinderOpts dflags
data PipelineOutput
= Temporary TempFileLifetime
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 12f0e8be33..3342091bfa 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -38,10 +38,9 @@ module GHC.Driver.Session (
xopt_FieldSelectors,
lang_set,
DynamicTooState(..), dynamicTooState, setDynamicNow, setDynamicTooFailed,
- dynamicOutputFile, dynamicOutputHi,
sccProfilingEnabled,
DynFlags(..),
- outputFile, hiSuf, objectSuf, ways,
+ outputFile, objectSuf, ways,
FlagSpec(..),
HasDynFlags(..), ContainsDynFlags(..),
RtsOptsEnabled(..),
@@ -1059,13 +1058,6 @@ setDynamicTooFailed :: MonadIO m => DynFlags -> m ()
setDynamicTooFailed dflags =
liftIO $ writeIORef (dynamicTooFailed dflags) True
--- | Compute the path of the dynamic object corresponding to an object file.
-dynamicOutputFile :: DynFlags -> FilePath -> FilePath
-dynamicOutputFile dflags outputFile = outputFile -<.> dynObjectSuf_ dflags
-
-dynamicOutputHi :: DynFlags -> FilePath -> FilePath
-dynamicOutputHi dflags hi = hi -<.> dynHiSuf_ dflags
-
-----------------------------------------------------------------------------
-- | Used by 'GHC.runGhc' to partially initialize a new 'DynFlags' value
@@ -1873,26 +1865,19 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
throwGhcExceptionIO (CmdLineError ("combination not supported: " ++
intercalate "/" (map wayDesc (Set.toAscList theWays))))
- let dflags3
- | Just outFile <- outputFile_ dflags2 -- Only iff user specified -o ...
- , not (isJust (dynOutputFile_ dflags2)) -- but not -dyno
- = dflags2 { dynOutputFile_ = Just $ dynamicOutputFile dflags2 outFile }
- | otherwise
- = dflags2
-
- let (dflags4, consistency_warnings) = makeDynFlagsConsistent dflags3
+ let (dflags3, consistency_warnings) = makeDynFlagsConsistent dflags2
-- Set timer stats & heap size
- when (enableTimeStats dflags4) $ liftIO enableTimingStats
- case (ghcHeapSize dflags4) of
+ when (enableTimeStats dflags3) $ liftIO enableTimingStats
+ case (ghcHeapSize dflags3) of
Just x -> liftIO (setHeapSize x)
_ -> return ()
- liftIO $ setUnsafeGlobalDynFlags dflags4
+ liftIO $ setUnsafeGlobalDynFlags dflags3
let warns' = map (Warn WarningWithoutFlag) (consistency_warnings ++ sh_warns)
- return (dflags4, leftover, warns' ++ warns)
+ return (dflags3, leftover, warns' ++ warns)
-- | Check (and potentially disable) any extensions that aren't allowed
-- in safe mode.
@@ -4874,11 +4859,6 @@ outputFile dflags
| dynamicNow dflags = dynOutputFile_ dflags
| otherwise = outputFile_ dflags
-hiSuf :: DynFlags -> String
-hiSuf dflags
- | dynamicNow dflags = dynHiSuf_ dflags
- | otherwise = hiSuf_ dflags
-
objectSuf :: DynFlags -> String
objectSuf dflags
| dynamicNow dflags = dynObjectSuf_ dflags
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 2b31074896..64df715755 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -912,10 +912,10 @@ findAndReadIface logger name_cache fc hooks unit_state home_unit dflags doc_str
case r of
Failed _
-> return ()
- Succeeded (iface,fp)
+ Succeeded (iface,_fp)
-> load_dynamic_too_maybe logger name_cache unit_state
dflags wanted_mod
- hi_boot_file iface fp
+ hi_boot_file iface loc
return r
err -> do
trace_if logger (text "...not found")
@@ -928,20 +928,20 @@ findAndReadIface logger name_cache fc hooks unit_state home_unit dflags doc_str
err
-- | Check if we need to try the dynamic interface for -dynamic-too
-load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> FilePath -> IO ()
-load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod is_boot iface file_path
+load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> ModLocation -> IO ()
+load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod is_boot iface loc
-- Indefinite interfaces are ALWAYS non-dynamic.
| not (moduleIsDefinite (mi_module iface)) = return ()
| otherwise = dynamicTooState dflags >>= \case
DT_Dont -> return ()
DT_Failed -> return ()
- DT_Dyn -> load_dynamic_too logger name_cache unit_state dflags wanted_mod is_boot iface file_path
- DT_OK -> load_dynamic_too logger name_cache unit_state (setDynamicNow dflags) wanted_mod is_boot iface file_path
+ DT_Dyn -> load_dynamic_too logger name_cache unit_state dflags wanted_mod iface file_path
+ DT_OK -> load_dynamic_too logger name_cache unit_state (setDynamicNow dflags) wanted_mod iface file_path
+ where
+ file_path = addBootSuffix_maybe is_boot (ml_dyn_hi_file loc)
-load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> IsBootInterface -> ModIface -> FilePath -> IO ()
-load_dynamic_too logger name_cache unit_state dflags wanted_mod is_boot iface file_path = do
- let dynFilePath = addBootSuffix_maybe is_boot
- $ replaceExtension file_path (hiSuf dflags)
+load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags -> Module -> ModIface -> FilePath -> IO ()
+load_dynamic_too logger name_cache unit_state dflags wanted_mod iface dynFilePath = do
read_file logger name_cache unit_state dflags wanted_mod dynFilePath >>= \case
Succeeded (dynIface, _)
| mi_mod_hash (mi_final_exts iface) == mi_mod_hash (mi_final_exts dynIface)
diff --git a/compiler/GHC/Linker/Dynamic.hs b/compiler/GHC/Linker/Dynamic.hs
index 3eca65c6cc..c62a6e2242 100644
--- a/compiler/GHC/Linker/Dynamic.hs
+++ b/compiler/GHC/Linker/Dynamic.hs
@@ -44,7 +44,7 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages
= dflags0
verbFlags = getVerbFlags dflags
- o_file = outputFile dflags
+ o_file = outputFile_ dflags
pkgs_with_rts <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_packages)
diff --git a/compiler/GHC/Linker/Loader.hs b/compiler/GHC/Linker/Loader.hs
index 3cdee27863..2af6f4dfe1 100644
--- a/compiler/GHC/Linker/Loader.hs
+++ b/compiler/GHC/Linker/Loader.hs
@@ -615,7 +615,7 @@ checkNonStdWay dflags interp srcspan
-- Only if we are compiling with the same ways as GHC is built
-- with, can we dynamically load those object files. (see #3604)
- | objectSuf dflags == normalObjectSuffix && not (null targetFullWays)
+ | objectSuf_ dflags == normalObjectSuffix && not (null targetFullWays)
= failNonStd dflags srcspan
| otherwise = return (Just (hostWayTag ++ "o"))
@@ -663,7 +663,7 @@ failNonStd dflags srcspan = dieWith dflags srcspan $
getLinkDeps :: HscEnv -> HomePackageTable
-> LoaderState
- -> Maybe FilePath -- replace object suffices?
+ -> Maybe FilePath -- replace object suffixes?
-> SrcSpan -- for error messages
-> [Module] -- If you need these
-> IO ([Linkable], [Linkable], [UnitId]) -- ... then link these first
diff --git a/compiler/GHC/Linker/Static.hs b/compiler/GHC/Linker/Static.hs
index ed67daa347..d5e9147509 100644
--- a/compiler/GHC/Linker/Static.hs
+++ b/compiler/GHC/Linker/Static.hs
@@ -73,7 +73,7 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
unit_state = ue_units unit_env
toolSettings' = toolSettings dflags
verbFlags = getVerbFlags dflags
- output_fn = exeFileName platform staticLink (outputFile dflags)
+ output_fn = exeFileName platform staticLink (outputFile_ dflags)
-- get the full list of packages to link with, by combining the
-- explicit packages with the auto packages and all of their
@@ -277,7 +277,7 @@ linkStaticLib logger dflags unit_env o_files dep_units = do
let platform = ue_platform unit_env
extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]
modules = o_files ++ extra_ld_inputs
- output_fn = exeFileName platform True (outputFile dflags)
+ output_fn = exeFileName platform True (outputFile_ dflags)
full_output_fn <- if isAbsolute output_fn
then return output_fn
diff --git a/compiler/GHC/Unit/Finder.hs b/compiler/GHC/Unit/Finder.hs
index f0ecfb2ba7..8a402dca15 100644
--- a/compiler/GHC/Unit/Finder.hs
+++ b/compiler/GHC/Unit/Finder.hs
@@ -123,37 +123,6 @@ lookupFileCache (FinderCache _ ref) key = do
-- -----------------------------------------------------------------------------
-- The three external entry points
--- | Locations and information the finder cares about.
---
--- Should be taken from 'DynFlags' via 'initFinderOpts'.
-data FinderOpts = FinderOpts
- { finder_importPaths :: [FilePath]
- -- ^ Where are we allowed to look for Modules and Source files
- , finder_lookupHomeInterfaces :: Bool
- -- ^ When looking up a home module:
- --
- -- * 'True': search interface files (e.g. in '-c' mode)
- -- * 'False': search source files (e.g. in '--make' mode)
-
- , finder_bypassHiFileCheck :: Bool
- -- ^ Don't check that an imported interface file actually exists
- -- if it can only be at one location. The interface will be reported
- -- as `InstalledFound` even if the file doesn't exist, so this is
- -- only useful in specific cases (e.g. to generate dependencies
- -- with `ghc -M`)
- , finder_ways :: Ways
- , finder_enableSuggestions :: Bool
- -- ^ If we encounter unknown modules, should we suggest modules
- -- that have a similar name.
- , finder_hieDir :: Maybe FilePath
- , finder_hieSuf :: String
- , finder_hiDir :: Maybe FilePath
- , finder_hiSuf :: String
- , finder_objectDir :: Maybe FilePath
- , finder_objectSuf :: String
- , finder_stubDir :: Maybe FilePath
- }
-
-- | Locate a module that was imported by the user. We have the
-- module's name, and possibly a package name. Without a package
@@ -424,19 +393,21 @@ findPackageModule_ fc fopts mod pkg_conf = do
package_hisuf | null tag = "hi"
| otherwise = tag ++ "_hi"
- mk_hi_loc = mkHiOnlyModLocation fopts package_hisuf
+ package_dynhisuf = waysBuildTag (addWay WayDyn (finder_ways fopts)) ++ "_hi"
+
+ mk_hi_loc = mkHiOnlyModLocation fopts package_hisuf package_dynhisuf
import_dirs = map ST.unpack $ unitImportDirs pkg_conf
-- we never look for a .hi-boot file in an external package;
-- .hi-boot files only make sense for the home package.
in
case import_dirs of
- [one] | finder_bypassHiFileCheck fopts -> do
+ [one] | finder_bypassHiFileCheck fopts ->
-- there's only one place that this .hi file can be, so
-- don't bother looking for it.
let basename = moduleNameSlashes (moduleName mod)
- loc <- mk_hi_loc one basename
- return (InstalledFound loc mod)
+ loc = mk_hi_loc one basename
+ in return $ InstalledFound loc mod
_otherwise ->
searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)]
@@ -446,8 +417,8 @@ findPackageModule_ fc fopts mod pkg_conf = do
searchPathExts :: [FilePath] -- paths to search
-> InstalledModule -- module name
-> [ (
- FileExt, -- suffix
- FilePath -> BaseName -> IO ModLocation -- action
+ FileExt, -- suffix
+ FilePath -> BaseName -> ModLocation -- action
)
]
-> IO InstalledFindResult
@@ -456,7 +427,7 @@ searchPathExts paths mod exts = search to_search
where
basename = moduleNameSlashes (moduleName mod)
- to_search :: [(FilePath, IO ModLocation)]
+ to_search :: [(FilePath, ModLocation)]
to_search = [ (file, fn path basename)
| path <- paths,
(ext,fn) <- exts,
@@ -467,17 +438,18 @@ searchPathExts paths mod exts = search to_search
search [] = return (InstalledNotFound (map fst to_search) (Just (moduleUnit mod)))
- search ((file, mk_result) : rest) = do
+ search ((file, loc) : rest) = do
b <- doesFileExist file
if b
- then do { loc <- mk_result; return (InstalledFound loc mod) }
+ then return $ InstalledFound loc mod
else search rest
mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt
- -> FilePath -> BaseName -> IO ModLocation
+ -> FilePath -> BaseName -> ModLocation
mkHomeModLocationSearched fopts mod suff path basename =
mkHomeModLocation2 fopts mod (path </> basename) suff
+
-- -----------------------------------------------------------------------------
-- Constructing a home module location
@@ -511,49 +483,59 @@ mkHomeModLocationSearched fopts mod suff path basename =
-- ext
-- The filename extension of the source file (usually "hs" or "lhs").
-mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> IO ModLocation
-mkHomeModLocation dflags mod src_filename = do
+mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> ModLocation
+mkHomeModLocation dflags mod src_filename =
let (basename,extension) = splitExtension src_filename
- mkHomeModLocation2 dflags mod basename extension
+ in mkHomeModLocation2 dflags mod basename extension
mkHomeModLocation2 :: FinderOpts
-> ModuleName
-> FilePath -- Of source module, without suffix
-> String -- Suffix
- -> IO ModLocation
-mkHomeModLocation2 fopts mod src_basename ext = do
+ -> ModLocation
+mkHomeModLocation2 fopts mod src_basename ext =
let mod_basename = 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
- return (ModLocation{ ml_hs_file = Just (src_basename <.> ext),
+ in (ModLocation{ ml_hs_file = Just (src_basename <.> ext),
ml_hi_file = hi_fn,
+ ml_dyn_hi_file = dyn_hi_fn,
ml_obj_file = obj_fn,
+ ml_dyn_obj_file = dyn_obj_fn,
ml_hie_file = hie_fn })
mkHomeModHiOnlyLocation :: FinderOpts
-> ModuleName
-> FilePath
-> BaseName
- -> IO ModLocation
-mkHomeModHiOnlyLocation fopts mod path basename = do
- loc <- mkHomeModLocation2 fopts mod (path </> basename) ""
- return loc { ml_hs_file = Nothing }
-
-mkHiOnlyModLocation :: FinderOpts -> Suffix -> FilePath -> String
- -> IO ModLocation
-mkHiOnlyModLocation fopts hisuf path basename
- = do let full_basename = path </> basename
- obj_fn = mkObjPath fopts full_basename basename
- hie_fn = mkHiePath fopts full_basename basename
- return ModLocation{ ml_hs_file = Nothing,
+ -> ModLocation
+mkHomeModHiOnlyLocation fopts mod path basename =
+ let loc = mkHomeModLocation2 fopts mod (path </> basename) ""
+ in loc { ml_hs_file = Nothing }
+
+-- This function is used to make a ModLocation for a package module. Hence why
+-- we explicitly pass in the interface file suffixes.
+mkHiOnlyModLocation :: FinderOpts -> Suffix -> Suffix -> FilePath -> String
+ -> ModLocation
+mkHiOnlyModLocation fopts hisuf dynhisuf path basename
+ = let full_basename = path </> basename
+ obj_fn = mkObjPath fopts full_basename basename
+ dyn_obj_fn = mkDynObjPath fopts full_basename basename
+ hie_fn = mkHiePath fopts full_basename basename
+ in ModLocation{ ml_hs_file = Nothing,
ml_hi_file = full_basename <.> hisuf,
-- Remove the .hi-boot suffix from
-- hi_file, if it had one. We always
-- want the name of the real .hi file
-- in the ml_hi_file field.
+ ml_dyn_obj_file = dyn_obj_fn,
+ -- MP: TODO
+ ml_dyn_hi_file = full_basename <.> dynhisuf,
ml_obj_file = obj_fn,
ml_hie_file = hie_fn
}
@@ -573,6 +555,21 @@ mkObjPath fopts basename mod_basename = obj_basename <.> osuf
obj_basename | Just dir <- odir = dir </> mod_basename
| otherwise = basename
+-- | Constructs the filename of a .dyn_o file for a given source file.
+-- Does /not/ check whether the .dyn_o file exists
+mkDynObjPath
+ :: FinderOpts
+ -> FilePath -- the filename of the source file, minus the extension
+ -> String -- the module name with dots replaced by slashes
+ -> FilePath
+mkDynObjPath fopts basename mod_basename = obj_basename <.> dynosuf
+ where
+ odir = finder_objectDir fopts
+ dynosuf = finder_dynObjectSuf fopts
+
+ obj_basename | Just dir <- odir = dir </> mod_basename
+ | otherwise = basename
+
-- | Constructs the filename of a .hi file for a given source file.
-- Does /not/ check whether the .hi file exists
@@ -589,6 +586,21 @@ mkHiPath fopts basename mod_basename = hi_basename <.> hisuf
hi_basename | Just dir <- hidir = dir </> mod_basename
| otherwise = basename
+-- | Constructs the filename of a .dyn_hi file for a given source file.
+-- Does /not/ check whether the .dyn_hi file exists
+mkDynHiPath
+ :: FinderOpts
+ -> FilePath -- the filename of the source file, minus the extension
+ -> String -- the module name with dots replaced by slashes
+ -> FilePath
+mkDynHiPath fopts basename mod_basename = hi_basename <.> dynhisuf
+ where
+ hidir = finder_hiDir fopts
+ dynhisuf = finder_dynHiSuf fopts
+
+ hi_basename | Just dir <- hidir = dir </> mod_basename
+ | otherwise = basename
+
-- | Constructs the filename of a .hie file for a given source file.
-- Does /not/ check whether the .hie file exists
mkHiePath
diff --git a/compiler/GHC/Unit/Finder/Types.hs b/compiler/GHC/Unit/Finder/Types.hs
index d589cacbba..26baea564c 100644
--- a/compiler/GHC/Unit/Finder/Types.hs
+++ b/compiler/GHC/Unit/Finder/Types.hs
@@ -3,6 +3,7 @@ module GHC.Unit.Finder.Types
, FinderCacheState
, FindResult (..)
, InstalledFindResult (..)
+ , FinderOpts(..)
)
where
@@ -10,6 +11,7 @@ import GHC.Prelude
import GHC.Unit
import qualified Data.Map as M
import GHC.Fingerprint
+import GHC.Platform.Ways
import Data.IORef
@@ -62,3 +64,35 @@ data FindResult
, fr_suggestions :: [ModuleSuggestion] -- ^ Possible mis-spelled modules
}
+-- | Locations and information the finder cares about.
+--
+-- Should be taken from 'DynFlags' via 'initFinderOpts'.
+data FinderOpts = FinderOpts
+ { finder_importPaths :: [FilePath]
+ -- ^ Where are we allowed to look for Modules and Source files
+ , finder_lookupHomeInterfaces :: Bool
+ -- ^ When looking up a home module:
+ --
+ -- * 'True': search interface files (e.g. in '-c' mode)
+ -- * 'False': search source files (e.g. in '--make' mode)
+
+ , finder_bypassHiFileCheck :: Bool
+ -- ^ Don't check that an imported interface file actually exists
+ -- if it can only be at one location. The interface will be reported
+ -- as `InstalledFound` even if the file doesn't exist, so this is
+ -- only useful in specific cases (e.g. to generate dependencies
+ -- with `ghc -M`)
+ , finder_ways :: Ways
+ , finder_enableSuggestions :: Bool
+ -- ^ If we encounter unknown modules, should we suggest modules
+ -- that have a similar name.
+ , finder_hieDir :: Maybe FilePath
+ , finder_hieSuf :: String
+ , finder_hiDir :: Maybe FilePath
+ , finder_hiSuf :: String
+ , finder_dynHiSuf :: String
+ , finder_objectDir :: Maybe FilePath
+ , finder_objectSuf :: String
+ , finder_dynObjectSuf :: String
+ , finder_stubDir :: Maybe FilePath
+ }
diff --git a/compiler/GHC/Unit/Module/Graph.hs b/compiler/GHC/Unit/Module/Graph.hs
index 027cbef51b..bf7abfea99 100644
--- a/compiler/GHC/Unit/Module/Graph.hs
+++ b/compiler/GHC/Unit/Module/Graph.hs
@@ -204,7 +204,7 @@ showModMsg dflags recomp (ModuleNode (ExtendedModSummary mod_summary _)) =
op = normalise
mod = moduleName (ms_mod mod_summary)
mod_str = showPpr dflags mod ++ hscSourceString (ms_hsc_src mod_summary)
- dyn_file = op $ msDynObjFilePath mod_summary dflags
+ dyn_file = op $ msDynObjFilePath mod_summary
obj_file = case backend dflags of
Interpreter | recomp -> "interpreted"
NoBackend -> "nothing"
diff --git a/compiler/GHC/Unit/Module/Location.hs b/compiler/GHC/Unit/Module/Location.hs
index ff5354bfdb..866ccf127a 100644
--- a/compiler/GHC/Unit/Module/Location.hs
+++ b/compiler/GHC/Unit/Module/Location.hs
@@ -16,7 +16,7 @@ import GHC.Utils.Outputable
-- | Module Location
--
-- Where a module lives on the file system: the actual locations
--- of the .hs, .hi and .o files, if we have them.
+-- of the .hs, .hi, .dyn_hi, .o, .dyn_o and .hie files, if we have them.
--
-- For a module in another unit, the ml_hs_file and ml_obj_file components of
-- ModLocation are undefined.
@@ -25,6 +25,16 @@ import GHC.Utils.Outputable
-- correspond to actual files yet: for example, even if the object
-- file doesn't exist, the ModLocation still contains the path to
-- where the object file will reside if/when it is created.
+--
+-- The paths of anything which can affect recompilation should be placed inside
+-- ModLocation.
+--
+-- When a ModLocation is created none of the filepaths will have -boot suffixes.
+-- This is because in --make mode the ModLocation is put in the finder cache which
+-- is indexed by ModuleName, when a ModLocation is retrieved from the FinderCache
+-- the boot suffixes are appended.
+-- The other case is in -c mode, there the ModLocation immediately gets given the
+-- boot suffixes in mkOneShotModLocation.
data ModLocation
= ModLocation {
@@ -37,12 +47,20 @@ data ModLocation
-- yet. Always of form foo.hi, even if there is an
-- hi-boot file (we add the -boot suffix later)
+ ml_dyn_hi_file :: FilePath,
+ -- ^ Where the .dyn_hi file is, whether or not it exists
+ -- yet.
+
ml_obj_file :: FilePath,
-- ^ Where the .o file is, whether or not it exists yet.
-- (might not exist either because the module hasn't
-- been compiled yet, or because it is part of a
-- unit with a .a file)
+ ml_dyn_obj_file :: FilePath,
+ -- ^ Where the .dy file is, whether or not it exists
+ -- yet.
+
ml_hie_file :: FilePath
-- ^ Where the .hie file is, whether or not it exists
-- yet.
@@ -73,7 +91,9 @@ addBootSuffixLocn :: ModLocation -> ModLocation
addBootSuffixLocn locn
= locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn)
, ml_hi_file = addBootSuffix (ml_hi_file locn)
+ , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn)
, ml_obj_file = addBootSuffix (ml_obj_file locn)
+ , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn)
, ml_hie_file = addBootSuffix (ml_hie_file locn) }
-- | Add the @-boot@ suffix to all output file paths associated with the
@@ -81,7 +101,10 @@ addBootSuffixLocn locn
addBootSuffixLocnOut :: ModLocation -> ModLocation
addBootSuffixLocnOut locn
= locn { ml_hi_file = addBootSuffix (ml_hi_file locn)
+ , ml_dyn_hi_file = addBootSuffix (ml_dyn_hi_file locn)
, ml_obj_file = addBootSuffix (ml_obj_file locn)
- , ml_hie_file = addBootSuffix (ml_hie_file locn) }
+ , ml_dyn_obj_file = addBootSuffix (ml_dyn_obj_file locn)
+ , ml_hie_file = addBootSuffix (ml_hie_file locn)
+ }
diff --git a/compiler/GHC/Unit/Module/ModSummary.hs b/compiler/GHC/Unit/Module/ModSummary.hs
index 1a8cddec61..9cf736a37a 100644
--- a/compiler/GHC/Unit/Module/ModSummary.hs
+++ b/compiler/GHC/Unit/Module/ModSummary.hs
@@ -156,8 +156,8 @@ msHsFilePath ms = expectJust "msHsFilePath" (ml_hs_file (ms_location ms))
msHiFilePath ms = ml_hi_file (ms_location ms)
msObjFilePath ms = ml_obj_file (ms_location ms)
-msDynObjFilePath :: ModSummary -> DynFlags -> FilePath
-msDynObjFilePath ms dflags = dynamicOutputFile dflags (msObjFilePath ms)
+msDynObjFilePath :: ModSummary -> FilePath
+msDynObjFilePath ms = ml_dyn_obj_file (ms_location ms)
-- | Did this 'ModSummary' originate from a hs-boot file?
isBootSummary :: ModSummary -> IsBootInterface
diff --git a/testsuite/tests/count-deps/CountDepsAst.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout
index da2b5b3e5c..9117f0892c 100644
--- a/testsuite/tests/count-deps/CountDepsAst.stdout
+++ b/testsuite/tests/count-deps/CountDepsAst.stdout
@@ -1,4 +1,4 @@
-Found 278 Language.Haskell.Syntax module dependencies
+Found 276 Language.Haskell.Syntax module dependencies
GHC.Builtin.Names
GHC.Builtin.PrimOps
GHC.Builtin.Types
@@ -85,7 +85,6 @@ GHC.Data.TrieMap
GHC.Driver.Backend
GHC.Driver.CmdLine
GHC.Driver.Config.Diagnostic
-GHC.Driver.Config.Finder
GHC.Driver.Config.Logger
GHC.Driver.Env
GHC.Driver.Env.KnotVars
@@ -223,7 +222,6 @@ GHC.Types.Var.Set
GHC.Unit
GHC.Unit.Env
GHC.Unit.External
-GHC.Unit.Finder
GHC.Unit.Finder.Types
GHC.Unit.Home
GHC.Unit.Home.ModInfo
diff --git a/testsuite/tests/count-deps/CountDepsParser.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout
index f67d2eb223..2738d7d33f 100644
--- a/testsuite/tests/count-deps/CountDepsParser.stdout
+++ b/testsuite/tests/count-deps/CountDepsParser.stdout
@@ -1,4 +1,4 @@
-Found 284 GHC.Parser module dependencies
+Found 282 GHC.Parser module dependencies
GHC.Builtin.Names
GHC.Builtin.PrimOps
GHC.Builtin.Types
@@ -86,7 +86,6 @@ GHC.Driver.Backend
GHC.Driver.Backpack.Syntax
GHC.Driver.CmdLine
GHC.Driver.Config.Diagnostic
-GHC.Driver.Config.Finder
GHC.Driver.Config.Logger
GHC.Driver.Env
GHC.Driver.Env.KnotVars
@@ -229,7 +228,6 @@ GHC.Types.Var.Set
GHC.Unit
GHC.Unit.Env
GHC.Unit.External
-GHC.Unit.Finder
GHC.Unit.Finder.Types
GHC.Unit.Home
GHC.Unit.Home.ModInfo
diff --git a/testsuite/tests/driver/T20348/Makefile b/testsuite/tests/driver/T20348/Makefile
index e6903e4cc4..ba1edd021d 100644
--- a/testsuite/tests/driver/T20348/Makefile
+++ b/testsuite/tests/driver/T20348/Makefile
@@ -24,3 +24,38 @@ T20348: clean
# Second run: should not recompile.
echo 'second run'
'$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface A.hs
+
+T20348A: clean
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c -o A2.o -ohi A2.hi -dynohi A2.dyn_hi A.hs -dynamic-too
+ $(call checkExists,A2.hi)
+ $(call checkExists,A2.o)
+ $(call checkExists,A2.dyn_hi)
+ $(call checkExists,A2.dyn_o)
+
+T20348B: clean
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c -o A2.o -ohi A2.hi A.hs -dynamic-too
+ $(call checkExists,A2.hi)
+ $(call checkExists,A2.o)
+ $(call checkExists,A.dyn_hi)
+ $(call checkExists,A2.dyn_o)
+
+T20348C: clean
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c -o A2.o -dyno A2.dyn_o A.hs -dynamic-too
+ $(call checkExists,A.hi)
+ $(call checkExists,A2.o)
+ $(call checkExists,A.dyn_hi)
+ $(call checkExists,A2.dyn_o)
+
+T20348D: clean
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c -dyno A2.dyn_o A.hs -dynamic-too
+ $(call checkExists,A.hi)
+ $(call checkExists,A.o)
+ $(call checkExists,A.dyn_hi)
+ $(call checkExists,A2.dyn_o)
+
+T20348E: clean
+ '$(TEST_HC)' $(TEST_HC_OPTS) -S -o A2.s A.hs -dynamic-too
+ $(call checkExists,A2.s)
+ $(call checkExists,A2.dyn_s)
+
+
diff --git a/testsuite/tests/driver/T20348/all.T b/testsuite/tests/driver/T20348/all.T
index 935c8efa8c..e7717ca770 100644
--- a/testsuite/tests/driver/T20348/all.T
+++ b/testsuite/tests/driver/T20348/all.T
@@ -1,3 +1,8 @@
# N.B. this package requires a dynamically-linked ghc-bin, since it assumes
# that TH evaluation will build dynamic objects.
test('T20348', [extra_files(['A.hs']), unless(have_dynamic(), skip)], makefile_test, [])
+test('T20348A', [extra_files(['A.hs']), unless(have_dynamic(), skip)], makefile_test, [])
+test('T20348B', [extra_files(['A.hs']), unless(have_dynamic(), skip)], makefile_test, [])
+test('T20348C', [extra_files(['A.hs']), unless(have_dynamic(), skip)], makefile_test, [])
+test('T20348D', [extra_files(['A.hs']), unless(have_dynamic(), skip)], makefile_test, [])
+test('T20348E', [extra_files(['A.hs']), unless(have_dynamic(), skip)], makefile_test, [])
diff --git a/testsuite/tests/driver/recomp-boot-dyn-too/A.hs b/testsuite/tests/driver/recomp-boot-dyn-too/A.hs
new file mode 100644
index 0000000000..d843c00b78
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot-dyn-too/A.hs
@@ -0,0 +1 @@
+module A where
diff --git a/testsuite/tests/driver/recomp-boot-dyn-too/A.hs-boot b/testsuite/tests/driver/recomp-boot-dyn-too/A.hs-boot
new file mode 100644
index 0000000000..d843c00b78
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot-dyn-too/A.hs-boot
@@ -0,0 +1 @@
+module A where
diff --git a/testsuite/tests/driver/recomp-boot-dyn-too/B1.hs b/testsuite/tests/driver/recomp-boot-dyn-too/B1.hs
new file mode 100644
index 0000000000..ce9e7e4932
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot-dyn-too/B1.hs
@@ -0,0 +1,3 @@
+module B where
+
+import A
diff --git a/testsuite/tests/driver/recomp-boot-dyn-too/B2.hs b/testsuite/tests/driver/recomp-boot-dyn-too/B2.hs
new file mode 100644
index 0000000000..b3fc879af1
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot-dyn-too/B2.hs
@@ -0,0 +1,3 @@
+module B where
+
+import {-# SOURCE #-} A
diff --git a/testsuite/tests/driver/recomp-boot-dyn-too/Makefile b/testsuite/tests/driver/recomp-boot-dyn-too/Makefile
new file mode 100644
index 0000000000..6c3761b3d4
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot-dyn-too/Makefile
@@ -0,0 +1,18 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+# Recompilation tests
+
+clean:
+ rm -f *.dyn_hi *.dyn_hi-boot *.dyn_o *.dyn_o-boot *.hi *.hi-boot *.o *.o-boot
+ rm -f B.hs
+
+# Recompile
+
+recomp-boot-dyn-too: clean
+ cp B1.hs B.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) --make -dynamic-too B.hs
+ cp B2.hs B.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) --make -dynamic-too B.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) --make -dynamic-too B.hs
diff --git a/testsuite/tests/driver/recomp-boot-dyn-too/all.T b/testsuite/tests/driver/recomp-boot-dyn-too/all.T
new file mode 100644
index 0000000000..8d4d6657c0
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot-dyn-too/all.T
@@ -0,0 +1,4 @@
+test('recomp-boot-dyn-too', [ unless(have_dynamic(), skip)
+ , extra_files(['A.hs', 'B1.hs', 'B2.hs', 'A.hs-boot'])
+ , when(fast(), skip)],
+ makefile_test, [])
diff --git a/testsuite/tests/driver/recomp-boot-dyn-too/recomp-boot-dyn-too.stdout b/testsuite/tests/driver/recomp-boot-dyn-too/recomp-boot-dyn-too.stdout
new file mode 100644
index 0000000000..e8ce474459
--- /dev/null
+++ b/testsuite/tests/driver/recomp-boot-dyn-too/recomp-boot-dyn-too.stdout
@@ -0,0 +1,4 @@
+[1 of 2] Compiling A ( A.hs, A.o, A.dyn_o )
+[2 of 2] Compiling B ( B.hs, B.o, B.dyn_o )
+[1 of 3] Compiling A[boot] ( A.hs-boot, A.o-boot, A.dyn_o-boot )
+[2 of 3] Compiling B ( B.hs, B.o, B.dyn_o ) [Source file changed]
diff --git a/testsuite/tests/regalloc/regalloc_unit_tests.hs b/testsuite/tests/regalloc/regalloc_unit_tests.hs
index 994ecde659..7726c79b1f 100644
--- a/testsuite/tests/regalloc/regalloc_unit_tests.hs
+++ b/testsuite/tests/regalloc/regalloc_unit_tests.hs
@@ -50,6 +50,8 @@ import GHC.Utils.Logger
import GHC.Utils.Outputable
import GHC.Types.Basic
import GHC.Unit.Home
+import GHC.Unit.Finder
+import GHC.Driver.Config.Finder
import GHC.Data.Stream as Stream (collect, yield)
@@ -158,7 +160,7 @@ compileCmmForRegAllocStats logger dflags cmmFile ncgImplF us = do
thisMod = mkModule
(stringToUnit . show . uniqFromSupply $ usc)
(mkModuleName . show . uniqFromSupply $ usd)
- thisModLoc = ModLocation Nothing (cmmFile ++ ".hi") (cmmFile ++ ".o") (cmmFile ++ ".hie")
+ thisModLoc = mkHiOnlyModLocation (initFinderOpts dflags) "hi" "dyn_hi" "" cmmFile
-- | The register allocator should be able to see that each variable only