diff --git a/compiler/GHC/Driver/Downsweep.hs b/compiler/GHC/Driver/Downsweep.hs index 2912eddaf0de..5fe3a50f8fdc 100644 --- a/compiler/GHC/Driver/Downsweep.hs +++ b/compiler/GHC/Driver/Downsweep.hs @@ -940,12 +940,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = do } -- Recursive call to catch the other cases enable_code_gen_ms ms' - | dynamic_too_enable enable_spec ms -> do - let ms' = ms - { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_BuildDynamicToo - } - -- Recursive call to catch the other cases - enable_code_gen_ms ms' + -- Note: dynamic_too_enable case removed - -dynamic-too is deprecated | ext_interp_enable ms -> do let ms' = ms { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_ExternalInterpreter @@ -968,14 +963,10 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = do -- can't compile anything anyway! See #16219. isHomeUnitDefinite (ue_unitHomeUnit (ms_unitid ms) unit_env) + -- bytecode_and_enable: prefer bytecode over needing dynamic objects + -- Note: dynamic_too_enable logic removed - -dynamic-too is deprecated bytecode_and_enable enable_spec ms = - -- In the situation where we **would** need to enable dynamic-too - -- IF we had decided we needed objects - dynamic_too_enable EnableObject ms - -- but we prefer to use bytecode rather than objects - && prefer_bytecode - -- and we haven't already turned it on - && not generate_both + prefer_bytecode && not generate_both where lcl_dflags = ms_hspp_opts ms prefer_bytecode = case enable_spec of @@ -985,29 +976,6 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = do generate_both = gopt Opt_ByteCodeAndObjectCode lcl_dflags - -- #8180 - when using TemplateHaskell, switch on -dynamic-too so - -- the linker can correctly load the object files. This isn't necessary - -- when using -fexternal-interpreter. - -- FIXME: Duplicated from makeDynFlagsConsistent - dynamic_too_enable enable_spec ms - | sTargetRTSLinkerOnlySupportsSharedLibs $ settings lcl_dflags = - not isDynWay && not dyn_too_enabled - && enable_object - | otherwise = - hostIsDynamic && not hostIsProfiled && internalInterpreter && - not isDynWay && not isProfWay && not dyn_too_enabled - && enable_object - where - lcl_dflags = ms_hspp_opts ms - internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags) - dyn_too_enabled = gopt Opt_BuildDynamicToo lcl_dflags - isDynWay = hasWay (ways lcl_dflags) WayDyn - isProfWay = hasWay (ways lcl_dflags) WayProf - enable_object = case enable_spec of - EnableByteCode -> False - EnableByteCodeAndObject -> True - EnableObject -> True - -- #16331 - when no "internal interpreter" is available but we -- need to process some TemplateHaskell or QuasiQuotes, we automatically -- turn on -fexternal-interpreter. diff --git a/compiler/GHC/Driver/DynFlags.hs b/compiler/GHC/Driver/DynFlags.hs index f375c8906daf..20928cb51afa 100644 --- a/compiler/GHC/Driver/DynFlags.hs +++ b/compiler/GHC/Driver/DynFlags.hs @@ -22,7 +22,8 @@ module GHC.Driver.DynFlags ( xopt_DuplicateRecordFields, xopt_FieldSelectors, lang_set, - DynamicTooState(..), dynamicTooState, setDynamicNow, + -- Note: DynamicTooState, dynamicTooState, setDynamicNow removed + -- -dynamic-too is deprecated, only dynamic objects are produced OnOff(..), DynFlags(..), ParMakeCount(..), @@ -296,10 +297,7 @@ data DynFlags = DynFlags { dynOutputHi :: Maybe String, dynLibLoader :: DynLibLoader, - dynamicNow :: !Bool, -- ^ Indicate if we are now generating dynamic output - -- because of -dynamic-too. This predicate is - -- used to query the appropriate fields - -- (outputFile/dynOutputFile, ways, etc.) + -- Note: dynamicNow field removed - -dynamic-too is deprecated -- | This defaults to 'non-module'. It can be set by -- 'GHC.Driver.Pipeline.setDumpPrefix' or 'ghc.GHCi.UI.runStmt' based on @@ -618,7 +616,6 @@ defaultDynFlags mySettings = dynObjectSuf_ = "dyn_" ++ phaseInputExt StopLn, dynHiSuf_ = "dyn_hi", - dynamicNow = False, pluginModNames = [], pluginModNameOpts = [], @@ -930,27 +927,8 @@ positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags -- need Template-Haskell and GHC is dynamically linked (cf -- GHC.Driver.Pipeline.compileOne'). -- --- We used to try and fall back from a dynamic-too failure but this feature --- didn't work as expected (#20446) so it was removed to simplify the --- implementation and not obscure latent bugs. - -data DynamicTooState - = DT_Dont -- ^ Don't try to build dynamic objects too - | DT_OK -- ^ Will still try to generate dynamic objects - | DT_Dyn -- ^ Currently generating dynamic objects (in the backend) - deriving (Eq,Show,Ord) - -dynamicTooState :: DynFlags -> DynamicTooState -dynamicTooState dflags - | not (gopt Opt_BuildDynamicToo dflags) = DT_Dont - | dynamicNow dflags = DT_Dyn - | otherwise = DT_OK - -setDynamicNow :: DynFlags -> DynFlags -setDynamicNow dflags0 = - dflags0 - { dynamicNow = True - } +-- Note: DynamicTooState type and dynamicTooState/setDynamicNow functions removed +-- -dynamic-too is deprecated - only dynamic objects are produced now data PkgDbRef = GlobalPkgDb @@ -1011,18 +989,7 @@ dopt_unset :: DynFlags -> DumpFlag -> DynFlags dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) } -- | Test whether a 'GeneralFlag' is set --- --- Note that `dynamicNow` (i.e., dynamic objects built with `-dynamic-too`) --- always implicitly enables Opt_PIC, Opt_ExternalDynamicRefs, and disables --- Opt_SplitSections. --- gopt :: GeneralFlag -> DynFlags -> Bool -gopt Opt_PIC dflags - | dynamicNow dflags = True -gopt Opt_ExternalDynamicRefs dflags - | dynamicNow dflags = True -gopt Opt_SplitSections dflags - | dynamicNow dflags = False gopt f dflags = f `EnumSet.member` generalFlags dflags -- | Set a 'GeneralFlag' @@ -1435,9 +1402,7 @@ languageExtensions (Just GHC2024) LangExt.RoleAnnotations] ways :: DynFlags -> Ways -ways dflags - | dynamicNow dflags = addWay WayDyn (targetWays_ dflags) - | otherwise = targetWays_ dflags +ways dflags = targetWays_ dflags -- | Get target profile targetProfile :: DynFlags -> Profile diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 13e6c87fe93e..29f5df09833a 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -1377,8 +1377,10 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do let force_write_interface = gopt Opt_WriteInterface dflags write_interface = backendWritesFiles (backend dflags) + -- Note: dynamicNow and DynamicTooState removed - -dynamic-too is deprecated + -- We now only write a single .hi file write_iface dflags' iface = - let !iface_name = if dynamicNow dflags' then ml_dyn_hi_file mod_location else ml_hi_file mod_location + let !iface_name = ml_hi_file mod_location profile = targetProfile dflags' in {-# SCC "writeIface" #-} @@ -1389,43 +1391,16 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do if (write_interface || force_write_interface) then do - -- FIXME: with -dynamic-too, "change" is only meaningful for the - -- non-dynamic interface, not for the dynamic one. We should have another - -- flag for the dynamic interface. In the meantime: - -- - -- * when we write a single full interface, we check if we are - -- currently writing the dynamic interface due to -dynamic-too, in - -- which case we ignore "change". - -- - -- * when we write two simple interfaces at once because of - -- dynamic-too, we use "change" both for the non-dynamic and the - -- dynamic interfaces. Hopefully both the dynamic and the non-dynamic - -- interfaces stay in sync... - -- let change = old_iface /= Just (mi_iface_hash iface) - let dt = dynamicTooState dflags - when (logHasDumpFlag logger Opt_D_dump_if_trace) $ putMsg logger $ hang (text "Writing interface(s):") 2 $ vcat [ text "Kind:" <+> if is_simple then text "simple" else text "full" , text "Hash change:" <+> ppr change - , text "DynamicToo state:" <+> text (show dt) ] - if is_simple - then when change $ do -- FIXME: see 'change' comment above - write_iface dflags iface - case dt of - DT_Dont -> return () - DT_Dyn -> panic "Unexpected DT_Dyn state when writing simple interface" - DT_OK -> write_iface (setDynamicNow dflags) iface - else case dt of - DT_Dont | change -> write_iface dflags iface - DT_OK | change -> write_iface dflags iface - -- FIXME: see change' comment above - DT_Dyn -> write_iface dflags iface - _ -> return () + -- Simply write the interface if there was a change + when change $ write_iface dflags iface when (gopt Opt_WriteHie dflags) $ do -- This is slightly hacky. A hie file is considered to be up to date diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs index 0a2be133fa90..dba980dff1b1 100644 --- a/compiler/GHC/Driver/Pipeline.hs +++ b/compiler/GHC/Driver/Pipeline.hs @@ -781,19 +781,9 @@ hscBackendPipeline :: P m => PipeEnv -> HscEnv -> ModSummary -> HscBackendAction hscBackendPipeline pipe_env hsc_env mod_sum result = if backendGeneratesCode (backend (hsc_dflags hsc_env)) then do - res <- hscGenBackendPipeline pipe_env hsc_env mod_sum result - -- Only run dynamic-too if the backend generates object files - -- See Note [Writing interface files] - -- If we are writing a simple interface (not . backendWritesFiles), then - -- hscMaybeWriteIface in the regular pipeline will write both the hi and - -- dyn_hi files. This way we can avoid running the pipeline twice and - -- generating a duplicate linkable. - -- We must not run the backend a second time with `dynamicNow` enable because - -- all the work has already been done in the first pipeline. - when (gopt Opt_BuildDynamicToo (hsc_dflags hsc_env) && backendWritesFiles (backend (hsc_dflags hsc_env)) ) $ do - let dflags' = setDynamicNow (hsc_dflags hsc_env) -- set "dynamicNow" - () <$ hscGenBackendPipeline pipe_env (hscSetFlags dflags' hsc_env) mod_sum result - return res + -- Note: -dynamic-too is deprecated and ignored + -- We no longer run the backend twice - only dynamic objects are produced + hscGenBackendPipeline pipe_env hsc_env mod_sum result else case result of HscUpdate iface -> return (iface, emptyHomeModInfoLinkable) diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs index ce1634512b17..0189905065af 100644 --- a/compiler/GHC/Driver/Pipeline/Execute.hs +++ b/compiler/GHC/Driver/Pipeline/Execute.hs @@ -544,7 +544,8 @@ 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 = if dynamicNow dflags then ml_dyn_obj_file location else ml_obj_file location -- The real object file + -- Note: dynamicNow removed - always use standard object file path + o_file = ml_obj_file location -- The real object file next_phase = hscPostBackendPhase src_flavour (backend dflags) case result of HscUpdate iface -> @@ -887,35 +888,26 @@ getOutputFilename 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 + -- Note: dynamicNow removed - always use standard object file path | StopLn <- next_phase, Just loc <- maybe_location = - return $ if dynamicNow dflags then ml_dyn_obj_file loc - else ml_obj_file loc + return $ ml_obj_file loc -- 2. If output style is persistent then | is_last_phase, Persistent <- output = persistent_fn -- 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. + -- Note: dynamicNow removed - always use standard output file | 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 + return $ 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) $$ - text (fromMaybe "-" (dynOutputFile_ dflags))) + getOutputFile_ dflags' = + case outputFile_ dflags' of + Nothing -> pprPanic "SpecificFile: No filename" (text (fromMaybe "-" (dynOutputFile_ dflags'))) Just fn -> fn hcsuf = hcSuf dflags diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 74850c028b76..16d0c6fa4812 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -41,7 +41,8 @@ module GHC.Driver.Session ( xopt_DuplicateRecordFields, xopt_FieldSelectors, lang_set, - DynamicTooState(..), dynamicTooState, setDynamicNow, + -- Note: DynamicTooState, dynamicTooState, setDynamicNow removed + -- -dynamic-too is deprecated sccProfilingEnabled, needSourceNotes, OnOff(..), @@ -1275,8 +1276,10 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "ddump-file-prefix" (hasArg (setDumpPrefixForce . Just . flip (++) ".")) - , make_ord_flag defGhcFlag "dynamic-too" - (NoArg (setGeneralFlag Opt_BuildDynamicToo)) + -- -dynamic-too is deprecated and ignored - GHC now only produces dynamic objects + , make_dep_flag defGhcFlag "dynamic-too" + (NoArg (return ())) + "-dynamic-too is deprecated and ignored. Use -dynamic instead." ------- Keeping temporary files ------------------------------------- -- These can be singular (think ghc -c) or plural (think ghc --make) @@ -3605,17 +3608,7 @@ makeDynFlagsConsistent :: DynFlags -> (DynFlags, [Warn], [Located SDoc]) -- ensure that a later change doesn't invalidate an earlier check. -- Be careful not to introduce potential loops! makeDynFlagsConsistent dflags - -- Disable -dynamic-too on Windows (#8228, #7134, #5987) - | os == OSMinGW32 && gopt Opt_BuildDynamicToo dflags - = let dflags' = gopt_unset dflags Opt_BuildDynamicToo - warn = "-dynamic-too is not supported on Windows" - in loop dflags' warn - -- Disable -dynamic-too if we are are compiling with -dynamic already, otherwise - -- you get two dynamic object files (.o and .dyn_o). (#20436) - | ways dflags `hasWay` WayDyn && gopt Opt_BuildDynamicToo dflags - = let dflags' = gopt_unset dflags Opt_BuildDynamicToo - warn = "-dynamic-too is ignored when using -dynamic" - in loop dflags' warn + -- Note: -dynamic-too validation removed - flag is now deprecated and ignored | gopt Opt_SplitSections dflags , platformHasSubsectionsViaSymbols (targetPlatform dflags) @@ -3840,15 +3833,13 @@ decodeSize str foreign import ccall unsafe "setHeapSize" setHeapSize :: Int -> IO () foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO () +-- Note: dynamicNow removed - -dynamic-too is deprecated +-- Always use the non-dynamic output file paths outputFile :: DynFlags -> Maybe String -outputFile dflags - | dynamicNow dflags = dynOutputFile_ dflags - | otherwise = outputFile_ dflags +outputFile dflags = outputFile_ dflags objectSuf :: DynFlags -> String -objectSuf dflags - | dynamicNow dflags = dynObjectSuf_ dflags - | otherwise = objectSuf_ dflags +objectSuf dflags = objectSuf_ dflags -- | Pretty-print the difference between 2 DynFlags. -- diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs index 6e05fc64d1c7..8b4dc140b849 100644 --- a/compiler/GHC/Iface/Load.hs +++ b/compiler/GHC/Iface/Load.hs @@ -915,18 +915,14 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do && not (isOneShot (ghcMode dflags)) then return (Failed (HomeModError mod loc)) else do + -- Note: load_dynamic_too_maybe removed - -dynamic-too is deprecated + -- We no longer check for .dyn_hi files r <- read_file hooks logger name_cache unit_state dflags wanted_mod (ml_hi_file loc) case r of Failed err -> return (Failed $ BadIfaceFile err) Succeeded (iface,_fp) - -> do - r2 <- load_dynamic_too_maybe hooks logger name_cache unit_state - (setDynamicNow dflags) wanted_mod - iface loc - case r2 of - Failed sdoc -> return (Failed sdoc) - Succeeded {} -> return $ Succeeded (iface, loc) + -> return $ Succeeded (iface, loc) err -> do trace_if logger (text "...not found") return $ Failed $ cannotFindInterface @@ -936,33 +932,8 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do (moduleName mod) err --- | Check if we need to try the dynamic interface for -dynamic-too -load_dynamic_too_maybe :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags - -> Module -> ModIface -> ModLocation - -> IO (MaybeErr MissingInterfaceError ()) -load_dynamic_too_maybe hooks logger name_cache unit_state dflags wanted_mod iface loc - -- Indefinite interfaces are ALWAYS non-dynamic. - | not (moduleIsDefinite (mi_module iface)) = return (Succeeded ()) - | gopt Opt_BuildDynamicToo dflags = load_dynamic_too hooks logger name_cache unit_state dflags wanted_mod iface loc - | otherwise = return (Succeeded ()) - -load_dynamic_too :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags - -> Module -> ModIface -> ModLocation - -> IO (MaybeErr MissingInterfaceError ()) -load_dynamic_too hooks logger name_cache unit_state dflags wanted_mod iface loc = do - read_file hooks logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case - Succeeded (dynIface, _) - | mi_mod_hash iface == mi_mod_hash dynIface - -> return (Succeeded ()) - | otherwise -> - do return $ (Failed $ DynamicHashMismatchError wanted_mod loc) - Failed err -> - do return $ (Failed $ FailedToLoadDynamicInterface wanted_mod err) - - --((text "Failed to load dynamic interface file for" <+> ppr wanted_mod <> colon) $$ err)) - - - +-- Note: load_dynamic_too_maybe and load_dynamic_too removed +-- -dynamic-too is deprecated - we no longer check for .dyn_hi files read_file :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags -> Module -> FilePath diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs index f8081a21945b..d17944a57098 100644 --- a/compiler/GHC/Iface/Recomp.hs +++ b/compiler/GHC/Iface/Recomp.hs @@ -318,22 +318,12 @@ check_old_iface hsc_env mod_summary maybe_iface Succeeded iface -> do trace_if logger (text "Read the interface file" <+> text iface_path) return $ Just iface + -- Note: check_dyn_hi removed - -dynamic-too is deprecated + -- We no longer check for .dyn_hi files check_dyn_hi :: ModIface -> IfG (MaybeValidated ModIface) -> IfG (MaybeValidated ModIface) - check_dyn_hi normal_iface recomp_check | gopt Opt_BuildDynamicToo dflags = do - res <- recomp_check - case res of - UpToDateItem _ -> do - maybe_dyn_iface <- liftIO $ loadIface (setDynamicNow dflags) (msDynHiFilePath mod_summary) - case maybe_dyn_iface of - Nothing -> return $ outOfDateItemBecause MissingDynHiFile Nothing - Just dyn_iface | mi_iface_hash dyn_iface - /= mi_iface_hash normal_iface - -> return $ outOfDateItemBecause MismatchedDynHiFile Nothing - Just {} -> return res - _ -> return res - check_dyn_hi _ recomp_check = recomp_check + check_dyn_hi _normal_iface recomp_check = recomp_check src_changed @@ -1888,19 +1878,9 @@ mkHashFun hsc_env eps name -- requirements; we didn't do any /real/ typechecking -- so there's no guarantee everything is loaded. -- Kind of a heinous hack. + -- Note: withoutDynamicNow call removed - -dynamic-too is deprecated + -- We no longer need to disable dynamic-too for backpack initIfaceLoad hsc_env . withIfaceErr ctx - $ withoutDynamicNow - -- If you try and load interfaces when dynamic-too - -- enabled then it attempts to load the dyn_hi and hi - -- interface files. Backpack doesn't really care about - -- dynamic object files as it isn't doing any code - -- generation so -dynamic-too is turned off. - -- Some tests fail without doing this (such as T16219), - -- but they fail because dyn_hi files are not found for - -- one of the dependencies (because they are deliberately turned off) - -- Why is this check turned off here? That is unclear but - -- just one of the many horrible hacks in the backpack - -- implementation. $ loadInterface (text "lookupVers2") mod ImportBySystem return $ snd (mi_hash_fn iface occ `orElse` pprPanic "lookupVers1" (ppr mod <+> ppr occ)) diff --git a/compiler/GHC/Linker/Deps.hs b/compiler/GHC/Linker/Deps.hs index 0f36a791b47c..0428592f9474 100644 --- a/compiler/GHC/Linker/Deps.hs +++ b/compiler/GHC/Linker/Deps.hs @@ -51,7 +51,7 @@ import System.Directory data LinkDepsOpts = LinkDepsOpts { ldObjSuffix :: !String -- ^ Suffix of .o files - , ldForceDyn :: !Bool -- ^ Always use .dyn_o? + , ldForceDyn :: !Bool -- ^ Force dynamic loading (legacy, .dyn_o deprecated) , ldUnitEnv :: !UnitEnv , ldPprOpts :: !SDocContext -- ^ Rendering options for error messages , ldUseByteCode :: !Bool -- ^ Use bytecode rather than objects @@ -239,9 +239,8 @@ throwProgramError opts doc = throwGhcExceptionIO (ProgramError (renderWithContex checkNonStdWay :: LinkDepsOpts -> Interp -> SrcSpan -> IO (Maybe FilePath) checkNonStdWay _opts interp _srcspan -- On some targets (e.g. wasm) the RTS linker only supports loading - -- dynamic code, in which case we need to ensure the .dyn_o object - -- is picked (instead of .o which is also present because of - -- -dynamic-too) + -- dynamic code. Note: -dynamic-too is deprecated, so .dyn_o is no + -- longer produced. Dynamic objects are now just .o files. | ldForceDyn _opts = do let target_ways = fullWays $ ldWays _opts pure $ if target_ways `hasWay` WayDyn diff --git a/compiler/GHC/Linker/Loader.hs b/compiler/GHC/Linker/Loader.hs index 36d70d5c711a..24be6136aea3 100644 --- a/compiler/GHC/Linker/Loader.hs +++ b/compiler/GHC/Linker/Loader.hs @@ -1422,7 +1422,9 @@ locateLib interp hsc_env is_hs lib_dirs gcc_dirs lib0 obj_file | is_hs && loading_profiled_hs_libs = lib <.> "p_o" | otherwise = lib <.> "o" - dyn_obj_file = lib <.> "dyn_o" + -- Note: -dynamic-too is deprecated - .dyn_o files no longer produced + -- dyn_obj_file now same as obj_file + dyn_obj_file = obj_file arch_files | verbatim = [lib] | otherwise = [ "lib" ++ lib ++ lib_tag <.> "a" diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index 088b9f9a3320..b7ccf8df07f3 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -25,7 +25,7 @@ module GHC.Tc.Utils.Monad( whenDOptM, whenGOptM, whenWOptM, whenXOptM, unlessXOptM, getGhcMode, - withoutDynamicNow, + -- Note: withoutDynamicNow removed - -dynamic-too is deprecated getEpsVar, getEps, updateEps, updateEps_, @@ -624,8 +624,8 @@ unlessXOptM flag thing_inside = do b <- xoptM flag getGhcMode :: TcRnIf gbl lcl GhcMode getGhcMode = ghcMode <$> getDynFlags -withoutDynamicNow :: TcRnIf gbl lcl a -> TcRnIf gbl lcl a -withoutDynamicNow = updTopFlags (\dflags -> dflags { dynamicNow = False}) +-- Note: withoutDynamicNow removed - -dynamic-too is deprecated +-- This function was used to disable dynamic-too mode, which no longer exists updTopFlags :: (DynFlags -> DynFlags) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a updTopFlags f = updTopEnv (hscUpdateFlags f) diff --git a/compiler/GHC/Unit/Finder.hs b/compiler/GHC/Unit/Finder.hs index cb91559cfee3..b2e0f872ffd6 100644 --- a/compiler/GHC/Unit/Finder.hs +++ b/compiler/GHC/Unit/Finder.hs @@ -649,22 +649,24 @@ mkHomeModHiOnlyLocation fopts mod path basename = -- This function is used to make a ModLocation for a package module. Hence why -- we explicitly pass in the interface file suffixes. +-- Note: -dynamic-too is deprecated - dynhisuf parameter kept for API compat +-- but now dyn paths are same as non-dyn paths mkHiOnlyModLocation :: FinderOpts -> FileExt -> FileExt -> OsPath -> OsPath -> ModLocation -mkHiOnlyModLocation fopts hisuf dynhisuf path basename +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 + hi_fn = full_basename <.> hisuf in OsPathModLocation{ ml_hs_file_ospath = Nothing, - ml_hi_file_ospath = full_basename <.> hisuf, + ml_hi_file_ospath = hi_fn, -- 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_ospath = dyn_obj_fn, - -- MP: TODO - ml_dyn_hi_file_ospath = full_basename <.> dynhisuf, + ml_dyn_hi_file_ospath = hi_fn, -- Same as non-dyn ml_obj_file_ospath = obj_fn, ml_hie_file_ospath = hie_fn } @@ -686,18 +688,13 @@ mkObjPath fopts basename mod_basename = obj_basename <.> osuf -- | Constructs the filename of a .dyn_o file for a given source file. -- Does /not/ check whether the .dyn_o file exists +-- Note: -dynamic-too is deprecated - now returns same path as mkObjPath mkDynObjPath :: FinderOpts -> OsPath -- the filename of the source file, minus the extension -> OsPath -- the module name with dots replaced by slashes -> OsPath -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 +mkDynObjPath fopts basename mod_basename = mkObjPath fopts basename mod_basename -- | Constructs the filename of a .hi file for a given source file. @@ -717,18 +714,13 @@ mkHiPath fopts basename mod_basename = hi_basename <.> hisuf -- | Constructs the filename of a .dyn_hi file for a given source file. -- Does /not/ check whether the .dyn_hi file exists +-- Note: -dynamic-too is deprecated - now returns same path as mkHiPath mkDynHiPath :: FinderOpts -> OsPath -- the filename of the source file, minus the extension -> OsPath -- the module name with dots replaced by slashes -> OsPath -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 +mkDynHiPath fopts basename mod_basename = mkHiPath fopts basename mod_basename -- | Constructs the filename of a .hie file for a given source file. -- Does /not/ check whether the .hie file exists