X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fspecialise%2FSpecConstr.lhs;h=ade88d92f9b00872b174c232a68753f4ba525e72;hb=f766da17254420317a6973e0790813650f74a294;hp=404b6cc7406c81721687959f8ee6c8fdebbad0a3;hpb=76dfa3944cbf149a30398d29e6762a44772c0174;p=ghc-hetmet.git

diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index 404b6cc..ade88d9 100644
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -570,7 +570,7 @@ lookupHowBound :: ScEnv -> Id -> Maybe HowBound
 lookupHowBound env id = lookupVarEnv (sc_how_bound env) id
 
 scSubstId :: ScEnv -> Id -> CoreExpr
-scSubstId env v = lookupIdSubst (sc_subst env) v
+scSubstId env v = lookupIdSubst (text "scSubstId") (sc_subst env) v
 
 scSubstTy :: ScEnv -> Type -> Type
 scSubstTy env ty = substTy (sc_subst env) ty
@@ -1097,20 +1097,24 @@ specialise env force_spec bind_calls (fn, arg_bndrs, body, arg_occs)
   , notNull arg_bndrs		-- Only specialise functions
   , Just all_calls <- lookupVarEnv bind_calls fn
   = do	{ (boring_call, pats) <- callsToPats env specs arg_occs all_calls
---	; pprTrace "specialise" (vcat [ppr fn <+> ppr arg_occs,
---	  				text "calls" <+> ppr all_calls,
---	  				text "good pats" <+> ppr pats])  $
+--	; pprTrace "specialise" (vcat [ ppr fn <+> text "with" <+> int (length pats) <+> text "good patterns"
+--                                      , text "arg_occs" <+> ppr arg_occs,
+--	  			      ,	text "calls" <+> ppr all_calls,
+--	  			      , text "good pats" <+> ppr pats])  $
 --	  return ()
 
 		-- Bale out if too many specialisations
 		-- Rather a hacky way to do so, but it'll do for now
-	; let spec_count' = length pats + spec_count
+	; let n_pats = length pats
+              spec_count' = length pats + spec_count
 	; case sc_count env of
 	    Just max | not force_spec && spec_count' > max
-		-> WARN( True, msg ) return (nullUsage, spec_info)
+		-> pprTrace "SpecConstr" 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 ]
+		   msg = vcat [ sep [ ptext (sLit "Function") <+> quotes (ppr fn)
+		       	            , nest 2 (ptext (sLit "has") <+> int n_pats <+> 
+                                              ptext (sLit "call pattterns, but the limit is") <+> 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")