[Git][ghc/ghc][master] 5 commits: hadrian: Dump STG when ticky is enabled
Marge Bot
gitlab at gitlab.haskell.org
Sun Nov 22 17:39:45 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00
hadrian: Dump STG when ticky is enabled
This changes the "ticky" modifier to enable dumping of final STG as this
is generally needed to make sense of the ticky profiles.
- - - - -
d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00
hadrian: Introduce notion of flavour transformers
This extends Hadrian's notion of "flavour", as described in #18942.
- - - - -
179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00
hadrian: Add a viaLlvmBackend modifier
Note that this also slightly changes the semantics of these flavours as
we only use LLVM for >= stage1 builds.
- - - - -
d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00
hadrian: Add profiled_ghc and no_dynamic_ghc modifiers
- - - - -
6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00
hadrian: Drop redundant flavour definitions
Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as
these can now be realized with flavour transformers.
- - - - -
7 changed files:
- hadrian/doc/flavours.md
- hadrian/hadrian.cabal
- hadrian/src/Flavour.hs
- hadrian/src/Settings.hs
- − hadrian/src/Settings/Flavours/Llvm.hs
- − hadrian/src/Settings/Flavours/Profiled.hs
- − hadrian/src/Settings/Flavours/ThreadSanitizer.hs
Changes:
=====================================
hadrian/doc/flavours.md
=====================================
@@ -99,16 +99,6 @@ when compiling the `compiler` library, and `hsGhc` when compiling/linking the GH
<td>-O</td>
<td>-O2</td>
</tr>
- <tr>
- <th>prof</td>
- <td>-O0<br>-H64m</td>
- <td>-O0<br>-H64m</td>
- <td></td>
- <td>-O</td>
- <td>-O2</td>
- <td>-O</td>
- <td>-O</td>
- </tr>
<tr>
<th>bench</td>
<td>-O<br>-H64m</td>
@@ -166,13 +156,66 @@ when compiling the `compiler` library, and `hsGhc` when compiling/linking the GH
</tr>
</table>
-### LLVM variants
+## Flavour transformers
-In addition to the above, there are LLVM variants for the flavours `quick`,
-`prof`, `perf` and `bench`, available by appending a `-llvm` suffix (i.e.,
-`quick-llvm` for the LLVM variant of `quick`). These differ only in that there
-is an additional `-fllvm` flag in `hsDefault` when the stage0 compiler is GHC.
-See `src/Settings/Flavours/Llvm.hs` for details.
+Each of the flavours described above is intended as a starting-point for
+configuring your GHC build. In addition, Hadrian supports a number of "flavour
+transformers" which modify the configuration in various ways.
+
+These can be appended to the flavour name passed via the `--flavour`
+command-line flag, separated by the `+` character. For instance,
+
+```
+hadrian --flavour=perf+thread_sanitizer
+```
+
+The supported transformers are listed below:
+
+<table>
+ <tr>
+ <th>Transformer name</th>
+ <th>Effect</th>
+ </tr>
+ <tr>
+ <td><code>werror</code></td>
+ <td>Use the `-Werror` flag for all stage1+ compilation.</td>
+ </tr>
+ <tr>
+ <td><code>debug_info</code></td>
+ <td>Enable production of native debugging information (via GHC/GCC's `-g3`)
+ during stage1+ compilations.</td>
+ </tr>
+ <tr>
+ <td><code>ticky_ghc</code></td>
+ <td>Compile the GHC executable with Ticky-Ticky profiler support.</td>
+ </tr>
+ <tr>
+ <td><code>split_sections</code></td>
+ <td>Enable section splitting for all libraries (except for the GHC
+ library due to the long linking times that this causes).</td>
+ </tr>
+ <tr>
+ <td><code>thread_sanitizer</code></td>
+ <td>Build the runtime system with ThreadSanitizer support</td>
+ </tr>
+ <tr>
+ <td><code>llvm</code></td>
+ <td>Use GHC's LLVM backend (`-fllvm`) for all stage1+ compilation.</td>
+ </tr>
+ <tr>
+ <td><code>profiled_ghc</code></td>
+ <td>Build the GHC executable with cost-centre profiling support.
+ It is that you use this in conjunction with `no_dynamic_ghc` since
+ GHC does not It is support loading of profiled libraries with the
+ dynamically-linker.</td>
+ </tr>
+ <tr>
+ <td><code>no_dynamic_ghc</code></td>
+ <td>Linked GHC against the statically-linked RTS. This causes GHC to
+ default to loading static rather than dynamic library when,
+ e.g., loading libraries during TemplateHaskell evaluations.</td>
+ </tr>
+</table>
## Ways
@@ -184,7 +227,6 @@ information. The following table lists ways that are built in different flavours
<th rowspan="2">Flavour</th>
<th colspan="2">Library ways</th>
<th colspan="2">RTS ways</th>
- <th colspan="2">Profiled GHC</th>
</tr>
<tr>
<th>stage0</th>
@@ -195,7 +237,7 @@ information. The following table lists ways that are built in different flavours
<th>stage1+</th>
</tr>
<tr>
- <th>default<br>perf<br>prof<br>devel1<br>devel2<br>perf-llvm<br>prof-llvm</td>
+ <th>default<br>perf<br>prof<br>devel1<br>devel2</td>
<td>vanilla</td>
<td>vanilla<br>profiling<br>dynamic</td>
<td>logging<br>debug<br>threaded<br>threadedDebug<br>threadedLogging
@@ -208,11 +250,9 @@ information. The following table lists ways that are built in different flavours
<br>debugDynamic<br>threadedDynamic<br>threadedDebugDynamic
<br>loggingDynamic<br>threadedLoggingDynamic
</td>
- <td>Only in<br>prof<br>flavour</td>
- <td>Only in<br>prof<br>flavour</td>
</tr>
<tr>
- <th>quick<br>quick-llvm<br>quick-validate<br>quick-debug</th>
+ <th>quick<br>quick-validate<br>quick-debug</th>
<td>vanilla</td>
<td>vanilla<br>dynamic</td>
<td>logging<br>debug<br>threaded<br>threadedDebug<br>threadedLogging
@@ -223,8 +263,6 @@ information. The following table lists ways that are built in different flavours
<br>debugDynamic<br>threadedDynamic<br>threadedDebugDynamic
<br>loggingDynamic<br>threadedLoggingDynamic
</td>
- <td>No</td>
- <td>No</td>
</tr>
<tr>
<th>quickest<br>bench</th>
@@ -232,7 +270,5 @@ information. The following table lists ways that are built in different flavours
<td>vanilla</td>
<td>vanilla<br>threaded</td>
<td>vanilla<br>threaded</td>
- <td>No</td>
- <td>No</td>
</tr>
</table>
=====================================
hadrian/hadrian.cabal
=====================================
@@ -106,13 +106,10 @@ executable hadrian
, Settings.Flavours.Benchmark
, Settings.Flavours.Development
, Settings.Flavours.GhcInGhci
- , Settings.Flavours.Llvm
, Settings.Flavours.Performance
- , Settings.Flavours.Profiled
, Settings.Flavours.Quick
, Settings.Flavours.QuickCross
, Settings.Flavours.Quickest
- , Settings.Flavours.ThreadSanitizer
, Settings.Flavours.Validate
, Settings.Packages
, Settings.Parser
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -1,17 +1,28 @@
module Flavour
( Flavour (..), werror
, DocTargets, DocTarget(..)
+ , parseFlavour
-- * Flavour transformers
+ , flavourTransformers
, addArgs
, splitSections, splitSectionsIf
, enableThreadSanitizer
, enableDebugInfo, enableTickyGhc
+ , viaLlvmBackend
+ , enableProfiledGhc
+ , disableDynamicGhcPrograms
) where
import Expression
import Data.Set (Set)
+import Data.Map (Map)
+import qualified Data.Map as M
import Packages
+import Text.Parsec.Prim as P
+import Text.Parsec.Combinator as P
+import Text.Parsec.Char as P
+
-- Please update doc/{flavours.md, user-settings.md} when changing this file.
-- | 'Flavour' is a collection of build settings that fully define a GHC build.
-- Note the following type semantics:
@@ -69,6 +80,58 @@ type DocTargets = Set DocTarget
data DocTarget = Haddocks | SphinxHTML | SphinxPDFs | SphinxMan | SphinxInfo
deriving (Eq, Ord, Show, Bounded, Enum)
+flavourTransformers :: Map String (Flavour -> Flavour)
+flavourTransformers = M.fromList
+ [ "werror" =: werror
+ , "debug_info" =: enableDebugInfo
+ , "ticky_ghc" =: enableTickyGhc
+ , "split_sections" =: splitSections
+ , "thread_sanitizer" =: enableThreadSanitizer
+ , "llvm" =: viaLlvmBackend
+ , "profiled_ghc" =: enableProfiledGhc
+ , "no_dynamic_ghc" =: disableDynamicGhcPrograms
+ ]
+ where (=:) = (,)
+
+type Parser = Parsec String ()
+
+parseFlavour :: [Flavour] -- ^ base flavours
+ -> Map String (Flavour -> Flavour) -- ^ modifiers
+ -> String
+ -> Either String Flavour
+parseFlavour baseFlavours transformers str =
+ case P.runParser parser () "" str of
+ Left perr -> Left $ unlines $
+ [ "error parsing flavour specifier: " ++ show perr
+ , ""
+ , "known flavours:"
+ ] ++
+ [ " " ++ name f | f <- baseFlavours ] ++
+ [ ""
+ , "known flavour transformers:"
+ ] ++
+ [ " " ++ nm | nm <- M.keys transformers ]
+ Right f -> Right f
+ where
+ parser :: Parser Flavour
+ parser = do
+ base <- baseFlavour
+ transs <- P.many flavourTrans
+ return $ foldr ($) base transs
+
+ baseFlavour :: Parser Flavour
+ baseFlavour =
+ P.choice [ f <$ P.try (P.string (name f))
+ | f <- baseFlavours
+ ]
+
+ flavourTrans :: Parser (Flavour -> Flavour)
+ flavourTrans = do
+ void $ P.char '+'
+ P.choice [ trans <$ P.try (P.string nm)
+ | (nm, trans) <- M.toList transformers
+ ]
+
-- | Add arguments to the 'args' of a 'Flavour'.
addArgs :: Args -> Flavour -> Flavour
addArgs args' fl = fl { args = args fl <> args' }
@@ -96,7 +159,13 @@ enableTickyGhc =
[ builder (Ghc CompileHs) ? ticky
, builder (Ghc LinkHs) ? ticky
]
- ticky = arg "-ticky" <> arg "-ticky-allocd"
+ ticky = mconcat
+ [ arg "-ticky"
+ , arg "-ticky-allocd"
+ -- You generally need STG dumps to interpret ticky profiles
+ , arg "-ddump-to-file"
+ , arg "-ddump-stg-final"
+ ]
-- | Transform the input 'Flavour' so as to build with
-- @-split-sections@ whenever appropriate. You can
@@ -128,3 +197,17 @@ enableThreadSanitizer = addArgs $ mconcat
, builder (Cabal Flags) ? arg "thread-sanitizer"
, builder RunTest ? arg "--config=have_thread_sanitizer=True"
]
+
+-- | Use the LLVM backend in stages 1 and later.
+viaLlvmBackend :: Flavour -> Flavour
+viaLlvmBackend = addArgs $ notStage0 ? builder Ghc ? arg "-fllvm"
+
+-- | Build the GHC executable with profiling enabled. It is also recommended
+-- that you use this with @'dynamicGhcPrograms' = False@ since GHC does not
+-- support loading of profiled libraries with the dynamically-linker.
+enableProfiledGhc :: Flavour -> Flavour
+enableProfiledGhc flavour = flavour { ghcProfiled = True }
+
+-- | Disable 'dynamicGhcPrograms'.
+disableDynamicGhcPrograms :: Flavour -> Flavour
+disableDynamicGhcPrograms flavour = flavour { dynamicGhcPrograms = pure False }
=====================================
hadrian/src/Settings.hs
=====================================
@@ -15,13 +15,10 @@ import {-# SOURCE #-} Settings.Default
import Settings.Flavours.Benchmark
import Settings.Flavours.Development
import Settings.Flavours.GhcInGhci
-import Settings.Flavours.Llvm
import Settings.Flavours.Performance
-import Settings.Flavours.Profiled
import Settings.Flavours.Quick
import Settings.Flavours.Quickest
import Settings.Flavours.QuickCross
-import Settings.Flavours.ThreadSanitizer
import Settings.Flavours.Validate
import Control.Monad.Except
@@ -54,13 +51,11 @@ stagePackages stage = do
hadrianFlavours :: [Flavour]
hadrianFlavours =
[ benchmarkFlavour, defaultFlavour, developmentFlavour Stage1
- , developmentFlavour Stage2, performanceFlavour, profiledFlavour
+ , developmentFlavour Stage2, performanceFlavour
, quickFlavour, quickValidateFlavour, quickDebugFlavour
, quickestFlavour
- , quickCrossFlavour, benchmarkLlvmFlavour
- , performanceLlvmFlavour, profiledLlvmFlavour, quickLlvmFlavour
- , ghcInGhciFlavour, validateFlavour, slowValidateFlavour
- , threadSanitizerFlavour ]
+ , quickCrossFlavour
+ , ghcInGhciFlavour, validateFlavour, slowValidateFlavour ]
-- | This action looks up a flavour with the name given on the
-- command line with @--flavour@, defaulting to 'userDefaultFlavour'
@@ -75,11 +70,9 @@ flavour = do
let flavours = hadrianFlavours ++ userFlavours
(_settingErrs, tweak) = applySettings kvs
- return $
- case filter (\fl -> name fl == flavourName) flavours of
- [] -> error $ "Unknown build flavour: " ++ flavourName
- [f] -> tweak f
- _ -> error $ "Multiple build flavours named " ++ flavourName
+ case parseFlavour flavours flavourTransformers flavourName of
+ Left err -> fail err
+ Right f -> return $ tweak f
-- TODO: switch to Set Package as the order of packages should not matter?
-- Otherwise we have to keep remembering to sort packages from time to time.
=====================================
hadrian/src/Settings/Flavours/Llvm.hs deleted
=====================================
@@ -1,29 +0,0 @@
-module Settings.Flavours.Llvm (
- benchmarkLlvmFlavour,
- performanceLlvmFlavour,
- profiledLlvmFlavour,
- quickLlvmFlavour,
-) where
-
-import Expression
-import Flavour
-
-import Settings.Flavours.Benchmark
-import Settings.Flavours.Performance
-import Settings.Flavours.Profiled
-import Settings.Flavours.Quick
-
--- Please update doc/flavours.md when changing this file.
-benchmarkLlvmFlavour, performanceLlvmFlavour, profiledLlvmFlavour, quickLlvmFlavour :: Flavour
-benchmarkLlvmFlavour = mkLlvmFlavour benchmarkFlavour
-performanceLlvmFlavour = mkLlvmFlavour performanceFlavour
-profiledLlvmFlavour = mkLlvmFlavour profiledFlavour
-quickLlvmFlavour = mkLlvmFlavour quickFlavour
-
--- | Turn a flavour into an LLVM flavour
-mkLlvmFlavour :: Flavour -> Flavour
-mkLlvmFlavour flav = flav
- { name = name flav ++ "-llvm"
- , args = mconcat [ args flav
- , builder Ghc ? arg "-fllvm" ]
- }
=====================================
hadrian/src/Settings/Flavours/Profiled.hs deleted
=====================================
@@ -1,22 +0,0 @@
-module Settings.Flavours.Profiled (profiledFlavour) where
-
-import Expression
-import Flavour
-import {-# SOURCE #-} Settings.Default
-
--- Please update doc/flavours.md when changing this file.
-profiledFlavour :: Flavour
-profiledFlavour = defaultFlavour
- { name = "prof"
- , args = defaultBuilderArgs <> profiledArgs <> defaultPackageArgs
- , ghcProfiled = True
- , dynamicGhcPrograms = pure False }
-
-profiledArgs :: Args
-profiledArgs = sourceArgs SourceArgs
- { hsDefault = mconcat
- [ pure ["-O0", "-H64m"]
- ]
- , hsLibrary = notStage0 ? arg "-O"
- , hsCompiler = mconcat [stage0 ? arg "-O2", notStage0 ? arg "-O"]
- , hsGhc = arg "-O" }
=====================================
hadrian/src/Settings/Flavours/ThreadSanitizer.hs deleted
=====================================
@@ -1,9 +0,0 @@
-module Settings.Flavours.ThreadSanitizer (threadSanitizerFlavour) where
-
-import Flavour
-import Settings.Flavours.Validate
-
-threadSanitizerFlavour :: Flavour
-threadSanitizerFlavour =
- enableThreadSanitizer (validateFlavour
- { name = "thread-sanitizer" })
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/901bc2208a115e0f8313b3aa9abc76fd05509aaa...6815603f271484766425ff2e37043b78da2d073c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/901bc2208a115e0f8313b3aa9abc76fd05509aaa...6815603f271484766425ff2e37043b78da2d073c
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201122/1c5c6ae4/attachment-0001.html>
More information about the ghc-commits
mailing list