diff options
author | Jan Stolarek <jan.stolarek@p.lodz.pl> | 2014-02-03 12:26:14 +0100 |
---|---|---|
committer | Jan Stolarek <jan.stolarek@p.lodz.pl> | 2014-02-03 14:18:56 +0100 |
commit | dba9bf6723472eaf4be4813a6ca5ed910e33395d (patch) | |
tree | b1ecbd4cd02179c990eb29ef285bad5533bd8b82 | |
parent | 526cbc7a415eb467adbc13e55a80d8a5abbd02ba (diff) | |
download | haskell-dba9bf6723472eaf4be4813a6ca5ed910e33395d.tar.gz |
Eliminate duplicate code in Cmm pipeline
End of Cmm pipeline used to be split into two alternative flows,
depending on whether we did proc-point splitting or not. There
was a lot of code duplication between these two branches. But it
wasn't really necessary as the differences can be easily enclosed
within an if-then-else. I observed no impact of this change on
compilation performance.
-rw-r--r-- | compiler/cmm/CmmPipeline.hs | 81 |
1 files changed, 30 insertions, 51 deletions
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs index 98b398f7cc..1447f6d8cd 100644 --- a/compiler/cmm/CmmPipeline.hs +++ b/compiler/cmm/CmmPipeline.hs @@ -84,10 +84,6 @@ cpsTop hsc_env proc = else return call_pps - let noncall_pps = proc_points `setDifference` call_pps - when (not (setNull noncall_pps) && dopt Opt_D_dump_cmm dflags) $ - pprTrace "Non-call proc points: " (ppr noncall_pps) $ return () - ----------- Layout the stack and manifest Sp ---------------------------- (g, stackmaps) <- {-# SCC "layoutStack" #-} @@ -105,57 +101,40 @@ cpsTop hsc_env proc = let cafEnv = {-# SCC "cafAnal" #-} cafAnal g dumpIfSet_dyn dflags Opt_D_dump_cmm "CAFEnv" (ppr cafEnv) - 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 - gs <- {-# SCC "splitAtProcPoints" #-} runUniqSM $ - splitAtProcPoints dflags l call_pps proc_points pp_map - (CmmProc h l v g) - dumps Opt_D_dump_cmm_split "Post splitting" gs - - ------------- Populate info tables with stack info ----------------- - gs <- {-# SCC "setInfoTableStackMap" #-} - return $ map (setInfoTableStackMap dflags stackmaps) gs - dumps Opt_D_dump_cmm_info "after setInfoTableStackMap" gs - - ----------- Control-flow optimisations ----------------------------- - gs <- {-# SCC "cmmCfgOpts(2)" #-} - return $ if optLevel dflags >= 1 - then map (cmmCfgOptsProc splitting_proc_points) gs - else gs - gs <- return (map removeUnreachableBlocksProc gs) - -- Note [unreachable blocks] - dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" gs - - return (cafEnv, gs) - - else do - -- attach info tables to return points - g <- return $ attachContInfoTables call_pps (CmmProc h l v g) - - ------------- Populate info tables with stack info ----------------- - g <- {-# SCC "setInfoTableStackMap" #-} - return $ setInfoTableStackMap dflags stackmaps g - dump' Opt_D_dump_cmm_info "after setInfoTableStackMap" g - - ----------- Control-flow optimisations ----------------------------- - g <- {-# SCC "cmmCfgOpts(2)" #-} - return $ if optLevel dflags >= 1 - then cmmCfgOptsProc splitting_proc_points g - else g - g <- return (removeUnreachableBlocksProc g) - -- Note [unreachable blocks] - dump' Opt_D_dump_cmm_cfg "Post control-flow optimisations" g - - return (cafEnv, [g]) + 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 + g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $ + splitAtProcPoints dflags l call_pps proc_points pp_map + (CmmProc h l v g) + dumps Opt_D_dump_cmm_split "Post splitting" g + return g + else do + -- attach info tables to return points + return $ [attachContInfoTables call_pps (CmmProc h l v g)] + + ------------- Populate info tables with stack info ----------------- + g <- {-# SCC "setInfoTableStackMap" #-} + return $ map (setInfoTableStackMap dflags stackmaps) g + dumps Opt_D_dump_cmm_info "after setInfoTableStackMap" g + + ----------- Control-flow optimisations ----------------------------- + g <- {-# SCC "cmmCfgOpts(2)" #-} + return $ if optLevel dflags >= 1 + then map (cmmCfgOptsProc splitting_proc_points) g + else g + g <- return (map removeUnreachableBlocksProc g) + -- See Note [unreachable blocks] + dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" g + + return (cafEnv, g) where dflags = hsc_dflags hsc_env platform = targetPlatform dflags dump = dumpGraph dflags - dump' = dumpWith dflags dumps flag name = mapM_ (dumpWith dflags flag name) |