Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-7.4
http://hackage.haskell.org/trac/ghc/changeset/92c4406542235bd9930dbdbe265c22925d5d6889 >--------------------------------------------------------------- commit 92c4406542235bd9930dbdbe265c22925d5d6889 Author: Ian Lynagh <[email protected]> Date: Mon Dec 19 14:09:14 2011 +0000 Make "Simplifier ticks exhausted" a warning in the 7.4 branch This works around the problems reported in #5539, where lots of people are running into the limit. >--------------------------------------------------------------- compiler/simplCore/SimplCore.lhs | 16 ++++++++++++++-- compiler/simplCore/SimplMonad.lhs | 32 +++++++++++++++++++++++++++----- 2 files changed, 41 insertions(+), 7 deletions(-) diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 03ffb47..ed05aed 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -489,9 +489,15 @@ simplifyExpr dflags expr ; us <- mkSplitUniqSupply 's' ; let sz = exprSize expr - (expr', counts) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us sz $ + (expr', counts, mWarn) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us sz $ simplExprGently (simplEnvForGHCi dflags) expr + ; case mWarn of { + Just warning -> + Err.errorMsg dflags warning ; + Nothing -> + return () } + ; Err.dumpIfSet (dopt Opt_D_dump_simpl_stats dflags) "Simplifier statistics" (pprSimplCount counts) @@ -636,7 +642,13 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode) -- So the conditional didn't force counts1, because the -- selection got duplicated. Sigh! case initSmpl dflags rule_base2 fam_envs us1 sz simpl_binds of { - (env1, counts1) -> do { + (env1, counts1, mWarn) -> do { + + case mWarn of { + Just warning -> + Err.errorMsg dflags warning ; + Nothing -> + return () } ; let { binds1 = getFloatBinds env1 ; rules1 = substRulesForImportedIds (mkCoreSubst (text "imp-rules") env1) rules diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs index 647da72..f2656d7 100644 --- a/compiler/simplCore/SimplMonad.lhs +++ b/compiler/simplCore/SimplMonad.lhs @@ -67,15 +67,28 @@ initSmpl :: DynFlags -> RuleBase -> (FamInstEnv, FamInstEnv) -> UniqSupply -- No init count; set to 0 -> Int -- Size of the bindings -> SimplM a - -> (a, SimplCount) + -> (a, SimplCount, Maybe SDoc) initSmpl dflags rules fam_envs us size m = case unSM m env us (zeroSimplCount dflags) of - (result, _, count) -> (result, count) + (result, _, count) -> + let mWarning = if st_max_ticks env <= simplCountN count + then Just (msg count) + else Nothing + in (result, count, mWarning) where env = STE { st_flags = dflags, st_rules = rules , st_max_ticks = computeMaxTicks dflags size , st_fams = fam_envs } + msg sc = vcat [ ptext (sLit "Warning: Simplifier ticks exhausted.") + , ptext (sLit "To increase the limit, use -fsimpl-tick-factor=N (default 100)") + , ptext (sLit "If you need to do this, let GHC HQ know, and what factor you needed") + , pp_details sc + , pprSimplCount sc ] + pp_details sc + | hasDetailedCounts sc = empty + | otherwise = ptext (sLit "To see detailed counts use -ddump-simpl-stats") + computeMaxTicks :: DynFlags -> Int -> Int -- Compute the max simplifier ticks as @@ -180,10 +193,19 @@ tick t = SM (\_st_env us sc -> let sc' = doSimplTick t sc checkedTick :: Tick -> SimplM () -- Try to take a tick, but fail if too many checkedTick t - = SM (\st_env us sc -> if st_max_ticks st_env <= simplCountN sc + = SM (\_st_env us sc -> + {- + This error is disabled for now due to #5539. + We will still print a warning at the callsites + of initSmpl. + + if st_max_ticks st_env <= simplCountN sc then pprPanic "Simplifier ticks exhausted" (msg sc) - else let sc' = doSimplTick t sc + else + -} + let sc' = doSimplTick t sc in sc' `seq` ((), us, sc')) +{- where msg sc = vcat [ ptext (sLit "When trying") <+> ppr t , ptext (sLit "To increase the limit, use -fsimpl-tick-factor=N (default 100)") @@ -193,7 +215,7 @@ checkedTick t pp_details sc | hasDetailedCounts sc = empty | otherwise = ptext (sLit "To see detailed counts use -ddump-simpl-stats") - +-} freeTick :: Tick -> SimplM () -- Record a tick, but don't add to the total tick count, which is _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
