Commit 2c7fe84e authored by simonpj's avatar simonpj
Browse files

[project @ 2000-09-07 16:28:44 by simonpj]

Do the begin-pass/end-pass stuff like the other core passes
parent 5439bab7
......@@ -72,16 +72,14 @@ tidyCorePgm us module_name binds_in rulebase_in
= do
beginPass "Tidy Core"
(binds_in1,mrulebase_in1) <- if opt_UsageSPOn
then _scc_ "CoreUsageSPInf"
doUsageSPInf us binds_in rulebase_in
else return (binds_in,Nothing)
binds_in1 <- if opt_UsageSPOn
then _scc_ "CoreUsageSPInf"
doUsageSPInf us binds_in rulebase_in
else return binds_in
let rulebase_in1 = maybe rulebase_in id mrulebase_in1
(tidy_env1, binds_out) = mapAccumL (tidyBind (Just module_name))
let (tidy_env1, binds_out) = mapAccumL (tidyBind (Just module_name))
init_tidy_env binds_in1
rules_out = tidyProtoRules tidy_env1 (mk_local_protos rulebase_in1)
rules_out = tidyProtoRules tidy_env1 (mk_local_protos rulebase_in)
endPass "Tidy Core" (opt_D_dump_simpl || opt_D_verbose_core2core) binds_out
return (binds_out, rules_out)
......
......@@ -39,7 +39,8 @@ import UniqSupply ( UniqSupply, UniqSM,
import Outputable
import Maybes ( expectJust )
import List ( unzip4 )
import CmdLineOpts ( opt_D_dump_usagesp, opt_DoUSPLinting )
import CmdLineOpts ( opt_D_dump_usagesp, opt_DoUSPLinting, opt_UsageSPOn )
import CoreLint ( beginPass, endPass )
import ErrUtils ( doIfSet, dumpIfSet )
import PprCore ( pprCoreBindings )
\end{code}
......@@ -91,36 +92,42 @@ monad.
doUsageSPInf :: UniqSupply
-> [CoreBind]
-> RuleBase
-> IO ([CoreBind], Maybe RuleBase)
-> IO [CoreBind]
doUsageSPInf us binds local_rules
= do
let binds1 = doUnAnnotBinds binds
dumpIfSet opt_D_dump_usagesp "UsageSPInf unannot'd" $
| not opt_UsageSPOn
= do { printErrs (text "WARNING: ignoring requested -fusagesp pass; requires -fusagesp-on") ;
return binds
}
| otherwise
= do
let binds1 = doUnAnnotBinds binds
beginPass "UsageSPInf"
dumpIfSet opt_D_dump_usagesp "UsageSPInf unannot'd" $
pprCoreBindings binds1
let ((binds2,ucs,_),_)
= initUs us (uniqSMMToUs (usgInfBinds emptyVarEnv binds1))
dumpIfSet opt_D_dump_usagesp "UsageSPInf annot'd" $
pprCoreBindings binds2
let ms = solveUCS ucs
s = case ms of
Just s -> s
Nothing -> panic "doUsageSPInf: insol. conset!"
binds3 = appUSubstBinds s binds2
doIfSet opt_DoUSPLinting $
do doLintUSPAnnotsBinds binds3 -- lint check 1
doLintUSPConstBinds binds3 -- lint check 2 (force solution)
doCheckIfWorseUSP binds binds3 -- check for worsening of usages
dumpIfSet opt_D_dump_usagesp "UsageSPInf" $
pprCoreBindings binds3
let ((binds2,ucs,_),_) = initUs us (uniqSMMToUs (usgInfBinds emptyVarEnv binds1))
return (binds3, Nothing)
dumpIfSet opt_D_dump_usagesp "UsageSPInf annot'd" $
pprCoreBindings binds2
let ms = solveUCS ucs
s = case ms of
Just s -> s
Nothing -> panic "doUsageSPInf: insol. conset!"
binds3 = appUSubstBinds s binds2
doIfSet opt_DoUSPLinting $
do doLintUSPAnnotsBinds binds3 -- lint check 1
doLintUSPConstBinds binds3 -- lint check 2 (force solution)
doCheckIfWorseUSP binds binds3 -- check for worsening of usages
endPass "UsageSPInf" opt_D_dump_usagesp binds3
return binds3
\end{code}
======================================================================
......
......@@ -165,7 +165,7 @@ for us. @sigVarTyMF@ checks the variable to see how to set the flags.
@hasLocalDef@ tells us if the given variable has an actual local
definition that we can play with. This is not quite the same as
@isLocallyDefined@, since @mayHaveNoBindingId@ things (usually) don't have
@isLocallyDefined@, since @hasNoBindingId@ things (usually) don't have
a local definition - the simplifier will inline whatever their
unfolding is anyway. We treat these as if they were externally
defined, since we don't have access to their definition (at least not
......
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