#include "HsVersions.h"
-import DynFlags ( dopt, DynFlag(Opt_D_dump_inlinings),
- SimplifierSwitch(..)
- )
+import DynFlags
import SimplMonad
import Type hiding ( substTy, extendTvSubst )
import SimplEnv
-- It's rather as if the top-level binders were imported.
; env <- simplRecBndrs env (bindersOfBinds binds)
; dflags <- getDOptsSmpl
- ; let dump_flag = dopt Opt_D_dump_inlinings dflags
+ ; let dump_flag = dopt Opt_D_dump_inlinings dflags ||
+ dopt Opt_D_dump_rule_firings dflags
; env' <- simpl_binds dump_flag env binds
; freeTick SimplifierDone
; return (getFloats env') }
-- We need to track the zapped top-level binders, because
-- they should have their fragile IdInfo zapped (notably occurrence info)
-- That's why we run down binds and bndrs' simultaneously.
+ --
+ -- The dump-flag emits a trace for each top-level binding, which
+ -- helps to locate the tracing for inlining and rule firing
simpl_binds :: Bool -> SimplEnv -> [InBind] -> SimplM SimplEnv
simpl_binds dump env [] = return env
simpl_binds dump env (bind:binds) = do { env' <- trace dump bind $
simplNonRecX env bndr new_rhs
= do { (env, bndr') <- simplBinder env bndr
; completeNonRecX env NotTopLevel NonRecursive
- (isStrictBndr bndr) bndr bndr' new_rhs }
+ (isStrictId bndr) bndr bndr' new_rhs }
completeNonRecX :: SimplEnv
-> TopLevelFlag -> RecFlag -> Bool
where
addCoerce co cont = add_coerce co (coercionKind co) cont
- add_coerce co (s1, k1) cont
- | s1 `coreEqType` k1 = cont
+ add_coerce co (s1, k1) cont -- co :: ty~ty
+ | s1 `coreEqType` k1 = cont -- is a no-op
+
add_coerce co1 (s1, k2) (CoerceIt co2 cont)
| (l1, t1) <- coercionKind co2
-- coerce T1 S1 (coerce S1 K1 e)
= do { tick (PreInlineUnconditionally bndr)
; simplLam (extendIdSubst env bndr (mkContEx rhs_se rhs)) bndrs body cont }
- | isStrictBndr bndr
+ | isStrictId bndr
= do { simplExprF (rhs_se `setFloats` env) rhs
(StrictBind bndr bndrs body env cont) }
; case maybe_rule of {
Just (rule, rule_rhs) ->
tick (RuleFired (ru_name rule)) `thenSmpl_`
- (if dopt Opt_D_dump_inlinings dflags then
+ (if dopt Opt_D_dump_rule_firings dflags then
pprTrace "Rule fired" (vcat [
text "Rule:" <+> ftext (ru_name rule),
text "Before:" <+> ppr var <+> sep (map pprParendExpr args),