[project @ 2000-11-10 15:12:50 by simonpj]

[ghc-hetmet.git] / ghc / compiler / simplCore / SimplCore.lhs

diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs
index 723b776..7b9ae30 100644 (file)
--- a/ghc/compiler/simplCore/SimplCore.lhs
+++ b/ghc/compiler/simplCore/SimplCore.lhs
@@ -11,14 +11,15 @@ module SimplCore ( core2core ) where
 import CmdLineOpts     ( CoreToDo(..), SimplifierSwitch(..), 
                          SwitchResult(..), intSwitchSet,
                           opt_UsageSPOn,
-                         DynFlags, DynFlag(..), dopt
+                         DynFlags, DynFlag(..), dopt, dopt_CoreToDo
                        )
-import CoreLint                ( beginPass, endPass )
+import CoreLint                ( showPass, endPass )
 import CoreSyn
 import CoreFVs         ( ruleSomeFreeVars )
 import HscTypes                ( PackageRuleBase, HomeSymbolTable, ModDetails(..) )
 import CSE             ( cseProgram )
-import Rules           ( RuleBase, emptyRuleBase, ruleBaseFVs, ruleBaseIds, extendRuleBaseList, addRuleBaseFVs )
+import Rules           ( RuleBase, emptyRuleBase, ruleBaseFVs, ruleBaseIds, 
+                         extendRuleBaseList, addRuleBaseFVs )
 import Module          ( moduleEnvElts )
 import CoreUnfold
 import PprCore         ( pprCoreBindings, pprIdCoreRule )
@@ -54,16 +55,16 @@ import List             ( partition )
 %************************************************************************
 
 \begin{code}
-core2core :: DynFlags 
+core2core :: DynFlags          -- includes spec of what core-to-core passes to do
          -> PackageRuleBase    -- Rule-base accumulated from imported packages
          -> HomeSymbolTable
-         -> [CoreToDo]         -- Spec of what core-to-core passes to do
          -> [CoreBind]         -- Binds in
          -> [IdCoreRule]       -- Rules in
          -> IO ([CoreBind], [IdCoreRule])  -- binds, local orphan rules out
 
-core2core dflags pkg_rule_base hst core_todos binds rules
+core2core dflags pkg_rule_base hst binds rules
   = do
+        let core_todos = dopt_CoreToDo dflags
        us <-  mkSplitUniqSupply 's'
        let (cp_us, ru_us) = splitUniqSupply us
 
@@ -131,6 +132,8 @@ doCorePass dfs rb us binds CoreDoUSPInf
    = _scc_ "CoreUsageSPInf" noStats dfs (doUsageSPInf dfs us binds)
 doCorePass dfs rb us binds CoreDoGlomBinds             
    = noStats dfs (glomBinds dfs binds)
+doCorePass dfs rb us binds CoreDoNothing
+   = noStats dfs (return binds)
 
 printCore binds = do dumpIfSet True "Print Core"
                               (pprCoreBindings binds)
@@ -294,7 +297,7 @@ glomBinds :: DynFlags -> [CoreBind] -> IO [CoreBind]
 -- analyser as free in f.
 
 glomBinds dflags binds
-  = do { beginPass dflags "GlomBinds" ;
+  = do { showPass dflags "GlomBinds" ;
         let { recd_binds = [Rec (flattenBinds binds)] } ;
         return recd_binds }
        -- Not much point in printing the result... 
@@ -319,7 +322,7 @@ simplifyPgm :: DynFlags
 simplifyPgm dflags rule_base
            sw_chkr us binds
   = do {
-       beginPass dflags "Simplify";
+       showPass dflags "Simplify";
 
        (termination_msg, it_count, counts_out, binds') 
           <- iteration us 1 (zeroSimplCount dflags) binds;