Commit 20765b55 authored by simonmar's avatar simonmar
Browse files

[project @ 1999-06-24 12:25:58 by simonmar]

Minor cleanup
parent 53806509
...@@ -47,13 +47,13 @@ stg2stg :: [StgToDo] -- spec of what stg-to-stg passes to do ...@@ -47,13 +47,13 @@ stg2stg :: [StgToDo] -- spec of what stg-to-stg passes to do
stg2stg stg_todos module_name us binds stg2stg stg_todos module_name us binds
= case (splitUniqSupply us) of { (us4now, us4later) -> = case (splitUniqSupply us) of { (us4now, us4later) ->
doIfSet do_verbose_stg2stg doIfSet opt_D_verbose_stg2stg (printErrs (text "VERBOSE STG-TO-STG:")) >>
(printErrs (text "VERBOSE STG-TO-STG:" $$
text "*** Core2Stg:" $$ end_pass us4now "Core2Stg" ([],[],[]) binds
vcat (map ppr (setStgVarInfo False binds)))) >> >>= \ (binds', us, ccs) ->
-- Do the main business! -- Do the main business!
foldl_mn do_stg_pass (binds, us4now, ([],[],[])) stg_todos foldl_mn do_stg_pass (binds', us, ccs) stg_todos
>>= \ (processed_binds, _, cost_centres) -> >>= \ (processed_binds, _, cost_centres) ->
-- Do essential wind-up -- Do essential wind-up
...@@ -70,7 +70,7 @@ stg2stg stg_todos module_name us binds ...@@ -70,7 +70,7 @@ stg2stg stg_todos module_name us binds
-- --
let let
annotated_binds = setStgVarInfo do_let_no_escapes processed_binds annotated_binds = setStgVarInfo opt_StgDoLetNoEscapes processed_binds
srt_binds = computeSRTs annotated_binds srt_binds = computeSRTs annotated_binds
in in
...@@ -79,10 +79,8 @@ stg2stg stg_todos module_name us binds ...@@ -79,10 +79,8 @@ stg2stg stg_todos module_name us binds
return (srt_binds, cost_centres) return (srt_binds, cost_centres)
} }
where
do_let_no_escapes = opt_StgDoLetNoEscapes
do_verbose_stg2stg = opt_D_verbose_stg2stg
where
grp_name = case (opt_SccGroup) of grp_name = case (opt_SccGroup) of
Just xx -> _PK_ xx Just xx -> _PK_ xx
Nothing -> _PK_ (moduleString module_name) -- default: module name Nothing -> _PK_ (moduleString module_name) -- default: module name
...@@ -115,7 +113,7 @@ stg2stg stg_todos module_name us binds ...@@ -115,7 +113,7 @@ stg2stg stg_todos module_name us binds
_scc_ "StgLambdaLift" _scc_ "StgLambdaLift"
-- NB We have to do setStgVarInfo first! -- NB We have to do setStgVarInfo first!
let let
binds3 = liftProgram module_name us1 (setStgVarInfo do_let_no_escapes binds) binds3 = liftProgram module_name us1 (setStgVarInfo opt_StgDoLetNoEscapes binds)
in in
end_pass us2 "LambdaLift" ccs binds3 end_pass us2 "LambdaLift" ccs binds3
...@@ -129,7 +127,7 @@ stg2stg stg_todos module_name us binds ...@@ -129,7 +127,7 @@ stg2stg stg_todos module_name us binds
end_pass us2 what ccs binds2 end_pass us2 what ccs binds2
= -- report verbosely, if required = -- report verbosely, if required
(if do_verbose_stg2stg then (if opt_D_verbose_stg2stg then
hPutStr stderr (showSDoc hPutStr stderr (showSDoc
(text ("*** "++what++":") $$ vcat (map ppr binds2) (text ("*** "++what++":") $$ vcat (map ppr binds2)
)) ))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment