X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscMain.lhs;h=f054d25f9f2d61e97b2df17608980b72a3e3fce2;hb=6bc92166180824bf046d31e378359e3c386150f9;hp=dd88f721f125e12d584bae144fd65f9f8c7e8c4e;hpb=176fa33f17dd78355cc572e006d2ab26898e2c69;p=ghc-hetmet.git

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index dd88f72..f054d25 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -81,6 +81,7 @@ import CodeGen		( codeGen )
 import Cmm              ( Cmm )
 import PprCmm		( pprCmms )
 import CmmParse		( parseCmmFile )
+import CmmBuildInfoTables
 import CmmCPS
 import CmmCPSZ
 import CmmInfo
@@ -667,14 +668,12 @@ hscGenHardCode cgguts mod_summary
              <- {-# SCC "CoreToStg" #-}
                 myCoreToStg dflags this_mod prepd_binds	
 
-         ------------------  Try new code gen route ----------
-         cmms <- tryNewCodeGen hsc_env this_mod data_tycons
-                               dir_imps cost_centre_info
-                               stg_binds hpc_info
-
          ------------------  Code generation ------------------
          cmms <- if dopt Opt_TryNewCodeGen (hsc_dflags hsc_env)
-                 then pprTrace "cmms" (ppr cmms) $ return cmms
+                 then do cmms <- tryNewCodeGen hsc_env this_mod data_tycons
+                                 dir_imps cost_centre_info
+                                 stg_binds hpc_info
+                         pprTrace "cmms" (ppr cmms) $ return cmms
                  else {-# SCC "CodeGen" #-}
                        codeGen dflags this_mod data_tycons
                                dir_imps cost_centre_info
@@ -764,16 +763,21 @@ tryNewCodeGen hsc_env this_mod data_tycons imported_mods
 	; prog <- return $ map (runTx $ runCmmOpts cmmCfgOptsZ) prog
 		-- Control flow optimisation
 
-	; prog <- mapM (protoCmmCPSZ hsc_env) prog
+        -- Note: Have to thread the module's SRT through all the procedures
+        -- because we greedily build it as we go.
+        ; us <- mkSplitUniqSupply 'S'
+        ; let topSRT = initUs_ us emptySRT
+	; (topSRT, prog) <- foldM (protoCmmCPSZ hsc_env) (topSRT, []) prog
 		-- The main CPS conversion
 
-	; prog <- return $ map (runTx $ runCmmOpts cmmCfgOptsZ) prog
+	; prog <- return $ map (runTx $ runCmmOpts cmmCfgOptsZ) (srtToData topSRT : prog)
 		-- Control flow optimisation, again
 
-	; dumpIfSet_dyn dflags Opt_D_dump_cmmz "New Cmm" 
-		(pprCmms prog)
+	; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Output Cmm" (pprCmms prog)
 
-	; return $ map cmmOfZgraph prog }
+	; let prog' = map cmmOfZgraph prog
+	; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Raw Cmm" (ppr prog')
+	; return prog' }
 
 
 optionallyConvertAndOrCPS :: HscEnv -> [Cmm] -> IO [Cmm]
@@ -802,7 +806,9 @@ testCmmConversion hsc_env cmm =
        let cvtm = do g <- cmmToZgraph cmm
                      return $ cfopts g
        let zgraph = initUs_ us cvtm
-       cps_zgraph <- protoCmmCPSZ hsc_env zgraph
+       us <- mkSplitUniqSupply 'S'
+       let topSRT = initUs_ us emptySRT
+       (_, [cps_zgraph]) <- protoCmmCPSZ hsc_env (topSRT, []) zgraph
        let chosen_graph = if dopt Opt_RunCPSZ dflags then cps_zgraph else zgraph
        dumpIfSet_dyn dflags Opt_D_dump_cmmz "C-- Zipper Graph" (ppr chosen_graph)
        showPass dflags "Convert from Z back to Cmm"