diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2020-03-17 15:32:32 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-05-01 10:37:39 -0400 |
| commit | f8386c7b6a9d26bc5fd2c1d74d944c8df6337690 (patch) | |
| tree | 2160d6880a430f07f4a0ac7a58b0355afe139649 /compiler/GHC/SysTools | |
| parent | 780de9e11014a88a4f676eb296c30fec2b07b5c2 (diff) | |
| download | haskell-f8386c7b6a9d26bc5fd2c1d74d944c8df6337690.tar.gz | |
Refactor PprDebug handling
If `-dppr-debug` is set, then PprUser and PprDump styles are silently
replaced with PprDebug style. This was done in `mkUserStyle` and
`mkDumpStyle` smart constructors. As a consequence they needed a
DynFlags parameter.
Now we keep the original PprUser and PprDump styles until they are used
to create an `SDocContext`. I.e. the substitution is only performed in
`initSDocContext`.
Diffstat (limited to 'compiler/GHC/SysTools')
| -rw-r--r-- | compiler/GHC/SysTools/ExtraObj.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/SysTools/Process.hs | 4 |
2 files changed, 3 insertions, 3 deletions
diff --git a/compiler/GHC/SysTools/ExtraObj.hs b/compiler/GHC/SysTools/ExtraObj.hs index 7901a318b8..3d12158b5c 100644 --- a/compiler/GHC/SysTools/ExtraObj.hs +++ b/compiler/GHC/SysTools/ExtraObj.hs @@ -77,7 +77,7 @@ mkExtraObjToLinkIntoBinary :: DynFlags -> IO FilePath mkExtraObjToLinkIntoBinary dflags = do when (gopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $ do putLogMsg dflags NoReason SevInfo noSrcSpan - (defaultUserStyle dflags) + defaultUserStyle (text "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main." $$ text " Call hs_init_ghc() from your main() function to set these options.") diff --git a/compiler/GHC/SysTools/Process.hs b/compiler/GHC/SysTools/Process.hs index 83547ab06c..5482a4ef25 100644 --- a/compiler/GHC/SysTools/Process.hs +++ b/compiler/GHC/SysTools/Process.hs @@ -282,11 +282,11 @@ builderMainLoop dflags filter_fn pgm real_args mb_cwd mb_env = do case msg of BuildMsg msg -> do putLogMsg dflags NoReason SevInfo noSrcSpan - (defaultUserStyle dflags) msg + defaultUserStyle msg log_loop chan t BuildError loc msg -> do putLogMsg dflags NoReason SevError (mkSrcSpan loc loc) - (defaultUserStyle dflags) msg + defaultUserStyle msg log_loop chan t EOF -> log_loop chan (t-1) |