[commit: ghc] supercompiler: Fix Process summary stats for shallow trees (3280555)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/32805552478c9643624bce334409c4142fa370db

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

commit 32805552478c9643624bce334409c4142fa370db
Author: Max Bolingbroke <[email protected]>
Date:   Tue Jan 31 17:29:29 2012 +0000

    Fix Process summary stats for shallow trees

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

 .../supercompile/Supercompile/Drive/Process.hs     |    8 +++-----
 1 files changed, 3 insertions(+), 5 deletions(-)

diff --git a/compiler/supercompile/Supercompile/Drive/Process.hs b/compiler/supercompile/Supercompile/Drive/Process.hs
index 40ab8c6..a57eea9 100644
--- a/compiler/supercompile/Supercompile/Drive/Process.hs
+++ b/compiler/supercompile/Supercompile/Drive/Process.hs
@@ -110,7 +110,7 @@ childrenSummary parent_children = unlines [maybe "<root>" varString mb_parent ++
         ordered_counts = sortBy (comparing (Down . sum . snd)) (M.toList descendant_counts)
 
 depthHistogram :: ParentChildren -> SDoc
-depthHistogram parent_children = vcat [ppr depth <> char ',' <+> ppr count | (depth, count) <- IM.toList overall_depth_summary]
+depthHistogram parent_children = maybe empty (\overall_depth_summary -> vcat [ppr depth <> char ',' <+> ppr count | (depth, count) <- IM.toList overall_depth_summary]) (M.lookup Nothing summary_map)
   where depth_map :: M.Map (Maybe Var) Int
         depth_map = M.foldrWithKey (\mb_fun children so_far -> let Just depth = M.lookup mb_fun depth_map
                                                                in foldr (\(child_fun, _) -> M.insert (Just child_fun) (depth + 1)) so_far children)
@@ -121,15 +121,13 @@ depthHistogram parent_children = vcat [ppr depth <> char ',' <+> ppr count | (de
                                                                                   Just depth = M.lookup mb_fun depth_map
                                                                               in IM.unionsWith (+) (IM.singleton depth 1:summaries)
         
-        Just overall_depth_summary = M.lookup Nothing summary_map
-
 -- NB: there may be many deepest paths
 deepestPath :: [(Var, FVedTerm)] -> ParentChildren -> SDoc
-deepestPath fulfils parent_children = show_meaning_chains deepest_from_root $$ summarise_leaves (map last deepest_from_root)
+deepestPath fulfils parent_children = maybe empty (\(_, deepest_from_root) -> show_meaning_chains deepest_from_root $$ summarise_leaves (map last deepest_from_root)) mb_deepest_from_root
   where deepest :: M.Map (Maybe Var) (Int, [[(Var, (State, Bool))]])
         deepest = flip M.map parent_children $ \children -> maximumByFst [(depth + 1, (fun, state):states) | (fun, state) <- children, let (depth, statess) = M.findWithDefault (0, [[]]) (Just fun) deepest, states <- statess]
         
-        Just (_, deepest_from_root) = M.lookup Nothing deepest
+        mb_deepest_from_root = M.lookup Nothing deepest
 
         fulfils_map :: M.Map Var FVedTerm
         fulfils_map = M.fromList fulfils