import IdInfo
import CoreUtils ( coreBindsSize )
import Simplify ( simplTopBinds, simplExpr )
+import SimplUtils ( simplEnvForGHCi, simplEnvForRules )
import SimplEnv
import SimplMonad
import CoreMonad
import SpecConstr ( specConstrProgram)
import DmdAnal ( dmdAnalPgm )
import WorkWrap ( wwTopBinds )
-#ifdef OLD_STRICTNESS
-import StrictAnal ( saBinds )
-import CprAnalyse ( cprAnalyse )
-#endif
import Vectorise ( vectorise )
import FastString
import Util
-> IO CoreExpr
-- simplifyExpr is called by the driver to simplify an
-- expression typed in at the interactive prompt
+--
+-- Also used by Template Haskell
simplifyExpr dflags expr
= do {
; Err.showPass dflags "Simplify"
; us <- mkSplitUniqSupply 's'
; let (expr', _counts) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
- simplExprGently gentleSimplEnv expr
+ simplExprGently simplEnvForGHCi expr
; Err.dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression"
(pprCoreExpr expr')
; return expr'
}
-gentleSimplEnv :: SimplEnv
-gentleSimplEnv = mkSimplEnv SimplGently (isAmongSimpl [])
-
doCorePasses :: [CorePass] -> ModGuts -> CoreM ModGuts
doCorePasses passes guts = foldM (flip doCorePass) guts passes
doCorePass CoreDoPrintCore = dontDescribePass $ observe printCore
doCorePass (CoreDoRuleCheck phase pat) = dontDescribePass $ ruleCheck phase pat
-#ifdef OLD_STRICTNESS
-doCorePass CoreDoOldStrictness = {-# SCC "OldStrictness" #-} doOldStrictness
-#endif
-
doCorePass CoreDoNothing = return
doCorePass (CoreDoPasses passes) = doCorePasses passes
-
-#ifdef OLD_STRICTNESS
-doOldStrictness :: ModGuts -> CoreM ModGuts
-doOldStrictness guts
- = do dfs <- getDynFlags
- guts' <- describePass "Strictness analysis" Opt_D_dump_stranal $
- doPassM (saBinds dfs) guts
- guts'' <- describePass "Constructed Product analysis" Opt_D_dump_cpranal $
- doPass cprAnalyse guts'
- return guts''
-#endif
-
\end{code}
%************************************************************************
ruleCheck :: CompilerPhase -> String -> ModGuts -> CoreM ModGuts
ruleCheck current_phase pat guts = do
- let is_active = isActive current_phase
rb <- getRuleBase
dflags <- getDynFlags
liftIO $ Err.showPass dflags "RuleCheck"
- liftIO $ printDump (ruleCheckProgram is_active pat rb (mg_binds guts))
+ liftIO $ printDump (ruleCheckProgram current_phase pat rb (mg_binds guts))
return guts
; let -- Simplify the local rules; boringly, we need to make an in-scope set
-- from the local binders, to avoid warnings from Simplify.simplVar
local_ids = mkInScopeSet (mkVarSet (bindersOfBinds binds))
- env = setInScopeSet gentleSimplEnv local_ids
+ env = setInScopeSet simplEnvForRules local_ids
(simpl_rules, _) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
mapM (simplRule env) local_rules
Simplify.completeLam) but only if -O is on.
\begin{code}
+simplRule :: SimplEnv -> CoreRule -> SimplM CoreRule
simplRule env rule@(BuiltinRule {})
= return rule
simplRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs })
eps <- hscEPS hsc_env ;
let { rule_base1 = unionRuleBase hpt_rule_base (eps_rule_base eps)
; rule_base2 = extendRuleBaseList rule_base1 rules
- ; simpl_env = mkSimplEnv mode sw_chkr
+ ; simpl_env = mkSimplEnv sw_chkr mode
; simpl_binds = {-# SCC "SimplTopBinds" #-}
simplTopBinds simpl_env tagged_binds
; fam_envs = (eps_fam_inst_env eps, fam_inst_env) } ;
let { binds2 = {-# SCC "ZapInd" #-} shortOutIndirections binds1 } ;
-- Dump the result of this iteration
- endIteration dflags mode iteration_no max_iterations counts1 binds2 rules1 ;
+ end_iteration dflags mode iteration_no max_iterations counts1 binds2 rules1 ;
-- Loop
do_iteration us2 (iteration_no + 1) all_counts binds2 rules1
(us1, us2) = splitUniqSupply us
-------------------
-endIteration :: DynFlags -> SimplifierMode -> Int -> Int
+end_iteration :: DynFlags -> SimplifierMode -> Int -> Int
-> SimplCount -> [CoreBind] -> [CoreRule] -> IO ()
--- Same as endPass but with simplifier counts
-endIteration dflags mode iteration_no max_iterations counts binds rules
+-- Same as endIteration but with simplifier counts
+end_iteration dflags mode iteration_no max_iterations counts binds rules
= do { Err.dumpIfSet_dyn dflags Opt_D_dump_simpl_iterations pass_name
(pprSimplCount counts) ;
- ; endPass dflags pass_name Opt_D_dump_simpl_iterations binds rules }
+ ; endIteration dflags pass_name Opt_D_dump_simpl_iterations binds rules }
where
pass_name = "Simplifier mode " ++ showPpr mode ++
", iteration " ++ show iteration_no ++
RULES: we want to *add* any RULES for x_local to x_exported.
-Note [Messing up the exported Id's IdInfo]
+Note [Messing up the exported Id's RULES]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We must be careful about discarding the IdInfo on the old Id
-
-The example that went bad on me at one stage was this one:
+We must be careful about discarding (obviously) or even merging the
+RULES on the exported Id. The example that went bad on me at one stage
+was this one:
iterate :: (a -> a) -> a -> [a]
[Exported]
= modifyIdInfo transfer exported_id
where
local_info = idInfo local_id
- transfer exp_info = exp_info `setNewStrictnessInfo` newStrictnessInfo local_info
+ transfer exp_info = exp_info `setStrictnessInfo` strictnessInfo local_info
`setUnfoldingInfo` unfoldingInfo local_info
`setInlinePragInfo` inlinePragInfo local_info
`setSpecInfo` addSpecInfo (specInfo exp_info) new_info