2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 \section[SimplStg]{Driver for simplifying @STG@ programs}
7 module SimplStg ( stg2stg ) where
9 #include "HsVersions.h"
13 import CostCentre ( CostCentre, CostCentreStack )
14 import SCCfinal ( stgMassageForProfiling )
15 import StgLint ( lintStgBindings )
16 import StgStats ( showStgStats )
17 import SRT ( computeSRTs )
19 import CmdLineOpts ( DynFlags, DynFlag(..), dopt,
20 StgToDo(..), dopt_StgToDo
23 import Module ( Module )
24 import ErrUtils ( doIfSet_dyn, dumpIfSet_dyn, showPass )
25 import UniqSupply ( mkSplitUniqSupply, splitUniqSupply )
30 stg2stg :: DynFlags -- includes spec of what stg-to-stg passes to do
31 -> Module -- module name (profiling only)
32 -> [StgBinding] -- input...
34 ([(StgBinding,[Id])], -- output program...
35 ([CostCentre], -- local cost-centres that need to be decl'd
36 [CostCentre], -- "extern" cost-centres
37 [CostCentreStack])) -- pre-defined "singleton" cost centre stacks
39 stg2stg dflags module_name binds
40 = do { showPass dflags "Stg2Stg"
41 ; us <- mkSplitUniqSupply 'g'
43 ; doIfSet_dyn dflags Opt_D_verbose_stg2stg
44 (printDump (text "VERBOSE STG-TO-STG:"))
46 ; (binds', us', ccs) <- end_pass us "Stg2Stg" ([],[],[]) binds
48 -- Do the main business!
49 ; (processed_binds, _, cost_centres)
50 <- foldl_mn do_stg_pass (binds', us', ccs)
53 ; let srt_binds = computeSRTs processed_binds
55 ; dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:"
56 (pprStgBindingsWithSRTs srt_binds)
58 ; return (srt_binds, cost_centres)
62 stg_linter = if dopt Opt_DoStgLinting dflags
64 else ( \ whodunnit binds -> binds )
66 -------------------------------------------
67 do_stg_pass (binds, us, ccs) to_do
69 (us1, us2) = splitUniqSupply us
73 trace (showStgStats binds)
74 end_pass us2 "StgStats" ccs binds
76 StgDoMassageForProfiling ->
79 (collected_CCs, binds3)
80 = stgMassageForProfiling module_name us1 binds
82 end_pass us2 "ProfMassage" collected_CCs binds3
84 end_pass us2 what ccs binds2
85 = do -- report verbosely, if required
86 dumpIfSet_dyn dflags Opt_D_verbose_stg2stg what
87 (vcat (map ppr binds2))
88 let linted_binds = stg_linter what binds2
89 return (linted_binds, us2, ccs)
90 -- return: processed binds
91 -- UniqueSupply for the next guy to use
92 -- cost-centres to be declared/registered (specialised)
93 -- add to description of what's happened (reverse order)
95 -- here so it can be inlined...
96 foldl_mn f z [] = return z
97 foldl_mn f z (x:xs) = f z x >>= \ zz ->