diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-09-30 11:12:10 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-10-19 03:30:16 -0400 |
commit | df419c1abd7daa3aa0231747582333357b8e9b85 (patch) | |
tree | a73aaf04830425c43afe525f22138ca58550301e | |
parent | 8144a92f5a73dd22c0d855d5b2bead930111511c (diff) | |
download | haskell-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.
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 |