From e9d303dcabd6d6dd56660fef7a50f802cfdd5b57 Mon Sep 17 00:00:00 2001
From: Norman Ramsey <nr@eecs.harvard.edu>
Date: Fri, 7 Sep 2007 13:24:42 +0000
Subject: [PATCH] refactor duplicated code in main/HscMain   I kept making
 mistakes because all the ZipCfg and CPS stuff   was called
 from two different places (compiling Haskell and  
 compiling Cmm).  Now it is called from a single place, and
 therefore   successfully turned off by default.

  I still don't know why turning it on causes rts/Apply.cmm not to
  compile; that development is new since yesterday.
---
 compiler/main/HscMain.lhs |   35 ++++++++++++++++++++---------------
 1 file changed, 20 insertions(+), 15 deletions(-)

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 0152549..6491450 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -594,17 +594,9 @@ hscCompile cgguts
                       codeGen dflags this_mod data_tycons
                               dir_imps cost_centre_info
                               stg_binds hpc_info
-         --------  Optionally convert to and from zipper ------
-         cmms <-
-             if dopt Opt_ConvertToZipCfgAndBack dflags
-             then mapM (testCmmConversion dflags) cmms
-             else return cmms
-         ------------  Optionally convert to CPS --------------
-         cmms <-
-             if not (dopt Opt_ConvertToZipCfgAndBack dflags) &&
-                dopt Opt_RunCPSZ dflags
-             then cmmCPS dflags cmms
-             else return cmms
+         --- Optionally run experimental Cmm transformations ---
+         cmms <- optionallyConvertAndOrCPS dflags cmms
+                 -- ^ unless certain dflags are on, the identity function
          ------------------  Code output -----------------------
          rawcmms <- cmmToRawCmm cmms
          (_stub_h_exists, stub_c_exists)
@@ -717,10 +709,9 @@ hscCmmFile dflags filename = do
   case maybe_cmm of
     Nothing -> return False
     Just cmm -> do
-        cmm <- testCmmConversion dflags cmm
-        --continuationC <- cmmCPS dflags cmm >>= cmmToRawCmm
-        continuationC <- cmmToRawCmm [cmm]
-	codeOutput dflags no_mod no_loc NoStubs [] continuationC
+        cmms <- optionallyConvertAndOrCPS dflags [cmm]
+        rawCmms <- cmmToRawCmm cmms
+	codeOutput dflags no_mod no_loc NoStubs [] rawCmms
 	return True
   where
 	no_mod = panic "hscCmmFile: no_mod"
@@ -728,6 +719,20 @@ hscCmmFile dflags filename = do
                               ml_hi_file  = panic "hscCmmFile: no hi file",
                               ml_obj_file = panic "hscCmmFile: no obj file" }
 
+optionallyConvertAndOrCPS :: DynFlags -> [Cmm] -> IO [Cmm]
+optionallyConvertAndOrCPS dflags cmms =
+    do   --------  Optionally convert to and from zipper ------
+       cmms <- if dopt Opt_ConvertToZipCfgAndBack dflags
+               then mapM (testCmmConversion dflags) cmms
+               else return cmms
+         ---------  Optionally convert to CPS (MDA) -----------
+       cmms <- if not (dopt Opt_ConvertToZipCfgAndBack dflags) &&
+                  dopt Opt_RunCPSZ dflags
+               then cmmCPS dflags cmms
+               else return cmms
+       return cmms
+
+
 testCmmConversion :: DynFlags -> Cmm -> IO Cmm
 testCmmConversion dflags cmm =
     do showPass dflags "CmmToCmm"
-- 
1.7.10.4