Commit af37b300 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Improve warning for SpecConstr

parent db9c51c9
...@@ -36,6 +36,7 @@ import Name ...@@ -36,6 +36,7 @@ import Name
import OccName ( mkSpecOcc ) import OccName ( mkSpecOcc )
import ErrUtils ( dumpIfSet_dyn ) import ErrUtils ( dumpIfSet_dyn )
import DynFlags ( DynFlags(..), DynFlag(..) ) import DynFlags ( DynFlags(..), DynFlag(..) )
import StaticFlags ( opt_PprStyle_Debug )
import StaticFlags ( opt_SpecInlineJoinPoints ) import StaticFlags ( opt_SpecInlineJoinPoints )
import BasicTypes ( Activation(..) ) import BasicTypes ( Activation(..) )
import Maybes ( orElse, catMaybes, isJust, isNothing ) import Maybes ( orElse, catMaybes, isJust, isNothing )
...@@ -1021,10 +1022,14 @@ specialise env bind_calls (fn, arg_bndrs, body, arg_occs) ...@@ -1021,10 +1022,14 @@ specialise env bind_calls (fn, arg_bndrs, body, arg_occs)
; let spec_count' = length pats + spec_count ; let spec_count' = length pats + spec_count
; case sc_count env of ; case sc_count env of
Just max | spec_count' > max Just max | spec_count' > max
-> pprTrace "SpecConstr: too many specialisations for one function (see -fspec-constr-count):" -> WARN( True, msg ) return (nullUsage, spec_info)
(vcat [ptext (sLit "Function:") <+> ppr fn, where
ptext (sLit "Specialisations:") <+> ppr (pats ++ [p | OS p _ _ _ <- specs])]) msg = vcat [ sep [ ptext (sLit "SpecConstr: specialisation of") <+> quotes (ppr fn)
return (nullUsage, spec_info) , nest 2 (ptext (sLit "limited by bound of")) <+> int max ]
, ptext (sLit "Use -fspec-constr-count=n to set the bound")
, extra ]
extra | not opt_PprStyle_Debug = ptext (sLit "Use -dppr-debug to see specialisations")
| otherwise = ptext (sLit "Specialisations:") <+> ppr (pats ++ [p | OS p _ _ _ <- specs])
_normal_case -> do { _normal_case -> do {
......
...@@ -107,6 +107,15 @@ infixr 9 `thenCmp` ...@@ -107,6 +107,15 @@ infixr 9 `thenCmp`
%* * %* *
%************************************************************************ %************************************************************************
These booleans are global constants, set by CPP flags. They allow us to
recompile a single module (this one) to change whether or not debug output
appears. They sometimes let us avoid even running CPP elsewhere.
It's important that the flags are literal constants (True/False). Then,
with -0, tests of the flags in other modules will simplify to the correct
branch of the conditional, thereby dropping debug code altogether when
the flags are off.
\begin{code} \begin{code}
ghciSupported :: Bool ghciSupported :: Bool
#ifdef GHCI #ifdef GHCI
......
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