diff options
| -rw-r--r-- | compiler/main/DriverPipeline.hs | 4 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 23 | ||||
| -rw-r--r-- | compiler/main/HscMain.hs | 2 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnMonad.lhs | 2 |
4 files changed, 16 insertions, 15 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 26425ae29b..aa49e70eb7 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -583,7 +583,7 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase) when isHaskellishFile $ whenCannotGenerateDynamicToo dflags $ do debugTraceMsg dflags 4 (text "Running the pipeline again for -dynamic-too") - let dflags' = doDynamicToo dflags + let dflags' = dynamicTooMkDynamicDynFlags dflags hsc_env' <- newHscEnv dflags' _ <- runPipeline' start_phase hsc_env' env input_fn maybe_loc maybe_stub_o @@ -724,7 +724,7 @@ pipeLoop phase input_fn = do case phase of HscOut {} -> whenGeneratingDynamicToo dflags $ do - setDynFlags $ doDynamicToo dflags + setDynFlags $ dynamicTooMkDynamicDynFlags dflags -- TODO shouldn't ignore result: _ <- pipeLoop phase input_fn return () diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index d559bb403e..975ffecf05 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -32,7 +32,7 @@ module DynFlags ( lang_set, whenGeneratingDynamicToo, ifGeneratingDynamicToo, whenCannotGenerateDynamicToo, - doDynamicToo, + dynamicTooMkDynamicDynFlags, DynFlags(..), HasDynFlags(..), ContainsDynFlags(..), RtsOptsEnabled(..), @@ -1176,16 +1176,17 @@ generateDynamicTooConditional dflags canGen cannotGen notTryingToGen if b then canGen else cannotGen else notTryingToGen -doDynamicToo :: DynFlags -> DynFlags -doDynamicToo dflags0 = let dflags1 = addWay' WayDyn dflags0 - dflags2 = dflags1 { - outputFile = dynOutputFile dflags1, - hiSuf = dynHiSuf dflags1, - objectSuf = dynObjectSuf dflags1 - } - dflags3 = updateWays dflags2 - dflags4 = gopt_unset dflags3 Opt_BuildDynamicToo - in dflags4 +dynamicTooMkDynamicDynFlags :: DynFlags -> DynFlags +dynamicTooMkDynamicDynFlags dflags0 + = let dflags1 = addWay' WayDyn dflags0 + dflags2 = dflags1 { + outputFile = dynOutputFile dflags1, + hiSuf = dynHiSuf dflags1, + objectSuf = dynObjectSuf dflags1 + } + dflags3 = updateWays dflags2 + dflags4 = gopt_unset dflags3 Opt_BuildDynamicToo + in dflags4 ----------------------------------------------------------------------------- diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 2c2df87b7c..e884fe5bcf 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -1135,7 +1135,7 @@ hscWriteIface dflags iface no_change mod_summary = do -- TODO: Should handle the dynamic hi filename properly let dynIfaceFile = replaceExtension ifaceFile (dynHiSuf dflags) dynIfaceFile' = addBootSuffix_maybe (mi_boot iface) dynIfaceFile - dynDflags = doDynamicToo dflags + dynDflags = dynamicTooMkDynamicDynFlags dflags writeIfaceFile dynDflags dynIfaceFile' iface -- | Compile to hard-code. diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index cd164b9ccb..84dcecfcf8 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -313,7 +313,7 @@ getGhcMode = do { env <- getTopEnv; return (ghcMode (hsc_dflags env)) } withDoDynamicToo :: TcRnIf gbl lcl a -> TcRnIf gbl lcl a withDoDynamicToo m = do env <- getEnv let dflags = extractDynFlags env - dflags' = doDynamicToo dflags + dflags' = dynamicTooMkDynamicDynFlags dflags env' = replaceDynFlags env dflags' setEnv env' m \end{code} |