Commit d3dac4e3 authored by Eugene Akentyev's avatar Eugene Akentyev Committed by Ben Gamari

Add -fprint-typechecker-elaboration flag (fixes #10662)

Reviewers: thomie, austin, bgamari

Reviewed By: thomie, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1625

GHC Trac Issues: #10662
parent 4b161c93
......@@ -38,6 +38,7 @@ import Var
import Bag
import FastString
import BooleanFormula (LBooleanFormula)
import DynFlags
import Data.Data hiding ( Fixity )
import Data.List hiding ( foldr )
......@@ -546,13 +547,20 @@ ppr_monobind (PatSynBind psb) = ppr psb
ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
, abs_exports = exports, abs_binds = val_binds
, abs_ev_binds = ev_binds })
= hang (ptext (sLit "AbsBinds") <+> brackets (interpp'SP tyvars)
= sdocWithDynFlags $ \ dflags ->
if gopt Opt_PrintTypechekerElaboration dflags then
-- Show extra information (bug number: #10662)
hang (ptext (sLit "AbsBinds") <+> brackets (interpp'SP tyvars)
<+> brackets (interpp'SP dictvars))
2 $ braces $ vcat
[ ptext (sLit "Exports:") <+> brackets (sep (punctuate comma (map ppr exports)))
, ptext (sLit "Exported types:") <+> vcat [pprBndr LetBind (abe_poly ex) | ex <- exports]
[ ptext (sLit "Exports:") <+>
brackets (sep (punctuate comma (map ppr exports)))
, ptext (sLit "Exported types:") <+>
vcat [pprBndr LetBind (abe_poly ex) | ex <- exports]
, ptext (sLit "Binds:") <+> pprLHsBinds val_binds
, ifPprDebug (ptext (sLit "Evidence:") <+> ppr ev_binds) ]
, ptext (sLit "Evidence:") <+> ppr ev_binds ]
else
pprLHsBinds val_binds
instance (OutputableBndr id) => Outputable (ABExport id) where
ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags })
......
......@@ -338,6 +338,7 @@ data GeneralFlag
| Opt_PrintUnicodeSyntax
| Opt_PrintExpandedSynonyms
| Opt_PrintPotentialInstances
| Opt_PrintTypechekerElaboration
-- optimisation opts
| Opt_CallArity
......@@ -2951,6 +2952,7 @@ fFlags = [
flagSpec "print-unicode-syntax" Opt_PrintUnicodeSyntax,
flagSpec "print-expanded-synonyms" Opt_PrintExpandedSynonyms,
flagSpec "print-potential-instances" Opt_PrintPotentialInstances,
flagSpec "print-typechecker-elaboration" Opt_PrintTypechekerElaboration,
flagSpec "prof-cafs" Opt_AutoSccsOnIndividualCafs,
flagSpec "prof-count-entries" Opt_ProfCountEntries,
flagSpec "regs-graph" Opt_RegsGraph,
......
......@@ -711,6 +711,47 @@ See also the ``--help``, ``--version``, ``--numeric-version``, and
Expected type: ST s Int
Actual type: ST s Bool
``-fprint-typechecker-elaboration``
.. index::
single: -fprint-typechecker-elaboration
When enabled, GHC also prints extra information from the typechecker in
warnings. For example:
::
main :: IO ()
main = do
return $ let a = "hello" in a
return ()
This warning message:
::
A do-notation statement discarded a result of type ‘[Char]’
Suppress this warning by saying
‘_ <- ($) return let a = "hello" in a’
or by using the flag -fno-warn-unused-do-bind
Becomes this:
::
A do-notation statement discarded a result of type ‘[Char]’
Suppress this warning by saying
‘_ <- ($)
return
let
AbsBinds [] []
{Exports: [a <= a
<>]
Exported types: a :: [Char]
[LclId, Str=DmdType]
Binds: a = "hello"}
in a’
or by using the flag -fno-warn-unused-do-bind
``-ferror-spans``
.. index::
single: -ferror-spans
......
main :: IO ()
main = do
return $ let a = "hello" in a
return ()
T10662.hs:3:3: warning:
A do-notation statement discarded a result of type ‘[Char]’
Suppress this warning by saying
‘_ <- ($) return let a = "hello" in a’
or by using the flag -fno-warn-unused-do-bind
......@@ -103,3 +103,4 @@ test('T8470', normal, compile, [''])
test('T10251', normal, compile, [''])
test('T10767', normal, compile, [''])
test('DsStrictWarn', normal, compile, [''])
test('T10662', normal, compile, ['-Wall'])
......@@ -48,11 +48,12 @@ AbsBinds [a] []
Exported types: T8958.$fRepresentationala
:: forall a. Representational a
[LclIdX[DFunId], Str=DmdType]
Binds: $dRepresentational = T8958.D:Representational}
Binds: $dRepresentational = T8958.D:Representational
Evidence: [EvBinds{}]}
AbsBinds [a] []
{Exports: [T8958.$fNominala <= $dNominal
<>]
Exported types: T8958.$fNominala :: forall a. Nominal a
[LclIdX[DFunId], Str=DmdType]
Binds: $dNominal = T8958.D:Nominal}
Binds: $dNominal = T8958.D:Nominal
Evidence: [EvBinds{}]}
......@@ -4,6 +4,6 @@ test('Roles3', only_ways('normal'), compile, ['-ddump-tc -dsuppress-uniques'])
test('Roles4', only_ways('normal'), compile, ['-ddump-tc -dsuppress-uniques'])
test('Roles13', only_ways('normal'), compile, ['-ddump-simpl -dsuppress-uniques'])
test('Roles14', only_ways('normal'), compile, ['-ddump-tc -dsuppress-uniques'])
test('T8958', [normalise_fun(normalise_errmsg), only_ways('normal')], compile, ['-ddump-tc -dsuppress-uniques'])
test('T8958', [normalise_fun(normalise_errmsg), only_ways('normal')], compile, ['-ddump-tc -dsuppress-uniques -fprint-typechecker-elaboration'])
test('T10263', normal, compile, [''])
test('T9204b', extra_clean(['T9204b.o-boot', 'T9204b.hi-boot', 'T9204b2.hi', 'T9204b2.o']), multimod_compile, ['T9204b', '-v0'])
......@@ -46,6 +46,12 @@ verbosityOptions =
, flagType = DynamicFlag
, flagReverse = "-fno-print-expanded-synonyms"
}
, flag { flagName = "-fprint-typechecker-elaboration"
, flagDescription =
"Print extra information from typechecker."
, flagType = DynamicFlag
, flagReverse = "-fno-print-typechecker-elaboration"
}
, flag { flagName = "-ferror-spans"
, flagDescription = "Output full span in error messages"
, flagType = DynamicFlag
......
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