diff options
Diffstat (limited to 'compiler/cmm/CmmPipeline.hs')
| -rw-r--r-- | compiler/cmm/CmmPipeline.hs | 27 |
1 files changed, 14 insertions, 13 deletions
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs index 37dbd12525..b19e4180f8 100644 --- a/compiler/cmm/CmmPipeline.hs +++ b/compiler/cmm/CmmPipeline.hs @@ -31,7 +31,7 @@ import Platform ----------------------------------------------------------------------------- cmmPipeline :: HscEnv -- Compilation env including - -- dynamic flags: -dcmm-lint -ddump-cps-cmm + -- dynamic flags: -dcmm-lint -ddump-cmm-cps -> TopSRT -- SRT table and accumulating list of compiled procs -> CmmGroup -- Input C-- with Procedures -> IO (TopSRT, CmmGroup) -- Output CPS transformed C-- @@ -42,7 +42,7 @@ cmmPipeline hsc_env topSRT prog = tops <- {-# SCC "tops" #-} mapM (cpsTop hsc_env) prog (topSRT, cmms) <- {-# SCC "doSRTs" #-} doSRTs dflags topSRT tops - dumpWith dflags Opt_D_dump_cmm_cps "Post CPS Cmm" cmms + dumpWith dflags Opt_D_dump_cmm_cps "Post CPS Cmm" (ppr cmms) return (topSRT, cmms) @@ -83,7 +83,7 @@ cpsTop hsc_env proc = then do pp <- {-# SCC "minimalProcPointSet" #-} runUniqSM $ minimalProcPointSet (targetPlatform dflags) call_pps g - dumpIfSet_dyn dflags Opt_D_dump_cmm "Proc points" + dumpWith dflags Opt_D_dump_cmm_proc "Proc points" (ppr l $$ ppr pp $$ ppr g) return pp else @@ -104,14 +104,15 @@ cpsTop hsc_env proc = ------------- CAF analysis ---------------------------------------------- let cafEnv = {-# SCC "cafAnal" #-} cafAnal g - dumpIfSet_dyn dflags Opt_D_dump_cmm "CAFEnv" (ppr cafEnv) + dumpWith dflags Opt_D_dump_cmm_caf "CAFEnv" (ppr cafEnv) g <- if splitting_proc_points then do ------------- Split into separate procedures ----------------------- pp_map <- {-# SCC "procPointAnalysis" #-} runUniqSM $ procPointAnalysis proc_points g - dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" pp_map + dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" $ + ppr pp_map g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $ splitAtProcPoints dflags l call_pps proc_points pp_map (CmmProc h l v g) @@ -142,7 +143,7 @@ cpsTop hsc_env proc = dump = dumpGraph dflags dumps flag name - = mapM_ (dumpWith dflags flag name) + = mapM_ (dumpWith dflags flag name . ppr) condPass flag pass g dumpflag dumpname = if gopt flag dflags @@ -346,7 +347,7 @@ runUniqSM m = do dumpGraph :: DynFlags -> DumpFlag -> String -> CmmGraph -> IO () dumpGraph dflags flag name g = do when (gopt Opt_DoCmmLinting dflags) $ do_lint g - dumpWith dflags flag name g + dumpWith dflags flag name (ppr g) where do_lint g = case cmmLintGraph dflags g of Just err -> do { fatalErrorMsg dflags err @@ -354,11 +355,11 @@ dumpGraph dflags flag name g = do } Nothing -> return () -dumpWith :: Outputable a => DynFlags -> DumpFlag -> String -> a -> IO () -dumpWith dflags flag txt g = do +dumpWith :: DynFlags -> DumpFlag -> String -> SDoc -> IO () +dumpWith dflags flag txt sdoc = do -- ToDo: No easy way of say "dump all the cmm, *and* split - -- them into files." Also, -ddump-cmm doesn't play nicely - -- with -ddump-to-file, since the headers get omitted. - dumpIfSet_dyn dflags flag txt (ppr g) + -- them into files." Also, -ddump-cmm-verbose doesn't play + -- nicely with -ddump-to-file, since the headers get omitted. + dumpIfSet_dyn dflags flag txt sdoc when (not (dopt flag dflags)) $ - dumpIfSet_dyn dflags Opt_D_dump_cmm txt (ppr g) + dumpIfSet_dyn dflags Opt_D_dump_cmm_verbose txt sdoc |