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