From af37b3001b086f39cbf1fe3ea2aa5c37f4f9a34f Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Mon, 15 Sep 2008 15:49:08 +0000
Subject: [PATCH] Improve warning for SpecConstr
---
compiler/specialise/SpecConstr.lhs | 13 +++++++++----
compiler/utils/Util.lhs | 9 +++++++++
2 files changed, 18 insertions(+), 4 deletions(-)
diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index 7eb3529d4e19..bdd9a16a7170 100644
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -36,6 +36,7 @@ import Name
import OccName ( mkSpecOcc )
import ErrUtils ( dumpIfSet_dyn )
import DynFlags ( DynFlags(..), DynFlag(..) )
+import StaticFlags ( opt_PprStyle_Debug )
import StaticFlags ( opt_SpecInlineJoinPoints )
import BasicTypes ( Activation(..) )
import Maybes ( orElse, catMaybes, isJust, isNothing )
@@ -1021,10 +1022,14 @@ specialise env bind_calls (fn, arg_bndrs, body, arg_occs)
; let spec_count' = length pats + spec_count
; case sc_count env of
Just max | spec_count' > max
- -> pprTrace "SpecConstr: too many specialisations for one function (see -fspec-constr-count):"
- (vcat [ptext (sLit "Function:") <+> ppr fn,
- ptext (sLit "Specialisations:") <+> ppr (pats ++ [p | OS p _ _ _ <- specs])])
- return (nullUsage, spec_info)
+ -> WARN( True, msg ) return (nullUsage, spec_info)
+ where
+ msg = vcat [ sep [ ptext (sLit "SpecConstr: specialisation of") <+> quotes (ppr fn)
+ , 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 {
diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 4058a97f3661..db6f96a206d9 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -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}
ghciSupported :: Bool
#ifdef GHCI
--
GitLab