import CoreUnfold ( couldBeSmallEnoughToInline )
import CoreLint ( showPass, endPass )
import CoreFVs ( exprsFreeVars )
-import CoreTidy ( tidyRules )
-import PprCore ( pprRules )
import WwLib ( mkWorkerArgs )
import DataCon ( dataConRepArity, dataConUnivTyVars )
import Coercion
+import Rules
import Type hiding( substTy )
import Id ( Id, idName, idType, isDataConWorkId_maybe, idArity,
mkUserLocal, mkSysLocal, idUnfolding, isLocalId )
import VarEnv
import VarSet
import Name
-import Rules ( addIdSpecialisations, mkLocalRule, rulesOfBinds )
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 )
endPass dflags "SpecConstr" Opt_D_dump_spec binds'
dumpIfSet_dyn dflags Opt_D_dump_rules "Top-level specialisations"
- (pprRules (tidyRules emptyTidyEnv (rulesOfBinds binds')))
+ (pprRulesForUser (rulesOfBinds binds'))
return binds'
where
; 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 {