- ([StgBinding], -- output program...
- ([CostCentre], -- local cost-centres that need to be decl'd
- [CostCentre])) -- "extern" cost-centres
-
-stg2stg stg_todos module_name ppr_style us binds
- = case (splitUniqSupply us) of { (us4now, us4later) ->
-
- (if do_verbose_stg2stg then
- hPutStr stderr "VERBOSE STG-TO-STG:\n" >>
- hPutStr stderr (ppShow 1000
- (ppAbove (ppStr ("*** Core2Stg:"))
- (ppAboves (map (ppr ppr_style) (setStgVarInfo False binds)))
- ))
- else return ()) >>
-
- -- Do the main business!
- foldl_mn do_stg_pass (binds, us4now, ([],[])) stg_todos
- >>= \ (processed_binds, _, cost_centres) ->
-
- -- Do essential wind-up
-
-{- Nuked for now SLPJ Dec 96
- -- Essential wind-up: part (a), saturate RHSs
- -- This must occur *after* elimIndirections, because elimIndirections
- -- can change things' arities. Consider:
- -- x_local = f x
- -- x_global = \a -> x_local a
- -- Then elimIndirections will change the program to
- -- x_global = f x
- -- and lo and behold x_global's arity has changed!
-
- case (satStgRhs processed_binds us4later) of { saturated_binds ->
--}
-
- -- Essential wind-up: part (b), do setStgVarInfo. It has to
- -- happen regardless, because the code generator uses its
- -- decorations.
- --
- -- Why does it have to happen last? Because earlier passes
- -- may move things around, which would change the live-var
- -- info. Also, setStgVarInfo decides about let-no-escape
- -- things, which in turn do a better job if arities are
- -- correct, which is done by satStgRhs.
- --
-
-{- Done in Core now. Nuke soon. SLPJ Nov 96
- let
- -- ToDo: provide proper flag control!
- binds_to_mangle
- = if not do_unlocalising
- then saturated_binds
- else snd (unlocaliseStgBinds unlocal_tag nullIdEnv no_ind_binds)
- in
--}
-
- return (setStgVarInfo do_let_no_escapes processed_binds, cost_centres)
- }
- where
- do_let_no_escapes = opt_StgDoLetNoEscapes
- do_verbose_stg2stg = opt_D_verbose_stg2stg
+ ([(StgBinding,[Id])], -- output program...
+ ([CostCentre], -- local cost-centres that need to be decl'd
+ [CostCentre], -- "extern" cost-centres
+ [CostCentreStack])) -- pre-defined "singleton" cost centre stacks
+
+stg2stg dflags module_name binds
+ = do { showPass dflags "Stg2Stg"
+ ; us <- mkSplitUniqSupply 'g'
+
+ ; doIfSet_dyn dflags Opt_D_verbose_stg2stg
+ (printDump (text "VERBOSE STG-TO-STG:"))
+
+ ; (binds', us', ccs) <- end_pass us "Stg2Stg" ([],[],[]) binds
+
+ -- Do the main business!
+ ; (processed_binds, _, cost_centres)
+ <- foldl_mn do_stg_pass (binds', us', ccs)
+ (dopt_StgToDo dflags)
+
+ ; let srt_binds = computeSRTs processed_binds