X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmmPipeline.hs;fp=compiler%2Fcmm%2FCmmCPS.hs;h=a63413cf53b3dba3e73068633b317b67824c699b;hp=35eabb331704e26e3a83cb8468b661105e3eeb36;hb=7e95df790b34e11d7308e43dab0a7175b69b70fc;hpb=c0687066474aa4ce4912f31a5c09c1bcd673fb06

diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmPipeline.hs
similarity index 89%
rename from compiler/cmm/CmmCPS.hs
rename to compiler/cmm/CmmPipeline.hs
index 35eabb3..a63413c 100644
--- a/compiler/cmm/CmmCPS.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -2,11 +2,11 @@
 -- Norman likes local bindings
 -- If this module lives on I'd like to get rid of this flag in due course
 
-module CmmCPS (
-  -- | Converts C-- with full proceedures and parameters
-  -- to a CPS transformed C-- with the stack made manifest.
-  -- Well, sort of.
-  protoCmmCPS
+module CmmPipeline (
+  -- | Converts C-- with an implicit stack and native C-- calls into
+  -- optimized, CPS converted and native-call-less C--.  The latter
+  -- C-- can be used to generate assembly.
+  cmmPipeline
 ) where
 
 import CLabel
@@ -16,7 +16,9 @@ import CmmBuildInfoTables
 import CmmCommonBlockElim
 import CmmProcPoint
 import CmmSpillReload
+import CmmRewriteAssignments
 import CmmStackLayout
+import CmmContFlowOpt
 import OptimizationFuel
 
 import DynFlags
@@ -30,7 +32,7 @@ import Outputable
 import StaticFlags
 
 -----------------------------------------------------------------------------
--- |Top level driver for the CPS pass
+-- | Top level driver for C-- pipeline
 -----------------------------------------------------------------------------
 -- There are two complications here:
 -- 1. We need to compile the procedures in two stages because we need
@@ -45,20 +47,27 @@ import StaticFlags
 -- 2. We need to thread the module's SRT around when the SRT tables
 --    are computed for each procedure.
 --    The SRT needs to be threaded because it is grown lazily.
-protoCmmCPS  :: HscEnv -- Compilation env including
+-- 3. We run control flow optimizations twice, once before any pipeline
+--    work is done, and once again at the very end on all of the
+--    resulting C-- blocks.  EZY: It's unclear whether or not whether
+--    we actually need to do the initial pass.
+cmmPipeline  :: HscEnv -- Compilation env including
                        -- dynamic flags: -dcmm-lint -ddump-cps-cmm
              -> (TopSRT, [Cmm])    -- SRT table and accumulating list of compiled procs
              -> Cmm                -- Input C-- with Procedures
              -> IO (TopSRT, [Cmm]) -- Output CPS transformed C--
-protoCmmCPS hsc_env (topSRT, rst) (Cmm tops) =
+cmmPipeline hsc_env (topSRT, rst) prog =
   do let dflags = hsc_dflags hsc_env
+         (Cmm tops) = runCmmContFlowOpts prog
      showPass dflags "CPSZ"
      (cafEnvs, tops) <- liftM unzip $ mapM (cpsTop hsc_env) tops
      let topCAFEnv = mkTopCAFInfo (concat cafEnvs)
      (topSRT, tops) <- foldM (toTops hsc_env topCAFEnv) (topSRT, []) tops
      let cmms = Cmm (reverse (concat tops))
      dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (ppr cmms)
-     return (topSRT, cmms : rst)
+     -- SRT is not affected by control flow optimization pass
+     let prog' = map runCmmContFlowOpts (cmms : rst)
+     return (topSRT, prog')
 
 {- [Note global fuel]
 ~~~~~~~~~~~~~~~~~~~~~