diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2022-05-13 11:12:02 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-05-17 07:16:39 -0400 |
| commit | eccdb2080ea80df6510098f2e58046bc20efe19a (patch) | |
| tree | 96d3c33462079a7a0fb5c85e06943c5202631194 | |
| parent | 5f6527e05beb628c5015ab9f8a7f4012ee8d14a1 (diff) | |
| download | haskell-eccdb2080ea80df6510098f2e58046bc20efe19a.tar.gz | |
Adjust flags for pprTrace
We were using defaultSDocContext for pprTrace, which suppresses
lots of useful infomation. This small MR adds
GHC.Utils.Outputable.traceSDocContext
and uses it for pprTrace and pprTraceUserWarning.
traceSDocContext is a global, and hence not influenced by flags,
but that seems unavoidable. But I made the sdocPprDebug bit
controlled by unsafeHasPprDebug, since we have the latter for
exactly this purpose.
Fixes #21569
| -rw-r--r-- | compiler/GHC/Utils/Outputable.hs | 16 | ||||
| -rw-r--r-- | compiler/GHC/Utils/Trace.hs | 6 |
2 files changed, 18 insertions, 4 deletions
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs index f424076e04..032c8502f8 100644 --- a/compiler/GHC/Utils/Outputable.hs +++ b/compiler/GHC/Utils/Outputable.hs @@ -90,7 +90,8 @@ module GHC.Utils.Outputable ( QualifyName(..), queryQual, sdocOption, updSDocContext, - SDocContext (..), sdocWithContext, defaultSDocContext, + SDocContext (..), sdocWithContext, + defaultSDocContext, traceSDocContext, getPprStyle, withPprStyle, setStyleColoured, pprDeeper, pprDeeperList, pprSetDepth, codeStyle, userStyle, dumpStyle, asmStyle, @@ -116,6 +117,7 @@ import qualified GHC.Utils.Ppr.Colour as Col import GHC.Utils.Ppr ( Doc, Mode(..) ) import GHC.Serialized import GHC.LanguageExtensions (Extension) +import GHC.Utils.GlobalVars( unsafeHasPprDebug ) import Data.ByteString (ByteString) import qualified Data.ByteString as BS @@ -450,6 +452,18 @@ defaultSDocContext = SDC , sdocUnitIdForUser = ftext } +traceSDocContext :: SDocContext +-- Used for pprTrace, when we want to see lots of info +traceSDocContext = defaultSDocContext + { sdocPprDebug = unsafeHasPprDebug + , sdocPrintTypecheckerElaboration = True + , sdocPrintExplicitKinds = True + , sdocPrintExplicitCoercions = True + , sdocPrintExplicitRuntimeReps = True + , sdocPrintExplicitForalls = True + , sdocPrintEqualityRelations = True + } + withPprStyle :: PprStyle -> SDoc -> SDoc {-# INLINE CONLIKE withPprStyle #-} withPprStyle sty d = SDoc $ \ctxt -> runSDoc d ctxt{sdocStyle=sty} diff --git a/compiler/GHC/Utils/Trace.hs b/compiler/GHC/Utils/Trace.hs index cc5c69abb7..c5f07df248 100644 --- a/compiler/GHC/Utils/Trace.hs +++ b/compiler/GHC/Utils/Trace.hs @@ -28,7 +28,7 @@ import Control.Monad.IO.Class pprTrace :: String -> SDoc -> a -> a pprTrace str doc x | unsafeHasNoDebugOutput = x - | otherwise = pprDebugAndThen defaultSDocContext trace (text str) doc x + | otherwise = pprDebugAndThen traceSDocContext trace (text str) doc x pprTraceM :: Applicative f => String -> SDoc -> f () pprTraceM str doc = pprTrace str doc (pure ()) @@ -69,7 +69,7 @@ warnPprTrace _ _s _ x | not debugIsOn = x warnPprTrace _ _s _msg x | unsafeHasNoDebugOutput = x warnPprTrace False _s _msg x = x warnPprTrace True s msg x - = pprDebugAndThen defaultSDocContext trace (text "WARNING:") + = pprDebugAndThen traceSDocContext trace (text "WARNING:") (text s $$ msg $$ withFrozenCallStack traceCallStackDoc ) x @@ -78,7 +78,7 @@ warnPprTrace True s msg x pprTraceUserWarning :: HasCallStack => SDoc -> a -> a pprTraceUserWarning msg x | unsafeHasNoDebugOutput = x - | otherwise = pprDebugAndThen defaultSDocContext trace (text "WARNING:") + | otherwise = pprDebugAndThen traceSDocContext trace (text "WARNING:") (msg $$ withFrozenCallStack traceCallStackDoc ) x |