summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2022-05-13 11:12:02 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-05-17 07:16:39 -0400
commiteccdb2080ea80df6510098f2e58046bc20efe19a (patch)
tree96d3c33462079a7a0fb5c85e06943c5202631194
parent5f6527e05beb628c5015ab9f8a7f4012ee8d14a1 (diff)
downloadhaskell-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.hs16
-rw-r--r--compiler/GHC/Utils/Trace.hs6
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