diff options
| author | simonpj <unknown> | 2001-01-11 14:09:50 +0000 |
|---|---|---|
| committer | simonpj <unknown> | 2001-01-11 14:09:50 +0000 |
| commit | e18bb2e86eb13bdb98cc0afc7c2aa8e56d98bcc7 (patch) | |
| tree | 5cf82473eea2d8d7c46dd097a4dff46ee7b192e1 | |
| parent | 4bac90dcd705b922910995b2cdf2fc4ee7a0f09b (diff) | |
| download | haskell-e18bb2e86eb13bdb98cc0afc7c2aa8e56d98bcc7.tar.gz | |
[project @ 2001-01-11 14:09:50 by simonpj]
Add debug print for rule firings; controlled by -ddump-inlinings.
Also, make -ddump-inlinings work without -DDEBUG is off.
It's jolly useful, and it's tiresome to have to tell
people to rebuild their compiler.
| -rw-r--r-- | ghc/compiler/coreSyn/CoreUnfold.lhs | 2 | ||||
| -rw-r--r-- | ghc/compiler/simplCore/Simplify.lhs | 11 |
2 files changed, 11 insertions, 2 deletions
diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs index d86b86461b..df6acfb34c 100644 --- a/ghc/compiler/coreSyn/CoreUnfold.lhs +++ b/ghc/compiler/coreSyn/CoreUnfold.lhs @@ -614,7 +614,6 @@ callSiteInline dflags black_listed inline_call occ id arg_infos interesting_cont arg_infos really_interesting_cont in -#ifdef DEBUG if dopt Opt_D_dump_inlinings dflags then pprTrace "Considering inlining" (ppr id <+> vcat [text "black listed:" <+> ppr black_listed, @@ -630,7 +629,6 @@ callSiteInline dflags black_listed inline_call occ id arg_infos interesting_cont else empty]) result else -#endif result } diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs index 76da6e5e6a..34f4dee597 100644 --- a/ghc/compiler/simplCore/Simplify.lhs +++ b/ghc/compiler/simplCore/Simplify.lhs @@ -10,6 +10,7 @@ module Simplify ( simplTopBinds, simplExpr ) where import CmdLineOpts ( switchIsOn, opt_SimplDoEtaReduction, opt_SimplNoPreInlining, + dopt, DynFlag(Opt_D_dump_inlinings), SimplifierSwitch(..) ) import SimplMonad @@ -38,6 +39,7 @@ import DataCon ( dataConNumInstArgs, dataConRepStrictness, dataConSig, dataConArgTys ) import CoreSyn +import PprCore ( pprParendExpr, pprCoreExpr ) import CoreFVs ( mustHaveLocalBinding, exprFreeVars ) import CoreUnfold ( mkOtherCon, mkUnfolding, otherCons, callSiteInline @@ -830,6 +832,15 @@ completeCall var occ_info cont case maybe_rule of { Just (rule_name, rule_rhs) -> tick (RuleFired rule_name) `thenSmpl_` +#ifdef DEBUG + (if dopt Opt_D_dump_inlinings dflags then + pprTrace "Rule fired" (vcat [ + text "Rule:" <+> ptext rule_name, + text "Before:" <+> ppr var <+> sep (map pprParendExpr args'), + text "After: " <+> pprCoreExpr rule_rhs]) + else + id) $ +#endif simplExprF rule_rhs call_cont ; Nothing -> -- No rules |