#include "HsVersions.h"
-import DynFlags ( CoreToDo(..), SimplifierSwitch(..),
- SimplifierMode(..), DynFlags, DynFlag(..), dopt,
- getCoreToDo, shouldDumpSimplPhase )
+import DynFlags ( DynFlags, DynFlag(..), dopt )
import CoreSyn
import CoreSubst
import HscTypes
import CoreMonad
import qualified ErrUtils as Err
import CoreLint
-import CoreMonad ( endPass )
import FloatIn ( floatInwards )
import FloatOut ( floatOutwards )
import FamInstEnv
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
us <- mkSplitUniqSupply 's'
let (cp_us, ru_us) = splitUniqSupply us
- -- COMPUTE THE ANNOTATIONS TO USE
- ann_env <- prepareAnnotations hsc_env (Just guts)
-
-- COMPUTE THE RULE BASE TO USE
+ -- See Note [Overall plumbing for rules] in Rules.lhs
(hpt_rule_base, guts1) <- prepareRules hsc_env guts ru_us
-- Get the module out of the current HscEnv so we can retrieve it from the monad.
-- _theoretically_ be changed during the Core pipeline (it's part of ModGuts), which
-- would mean our cached value would go out of date.
let mod = mg_module guts
- (guts2, stats) <- runCoreM hsc_env ann_env hpt_rule_base cp_us mod $ do
+ (guts2, stats) <- runCoreM hsc_env hpt_rule_base cp_us mod $ do
-- FIND BUILT-IN PASSES
let builtin_core_todos = getCoreToDo dflags
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
; Err.dumpIfSet_dyn dflags Opt_D_dump_rules "Transformation rules"
(withPprStyle (mkUserStyle (mkPrintUnqualified dflags rdr_env) AllTheWay) $
- vcat [text "Local rules", pprRules simpl_rules,
+ vcat [text "Local rules for local Ids", pprRules simpl_rules,
blankLine,
- text "Imported rules", pprRuleBase hpt_rule_base])
+ text "Local rules for imported Ids", pprRuleBase hpt_rule_base])
; return (hpt_rule_base, guts { mg_binds = binds_w_rules,
mg_rules = rules_for_imps })
}
where
dflags = hsc_dflags hsc_env
- dump_phase = shouldDumpSimplPhase dflags mode
+ dump_phase = dumpSimplPhase dflags mode
sw_chkr = isAmongSimpl switches
max_iterations = intSwitchSet sw_chkr MaxSimplifierIterations `orElse` 2
(pprCoreBindings tagged_binds);
-- Get any new rules, and extend the rule base
+ -- See Note [Overall plumbing for rules] in Rules.lhs
-- We need to do this regularly, because simplification can
-- poke on IdInfo thunks, which in turn brings in new rules
-- behind the scenes. Otherwise there's a danger we'll simply
let { all_counts = counts `plusSimplCount` counts1
; binds1 = getFloats env1
- ; rules1 = substRulesForImportedIds (mkCoreSubst env1) rules
+ ; rules1 = substRulesForImportedIds (mkCoreSubst (text "imp-rules") env1) rules
} ;
-- Stop if nothing happened; don't dump output
= 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