X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmCPSZ.hs;h=e72d3f2da9d8b66e4dc57180b4c484c9f28b233d;hb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516;hp=f2e245fc9111890adde48f66425163aef5c2d5c6;hpb=df5b491ce79b42987363ae96bc98b633cf55cca2;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmCPSZ.hs b/compiler/cmm/CmmCPSZ.hs
index f2e245f..e72d3f2 100644
--- a/compiler/cmm/CmmCPSZ.hs
+++ b/compiler/cmm/CmmCPSZ.hs
@@ -1,3 +1,7 @@
+{-# OPTIONS_GHC -XNoMonoLocalBinds #-}
+-- Norman likes local bindings
+-- If this module lives on I'd like to get rid of this flag in due course
+
 module CmmCPSZ (
   -- | Converts C-- with full proceedures and parameters
   -- to a CPS transformed C-- with the stack made manifest.
@@ -46,19 +50,16 @@ protoCmmCPSZ :: HscEnv -- Compilation env including
              -> (TopSRT, [CmmZ])  -- SRT table and accumulating list of compiled procs
              -> CmmZ              -- Input C-- with Procedures
              -> IO (TopSRT, [CmmZ]) -- Output CPS transformed C--
-protoCmmCPSZ hsc_env (topSRT, rst) (Cmm tops)
-  | not (dopt Opt_TryNewCodeGen (hsc_dflags hsc_env))
-  = return (topSRT, Cmm tops : rst)                -- Only if -fnew-codegen
-  | otherwise
-  = do	let dflags = hsc_dflags hsc_env
-        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
-        -- (topSRT, tops) <- foldM (\ z f -> f topCAFEnv z) (topSRT, []) toTops 
-        let cmms = Cmm (reverse (concat tops))
-        dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (ppr cmms)
-        return (topSRT, cmms : rst)
+protoCmmCPSZ hsc_env (topSRT, rst) (Cmm tops) =
+  do let dflags = hsc_dflags hsc_env
+     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
+     -- (topSRT, tops) <- foldM (\ z f -> f topCAFEnv z) (topSRT, []) toTops 
+     let cmms = Cmm (reverse (concat tops))
+     dumpIfSet_dyn dflags Opt_D_dump_cps_cmm "Post CPS Cmm" (ppr cmms)
+     return (topSRT, cmms : rst)
 
 {- [Note global fuel]
 ~~~~~~~~~~~~~~~~~~~~~
@@ -156,7 +157,10 @@ cpsTop hsc_env (CmmProc h l args (stackInfo@(entry_off, _), g)) =
   where dflags = hsc_dflags hsc_env
         mbpprTrace x y z = if dopt Opt_D_dump_cmmz dflags then pprTrace x y z else z
         dump f txt g = dumpIfSet_dyn dflags f txt (ppr g)
+
+        run :: FuelMonad a -> IO a
         run = runFuelIO (hsc_OptFuel hsc_env)
+
         dual_rewrite flag txt pass g =
           do dump flag ("Pre " ++ txt)  g
              g <- run $ pass g