X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fspecialise%2FSpecConstr.lhs;h=bdd9a16a717052785eb7355b1c5ab691800db6d1;hb=36104d7a0d66df895c8275e3aa7cfe35a322ff04;hp=7eb3529d4e191930eaa03d86977c506d151d0fce;hpb=10f18550c3684368b9d8e5b7adcccc14994cf170;p=ghc-hetmet.git

diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index 7eb3529..bdd9a16 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 {