[commit: ghc] master: Eliminate duplicate code in Cmm pipeline (dba9bf6)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/dba9bf6723472eaf4be4813a6ca5ed910e33395d/ghc

>---------------------------------------------------------------

commit dba9bf6723472eaf4be4813a6ca5ed910e33395d
Author: Jan Stolarek <jan.stolarek at p.lodz.pl>
Date:   Mon Feb 3 12:26:14 2014 +0100

    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.


>---------------------------------------------------------------

dba9bf6723472eaf4be4813a6ca5ed910e33395d
 compiler/cmm/CmmPipeline.hs |   81 ++++++++++++++++---------------------------
 1 file changed, 30 insertions(+), 51 deletions(-)

diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index 98b398f..1447f6d 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)