diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2020-03-16 15:44:15 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-04-21 06:39:32 -0400 |
| commit | ce5c2999d2e356d034fbf1045a2383c0ac24f15f (patch) | |
| tree | 49116d1a35f39c6c9567d5d281f947037e52f2be | |
| parent | 35e43d48a9a3ab22da90c4c2ea2c805fe762b9c5 (diff) | |
| download | haskell-ce5c2999d2e356d034fbf1045a2383c0ac24f15f.tar.gz | |
Avoid using sdocWithDynFlags (#17957)
Remove one use of `sdocWithDynFlags` from `GHC.CmmToLlvm.llvmCodeGen'`
and from `GHC.Driver.CodeOutput.profilingInitCode`
| -rw-r--r-- | compiler/GHC/CmmToLlvm.hs | 18 | ||||
| -rw-r--r-- | compiler/GHC/Driver/CodeOutput.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Main.hs | 2 |
3 files changed, 13 insertions, 14 deletions
diff --git a/compiler/GHC/CmmToLlvm.hs b/compiler/GHC/CmmToLlvm.hs index 77a4f00035..ea69809c13 100644 --- a/compiler/GHC/CmmToLlvm.hs +++ b/compiler/GHC/CmmToLlvm.hs @@ -75,14 +75,14 @@ llvmCodeGen dflags h cmm_stream -- run code generation a <- runLlvm dflags (fromMaybe supportedLlvmVersion mb_ver) bufh $ - llvmCodeGen' (liftStream cmm_stream) + llvmCodeGen' dflags (liftStream cmm_stream) bFlush bufh return a -llvmCodeGen' :: Stream.Stream LlvmM RawCmmGroup a -> LlvmM a -llvmCodeGen' cmm_stream +llvmCodeGen' :: DynFlags -> Stream.Stream LlvmM RawCmmGroup a -> LlvmM a +llvmCodeGen' dflags cmm_stream = do -- Preamble renderLlvm header ghcInternalFunctions @@ -100,19 +100,19 @@ llvmCodeGen' cmm_stream return a where header :: SDoc - header = sdocWithDynFlags $ \dflags -> + header = let target = platformMisc_llvmTarget $ platformMisc dflags - in text ("target datalayout = \"" ++ getDataLayout dflags target ++ "\"") + in text ("target datalayout = \"" ++ getDataLayout (llvmConfig dflags) target ++ "\"") $+$ text ("target triple = \"" ++ target ++ "\"") - getDataLayout :: DynFlags -> String -> String - getDataLayout dflags target = - case lookup target (llvmTargets $ llvmConfig dflags) of + getDataLayout :: LlvmConfig -> String -> String + getDataLayout config target = + case lookup target (llvmTargets config) of Just (LlvmTarget {lDataLayout=dl}) -> dl Nothing -> pprPanic "Failed to lookup LLVM data layout" $ text "Target:" <+> text target $$ hang (text "Available targets:") 4 - (vcat $ map (text . fst) $ llvmTargets $ llvmConfig dflags) + (vcat $ map (text . fst) $ llvmTargets config) llvmGroupLlvmGens :: RawCmmGroup -> LlvmM () llvmGroupLlvmGens cmm = do diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs index f87661846e..3bce0db86d 100644 --- a/compiler/GHC/Driver/CodeOutput.hs +++ b/compiler/GHC/Driver/CodeOutput.hs @@ -277,10 +277,9 @@ outputForeignStubs_help fname doc_str header footer -- module; -- | Generate code to initialise cost centres -profilingInitCode :: Module -> CollectedCCs -> SDoc -profilingInitCode this_mod (local_CCs, singleton_CCSs) - = sdocWithDynFlags $ \dflags -> - if not (gopt Opt_SccProfilingOn dflags) +profilingInitCode :: DynFlags -> Module -> CollectedCCs -> SDoc +profilingInitCode dflags this_mod (local_CCs, singleton_CCSs) + = if not (gopt Opt_SccProfilingOn dflags) then empty else vcat $ map emit_cc_decl local_CCs diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 2b5dfb2b11..caa18d6670 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -1420,7 +1420,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do let cost_centre_info = (S.toList local_ccs ++ caf_ccs, caf_cc_stacks) - prof_init = profilingInitCode this_mod cost_centre_info + prof_init = profilingInitCode dflags this_mod cost_centre_info foreign_stubs = foreign_stubs0 `appendStubC` prof_init ------------------ Code generation ------------------ |