diff options
Diffstat (limited to 'compiler/main')
| -rw-r--r-- | compiler/main/CodeOutput.lhs | 10 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 2 | ||||
| -rw-r--r-- | compiler/main/HscMain.lhs | 45 |
3 files changed, 9 insertions, 48 deletions
diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index 3ff35b6b92..597f9621d3 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -18,7 +18,7 @@ import PprC ( writeCs ) import CmmLint ( cmmLint ) import Packages import Util -import OldCmm ( RawCmm ) +import OldCmm ( RawCmmPgm ) import HscTypes import DynFlags import Config @@ -48,7 +48,7 @@ codeOutput :: DynFlags -> ModLocation -> ForeignStubs -> [PackageId] - -> [RawCmm] -- Compiled C-- + -> [RawCmmPgm] -- Compiled C-- -> IO (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}) codeOutput dflags this_mod location foreign_stubs pkg_deps flat_abstractC @@ -96,7 +96,7 @@ doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action \begin{code} outputC :: DynFlags -> FilePath - -> [RawCmm] + -> [RawCmmPgm] -> [PackageId] -> IO () @@ -134,7 +134,7 @@ outputC dflags filenm flat_absC packages %************************************************************************ \begin{code} -outputAsm :: DynFlags -> FilePath -> [RawCmm] -> IO () +outputAsm :: DynFlags -> FilePath -> [RawCmmPgm] -> IO () outputAsm dflags filenm flat_absC | cGhcWithNativeCodeGen == "YES" = do ncg_uniqs <- mkSplitUniqSupply 'n' @@ -155,7 +155,7 @@ outputAsm dflags filenm flat_absC %************************************************************************ \begin{code} -outputLlvm :: DynFlags -> FilePath -> [RawCmm] -> IO () +outputLlvm :: DynFlags -> FilePath -> [RawCmmPgm] -> IO () outputLlvm dflags filenm flat_absC = do ncg_uniqs <- mkSplitUniqSupply 'n' doOutput filenm $ \f -> llvmCodeGen dflags f ncg_uniqs flat_absC diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 5b23876b36..03530b1e54 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -283,7 +283,6 @@ data DynFlag -- temporary flags | Opt_RunCPS | Opt_RunCPSZ - | Opt_ConvertToZipCfgAndBack | Opt_AutoLinkPackages | Opt_ImplicitImportQualified | Opt_TryNewCodeGen @@ -1734,7 +1733,6 @@ fFlags = [ ( "run-cps", AlwaysAllowed, Opt_RunCPS, nop ), ( "run-cpsz", AlwaysAllowed, Opt_RunCPSZ, nop ), ( "new-codegen", AlwaysAllowed, Opt_TryNewCodeGen, nop ), - ( "convert-to-zipper-and-back", AlwaysAllowed, Opt_ConvertToZipCfgAndBack, nop ), ( "vectorise", AlwaysAllowed, Opt_Vectorise, nop ), ( "regs-graph", AlwaysAllowed, Opt_RegsGraph, nop ), ( "regs-iterative", AlwaysAllowed, Opt_RegsIterative, nop ), diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index ae858fde28..c43c396c64 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -115,7 +115,7 @@ import TyCon ( TyCon, isDataTyCon ) import Name ( Name, NamedThing(..) ) import SimplStg ( stg2stg ) import CodeGen ( codeGen ) -import OldCmm ( Cmm ) +import OldCmm as Old ( CmmPgm ) import PprCmm ( pprCmms ) import CmmParse ( parseCmmFile ) import CmmBuildInfoTables @@ -123,7 +123,6 @@ import CmmPipeline import CmmInfo import OptimizationFuel ( initOptFuelState ) import CmmCvt -import CmmContFlowOpt ( runCmmContFlowOpts ) import CodeOutput import NameEnv ( emptyNameEnv ) import NameSet ( emptyNameSet ) @@ -1114,17 +1113,14 @@ hscGenHardCode cgguts mod_summary ------------------ Code generation ------------------ cmms <- if dopt Opt_TryNewCodeGen dflags - then do cmms <- tryNewCodeGen hsc_env this_mod data_tycons + then tryNewCodeGen hsc_env this_mod data_tycons cost_centre_info stg_binds hpc_info - return cmms else {-# SCC "CodeGen" #-} codeGen dflags this_mod data_tycons cost_centre_info stg_binds hpc_info - --- Optionally run experimental Cmm transformations --- - cmms <- optionallyConvertAndOrCPS hsc_env cmms -- unless certain dflags are on, the identity function ------------------ Code output ----------------------- rawcmms <- cmmToRawCmm cmms @@ -1179,8 +1175,7 @@ hscCompileCmmFile hsc_env filename let dflags = hsc_dflags hsc_env cmm <- ioMsgMaybe $ parseCmmFile dflags filename liftIO $ do - cmms <- optionallyConvertAndOrCPS hsc_env [cmm] - rawCmms <- cmmToRawCmm cmms + rawCmms <- cmmToRawCmm [cmm] _ <- codeOutput dflags no_mod no_loc NoStubs [] rawCmms return () where @@ -1195,7 +1190,7 @@ tryNewCodeGen :: HscEnv -> Module -> [TyCon] -> CollectedCCs -> [(StgBinding,[(Id,[Id])])] -> HpcInfo - -> IO [Cmm] + -> IO [Old.CmmPgm] tryNewCodeGen hsc_env this_mod data_tycons cost_centre_info stg_binds hpc_info = do { let dflags = hsc_dflags hsc_env @@ -1216,38 +1211,6 @@ tryNewCodeGen hsc_env this_mod data_tycons ; return prog' } -optionallyConvertAndOrCPS :: HscEnv -> [Cmm] -> IO [Cmm] -optionallyConvertAndOrCPS hsc_env cmms = - do let dflags = hsc_dflags hsc_env - -------- Optionally convert to and from zipper ------ - cmms <- if dopt Opt_ConvertToZipCfgAndBack dflags - then mapM (testCmmConversion hsc_env) cmms - else return cmms - return cmms - - -testCmmConversion :: HscEnv -> Cmm -> IO Cmm -testCmmConversion hsc_env cmm = - do let dflags = hsc_dflags hsc_env - platform = targetPlatform dflags - showPass dflags "CmmToCmm" - dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- pre-conversion" (pprPlatform platform cmm) - --continuationC <- cmmCPS dflags abstractC >>= cmmToRawCmm - us <- mkSplitUniqSupply 'C' - let zgraph = initUs_ us (cmmToZgraph platform cmm) - chosen_graph <- - if dopt Opt_RunCPSZ dflags - then do us <- mkSplitUniqSupply 'S' - let topSRT = initUs_ us emptySRT - (_, [zgraph]) <- cmmPipeline hsc_env (topSRT, []) zgraph - return zgraph - else return (runCmmContFlowOpts zgraph) - dumpIfSet_dyn dflags Opt_D_dump_cmmz "C-- Zipper Graph" (pprPlatform platform chosen_graph) - showPass dflags "Convert from Z back to Cmm" - let cvt = cmmOfZgraph chosen_graph - dumpIfSet_dyn dflags Opt_D_dump_cvt_cmm "C-- post-conversion" (pprPlatform platform cvt) - return cvt - myCoreToStg :: DynFlags -> Module -> [CoreBind] -> IO ( [(StgBinding,[(Id,[Id])])] -- output program , CollectedCCs) -- cost centre info (declared and used) |