X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscMain.lhs;h=582b80da6c51f5dbe204f97fe424287dc495b367;hb=cb4bdf74a41da1e16f2f0dd42ef2338b564c3930;hp=d52337ed1ff4320e72fb6d13d0e36ccd106e792f;hpb=94bf0d3604ff0d2ecab246924af712bdd1c29a40;p=ghc-hetmet.git

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index d52337e..582b80d 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -113,17 +113,15 @@ import TyCon		( TyCon, isDataTyCon )
 import Name		( Name, NamedThing(..) )
 import SimplStg		( stg2stg )
 import CodeGen		( codeGen )
-import Cmm              ( Cmm )
+import OldCmm           ( Cmm )
 import PprCmm		( pprCmms )
 import CmmParse		( parseCmmFile )
 import CmmBuildInfoTables
 import CmmCPS
-import CmmCPSZ
 import CmmInfo
 import OptimizationFuel ( initOptFuelState )
 import CmmCvt
-import CmmTx
-import CmmContFlowOpt
+import CmmContFlowOpt   ( runCmmContFlowOpts )
 import CodeOutput
 import NameEnv          ( emptyNameEnv )
 import NameSet          ( emptyNameSet )
@@ -135,7 +133,6 @@ import DynFlags
 import ErrUtils
 import UniqSupply	( mkSplitUniqSupply )
 
-import MonadUtils
 import Outputable
 import HscStats		( ppSourceStats )
 import HscTypes
@@ -164,9 +161,9 @@ import Data.IORef
 newHscEnv :: DynFlags -> IO HscEnv
 newHscEnv dflags
   = do 	{ eps_var <- newIORef initExternalPackageState
-	; us      <- mkSplitUniqSupply 'r'
-	; nc_var  <- newIORef (initNameCache us knownKeyNames)
-	; fc_var  <- newIORef emptyUFM
+        ; us      <- mkSplitUniqSupply 'r'
+        ; nc_var  <- newIORef (initNameCache us knownKeyNames)
+        ; fc_var  <- newIORef emptyUFM
 	; mlc_var <- newIORef emptyModuleEnv
         ; optFuel <- initOptFuelState
 	; return (HscEnv { hsc_dflags = dflags,
@@ -182,12 +179,13 @@ newHscEnv dflags
                            hsc_type_env_var = Nothing } ) }
 
 
-knownKeyNames :: [Name]	-- Put here to avoid loops involving DsMeta,
-			-- where templateHaskellNames are defined
-knownKeyNames = map getName wiredInThings 
-	      ++ basicKnownKeyNames
+knownKeyNames :: [Name]      -- Put here to avoid loops involving DsMeta,
+                             -- where templateHaskellNames are defined
+knownKeyNames
+  = map getName wiredInThings 
+    ++ basicKnownKeyNames
 #ifdef GHCI
-	      ++ templateHaskellNames
+    ++ templateHaskellNames
 #endif
 
 -- -----------------------------------------------------------------------------
@@ -895,7 +893,7 @@ hscGenHardCode cgguts mod_summary
                                stg_binds hpc_info
 
          --- Optionally run experimental Cmm transformations ---
-         -- cmms <- optionallyConvertAndOrCPS hsc_env cmms
+         cmms <- optionallyConvertAndOrCPS hsc_env cmms
                  -- unless certain dflags are on, the identity function
          ------------------  Code output -----------------------
          rawcmms <- cmmToRawCmm cmms
@@ -975,17 +973,17 @@ tryNewCodeGen hsc_env this_mod data_tycons imported_mods
 	; dumpIfSet_dyn dflags Opt_D_dump_cmmz "Cmm produced by new codegen" 
 		(pprCmms prog)
 
-	; prog <- return $ map (runTx $ runCmmOpts cmmCfgOptsZ) prog
+	; prog <- return $ map runCmmContFlowOpts prog
 		-- Control flow optimisation
 
         -- We are building a single SRT for the entire module, so
         -- we must thread it through all the procedures as we cps-convert them.
         ; us <- mkSplitUniqSupply 'S'
         ; let topSRT = initUs_ us emptySRT
-	; (topSRT, prog) <- foldM (protoCmmCPSZ hsc_env) (topSRT, []) prog
+	; (topSRT, prog) <- foldM (protoCmmCPS hsc_env) (topSRT, []) prog
 		-- The main CPS conversion
 
-	; prog <- return $ map (runTx $ runCmmOpts cmmCfgOptsZ) (srtToData topSRT : prog)
+	; prog <- return $ map runCmmContFlowOpts (srtToData topSRT : prog)
 		-- Control flow optimisation, again
 
 	; let prog' = map cmmOfZgraph prog
@@ -1000,11 +998,6 @@ optionallyConvertAndOrCPS hsc_env cmms =
        cmms <- if dopt Opt_ConvertToZipCfgAndBack dflags
                then mapM (testCmmConversion hsc_env) cmms
                else return cmms
-         ---------  Optionally convert to CPS (MDA) -----------
-       cmms <- if not (dopt Opt_ConvertToZipCfgAndBack dflags) &&
-                  dopt Opt_RunCPS dflags
-               then cmmCPS dflags cmms
-               else return cmms
        return cmms
 
 
@@ -1015,17 +1008,15 @@ testCmmConversion hsc_env cmm =
        dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- pre-conversion" (ppr cmm)
        --continuationC <- cmmCPS dflags abstractC >>= cmmToRawCmm
        us <- mkSplitUniqSupply 'C'
-       let cfopts = runTx $ runCmmOpts cmmCfgOptsZ
-       let cvtm = do g <- cmmToZgraph cmm
-                     return $ cfopts g
+       let cvtm = runCmmContFlowOpts `liftM` cmmToZgraph cmm
        let zgraph = initUs_ us cvtm
        us <- mkSplitUniqSupply 'S'
        let topSRT = initUs_ us emptySRT
-       (_, [cps_zgraph]) <- protoCmmCPSZ hsc_env (topSRT, []) zgraph
+       (_, [cps_zgraph]) <- protoCmmCPS 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"
-       let cvt = cmmOfZgraph $ cfopts $ chosen_graph
+       let cvt = cmmOfZgraph $ runCmmContFlowOpts $ chosen_graph
        dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- post-conversion" (ppr cvt)
        return cvt
 
@@ -1217,6 +1208,7 @@ mkModGuts mod binds = ModGuts {
   mg_insts = [],
   mg_fam_insts = [],
   mg_rules = [],
+  mg_vect_decls = [],
   mg_binds = binds,
   mg_foreign = NoStubs,
   mg_warns = NoWarnings,
@@ -1258,15 +1250,13 @@ hscCompileCoreExpr hsc_env srcspan ds_expr
 
   	-- Lint if necessary
   	-- ToDo: improve SrcLoc
-    if lint_on then 
+    when lint_on $
        let ictxt = hsc_IC hsc_env
            tyvars = varSetElems (tyVarsOfTypes (map idType (ic_tmp_ids ictxt)))
        in
            case lintUnfolding noSrcLoc tyvars prepd_expr of
   	      Just err -> pprPanic "hscCompileCoreExpr" err
   	      Nothing  -> return ()
-    else
-       return ()
 
           -- Convert to BCOs
     bcos <- coreExprToBCOs dflags prepd_expr