Commit 134b7223 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Be less verbose when printing Names when we don't know what's in scope

Previously we always printed qualified names, but that makes a lot of debug or
warning output very verbose. So now we only print qualified names with -dppr-debug.

Civilised output (from pukka error messages, with the environment available) is
unaffected
parent 68a1e679
......@@ -732,7 +732,7 @@ mk_absent_let dflags arg
where
arg_ty = idType arg
abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg
msg = showSDocDebug dflags (ppr arg <+> ppr (idType arg))
msg = showSDoc dflags (ppr arg <+> ppr (idType arg))
mk_seq_case :: Id -> CoreExpr -> CoreExpr
mk_seq_case arg body = Case (Var arg) (sanitiseCaseBndr arg) (exprType body) [(DEFAULT, [], body)]
......
......@@ -190,31 +190,30 @@ neverQualify = (neverQualifyNames, neverQualifyModules)
defaultUserStyle, defaultDumpStyle :: PprStyle
defaultUserStyle = mkUserStyle alwaysQualify AllTheWay
defaultUserStyle = mkUserStyle neverQualify AllTheWay
-- Print without qualifiers to reduce verbosity, unless -dppr-debug
defaultDumpStyle | opt_PprStyle_Debug = PprDebug
| otherwise = PprDump
defaultErrStyle :: DynFlags -> PprStyle
-- Default style for error messages, when we don't know PrintUnqualified
-- It's a bit of a hack because it doesn't take into account what's in scope
-- Only used for desugarer warnings, and typechecker errors in interface sigs
-- NB that -dppr-debug will still get into PprDebug style
defaultErrStyle dflags = mkErrStyle dflags neverQualify
-- | Style for printing error messages
mkErrStyle :: DynFlags -> PrintUnqualified -> PprStyle
mkErrStyle dflags qual = mkUserStyle qual (PartWay (pprUserLength dflags))
defaultErrStyle :: DynFlags -> PprStyle
-- Default style for error messages
-- It's a bit of a hack because it doesn't take into account what's in scope
-- Only used for desugarer warnings, and typechecker errors in interface sigs
defaultErrStyle dflags = mkUserStyle alwaysQualify depth
where depth = if opt_PprStyle_Debug
then AllTheWay
else PartWay (pprUserLength dflags)
cmdlineParserStyle :: PprStyle
cmdlineParserStyle = mkUserStyle alwaysQualify AllTheWay
mkUserStyle :: PrintUnqualified -> Depth -> PprStyle
mkUserStyle unqual depth
| opt_PprStyle_Debug = PprDebug
| otherwise = PprUser unqual depth
cmdlineParserStyle :: PprStyle
cmdlineParserStyle = PprUser alwaysQualify AllTheWay
\end{code}
Orthogonal to the above printing styles are (possibly) some
......@@ -979,7 +978,7 @@ assertPprPanic file line msg
pprDebugAndThen :: DynFlags -> (String -> a) -> String -> SDoc -> a
pprDebugAndThen dflags cont heading pretty_msg
= cont (showSDocDebug dflags doc)
= cont (showSDoc dflags doc)
where
doc = sep [text heading, nest 4 pretty_msg]
\end{code}
......
<command line>: The value Simple.BadlyTypedPlugin.plugin did not have the type CoreMonad.Plugin as required
<command line>: The value plugin did not have the type Plugin as required
(GHC.Types.True, T7918B.hs:6:11-14)
(GHC.Base.id, T7918B.hs:7:11-14)
(GHC.Types.True, T7918B.hs:7:11-14)
(GHC.Types.True, T7918B.hs:8:11-14)
(GHC.Classes.||, T7918B.hs:8:11-14)
(GHC.Types.False, T7918B.hs:8:11-14)
(GHC.Types.False, T7918B.hs:9:11-14)
(GHC.Err.undefined, T7918B.hs:11:7-15)
(GHC.Types.Bool, T7918B.hs:11:24-27)
(GHC.Err.undefined, T7918B.hs:12:7-15)
(Data.Maybe.Maybe, T7918B.hs:12:24-27)
(GHC.Types.Bool, T7918B.hs:12:24-27)
(GHC.Err.undefined, T7918B.hs:13:7-15)
(Data.Either.Either, T7918B.hs:13:24-27)
(GHC.Types.Bool, T7918B.hs:13:24-27)
(GHC.Types.Int, T7918B.hs:13:24-27)
(GHC.Err.undefined, T7918B.hs:14:7-15)
(GHC.Types.Int, T7918B.hs:14:24-27)
(True, T7918B.hs:6:11-14)
(id, T7918B.hs:7:11-14)
(True, T7918B.hs:7:11-14)
(True, T7918B.hs:8:11-14)
(||, T7918B.hs:8:11-14)
(False, T7918B.hs:8:11-14)
(False, T7918B.hs:9:11-14)
(undefined, T7918B.hs:11:7-15)
(Bool, T7918B.hs:11:24-27)
(undefined, T7918B.hs:12:7-15)
(Maybe, T7918B.hs:12:24-27)
(Bool, T7918B.hs:12:24-27)
(undefined, T7918B.hs:13:7-15)
(Either, T7918B.hs:13:24-27)
(Bool, T7918B.hs:13:24-27)
(Int, T7918B.hs:13:24-27)
(undefined, T7918B.hs:14:7-15)
(Int, T7918B.hs:14:24-27)
(x, T7918B.hs:16:9-12)
(GHC.Err.undefined, T7918B.hs:16:16-24)
(undefined, T7918B.hs:16:16-24)
(x, T7918B.hs:17:9-12)
(GHC.Err.undefined, T7918B.hs:17:16-24)
(undefined, T7918B.hs:17:16-24)
(x, T7918B.hs:18:9-12)
(y, T7918B.hs:18:9-12)
(GHC.Err.undefined, T7918B.hs:18:16-24)
(undefined, T7918B.hs:18:16-24)
(y, T7918B.hs:19:9-12)
(GHC.Err.undefined, T7918B.hs:19:16-24)
(undefined, T7918B.hs:19:16-24)
SafeLang15: SafeLang15.hs:22:9-37: Irrefutable pattern failed for pattern Data.Maybe.Just p'
SafeLang15: SafeLang15.hs:22:9-37: Irrefutable pattern failed for pattern Just p'
==================== Tidy Core rules ====================
"SPEC Foo.shared [[]]" [ALWAYS]
forall ($dMyFunctor :: Foo.MyFunctor [])
(irred :: Foo.Domain [] GHC.Types.Int).
Foo.shared @ [] $dMyFunctor irred
= Foo.bar_$sshared
forall ($dMyFunctor :: MyFunctor []) (irred :: Domain [] Int).
shared @ [] $dMyFunctor irred
= bar_$sshared
......@@ -3,7 +3,7 @@ Rule fired: Class op fmap
Rule fired: Class op pure
Rule fired: Class op <*>
Rule fired: Class op <*>
Rule fired: SPEC T8848.map2
Rule fired: SPEC map2
Rule fired: Class op $p1Applicative
Rule fired: Class op <*>
Rule fired: Class op $p1Applicative
......
==================== Tidy Core rules ====================
"SPEC T8848a.f" [ALWAYS]
forall (@ b) ($dOrd :: GHC.Classes.Ord [GHC.Types.Int]).
T8848a.f @ b @ [GHC.Types.Int] $dOrd
= T8848a.f_$sf @ b
"SPEC f" [ALWAYS]
forall (@ b) ($dOrd :: Ord [Int]). f @ b @ [Int] $dOrd = f_$sf @ b
==================== Tidy Core rules ====================
"SPEC Main.fib [GHC.Types.Double]" [ALWAYS]
forall ($dNum :: GHC.Num.Num GHC.Types.Double)
($dOrd :: GHC.Classes.Ord GHC.Types.Double).
Main.fib @ GHC.Types.Double $dNum $dOrd
= Main.fib_$sfib1
forall ($dNum :: Num Double) ($dOrd :: Ord Double).
fib @ Double $dNum $dOrd
= fib_$sfib1
"SPEC Main.fib [GHC.Types.Int]" [ALWAYS]
forall ($dNum :: GHC.Num.Num GHC.Types.Int)
($dOrd :: GHC.Classes.Ord GHC.Types.Int).
Main.fib @ GHC.Types.Int $dNum $dOrd
= Main.fib_$sfib
forall ($dNum :: Num Int) ($dOrd :: Ord Int).
fib @ Int $dNum $dOrd
= fib_$sfib
"SPEC Main.tak [GHC.Types.Double]" [ALWAYS]
forall ($dNum :: GHC.Num.Num GHC.Types.Double)
($dOrd :: GHC.Classes.Ord GHC.Types.Double).
Main.tak @ GHC.Types.Double $dNum $dOrd
= Main.tak_$stak1
forall ($dNum :: Num Double) ($dOrd :: Ord Double).
tak @ Double $dNum $dOrd
= tak_$stak1
"SPEC Main.tak [GHC.Types.Int]" [ALWAYS]
forall ($dNum :: GHC.Num.Num GHC.Types.Int)
($dOrd :: GHC.Classes.Ord GHC.Types.Int).
Main.tak @ GHC.Types.Int $dNum $dOrd
= Main.tak_$stak
forall ($dNum :: Num Int) ($dOrd :: Ord Int).
tak @ Int $dNum $dOrd
= tak_$stak
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment