import FloatOut ( floatOutwards )
import FamInstEnv
import Id
-import BasicTypes ( CompilerPhase, isDefaultInlinePragma )
+import BasicTypes
import VarSet
import VarEnv
import LiberateCase ( liberateCase )
doCorePass CoreDoSpecConstr = {-# SCC "SpecConstr" #-}
specConstrProgram
-doCorePass (CoreDoVectorisation be) = {-# SCC "Vectorise" #-}
- vectorise be
+doCorePass CoreDoVectorisation = {-# SCC "Vectorise" #-}
+ vectorise
doCorePass CoreDoGlomBinds = doPassDM glomBinds
doCorePass CoreDoPrintCore = observe printCore
; us <- mkSplitUniqSupply 's'
; let (expr', _counts) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
- simplExprGently simplEnvForGHCi expr
+ simplExprGently (simplEnvForGHCi dflags) expr
; Err.dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression"
(pprCoreExpr expr')
-- space usage, especially with -O. JRS, 000620.
| let sz = coreBindsSize binds in sz == sz
= do {
- -- Occurrence analysis
- let { tagged_binds = {-# SCC "OccAnal" #-}
- occurAnalysePgm active_rule rules binds } ;
- Err.dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
- (pprCoreBindings tagged_binds);
+ -- Occurrence analysis
+ let { -- During the 'InitialPhase' (i.e., before vectorisation), we need to make sure
+ -- that the right-hand sides of vectorisation declarations are taken into
+ -- account during occurence analysis.
+ maybeVects = case sm_phase mode of
+ InitialPhase -> mg_vect_decls guts
+ _ -> []
+ ; tagged_binds = {-# SCC "OccAnal" #-}
+ occurAnalysePgm active_rule rules maybeVects binds
+ } ;
+ Err.dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
+ (pprCoreBindings tagged_binds);
-- Get any new rules, and extend the rule base
-- See Note [Overall plumbing for rules] in Rules.lhs