diff options
Diffstat (limited to 'compiler/GHC/Cmm/Pipeline.hs')
| -rw-r--r-- | compiler/GHC/Cmm/Pipeline.hs | 11 |
1 files changed, 7 insertions, 4 deletions
diff --git a/compiler/GHC/Cmm/Pipeline.hs b/compiler/GHC/Cmm/Pipeline.hs index ff61a2a7a4..5aef5a3cad 100644 --- a/compiler/GHC/Cmm/Pipeline.hs +++ b/compiler/GHC/Cmm/Pipeline.hs @@ -84,7 +84,7 @@ cpsTop logger platform dflags proc = ----------- Implement switches ------------------------------------------ g <- {-# SCC "createSwitchPlans" #-} - runUniqSMIO $ cmmImplementSwitchPlans (backend dflags) platform g + runUniqSM $ cmmImplementSwitchPlans (backend dflags) platform g dump Opt_D_dump_cmm_switch "Post switch plan" g ----------- Proc points ------------------------------------------------- @@ -94,7 +94,7 @@ cpsTop logger platform dflags proc = proc_points <- if splitting_proc_points then do - pp <- {-# SCC "minimalProcPointSet" #-} runUniqSMIO $ + pp <- {-# SCC "minimalProcPointSet" #-} runUniqSM $ minimalProcPointSet platform call_pps g dumpWith logger Opt_D_dump_cmm_proc "Proc points" FormatCMM (pdoc platform l $$ ppr pp $$ pdoc platform g) @@ -106,7 +106,7 @@ cpsTop logger platform dflags proc = (g, stackmaps) <- {-# SCC "layoutStack" #-} if do_layout - then runUniqSMIO $ cmmLayoutStack dflags proc_points entry_off g + then runUniqSM $ cmmLayoutStack dflags proc_points entry_off g else return (g, mapEmpty) dump Opt_D_dump_cmm_sp "Layout Stack" g @@ -126,7 +126,7 @@ cpsTop logger platform dflags proc = procPointAnalysis proc_points g dumpWith logger Opt_D_dump_cmm_procmap "procpoint map" FormatCMM (ppr pp_map) - g <- {-# SCC "splitAtProcPoints" #-} runUniqSMIO $ + g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $ splitAtProcPoints platform l call_pps proc_points pp_map (CmmProc h l v g) dumps Opt_D_dump_cmm_split "Post splitting" g @@ -341,6 +341,9 @@ generator later. -} +runUniqSM :: UniqSM a -> IO a +runUniqSM = runUniqSMIO 'u' + dumpGraph :: Logger -> Platform -> DynFlags -> DumpFlag -> String -> CmmGraph -> IO () dumpGraph logger platform dflags flag name g = do when (gopt Opt_DoCmmLinting dflags) $ do_lint g |