Few tweaks in -ddump-debug output, minor refactoring

- Fixes crazy indentation in -ddump-debug output
- We no longer dump empty sections in -ddump-debug when a code block
  does not have any generated debug info
- Minor refactoring in Debug.hs and AsmCodeGen.hs

2 files changed, 17 insertions, 22 deletions

diff --git a/compiler/cmm/Debug.hs b/compiler/cmm/Debug.hs
index 4aec63fad6..c874e81620 100644
--- a/compiler/cmm/Debug.hs
+++ b/compiler/cmm/Debug.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiWayIf #-}
 
 -----------------------------------------------------------------------------
 --
@@ -11,7 +12,7 @@
 
 module Debug (
 
-  DebugBlock(..), dblIsEntry,
+  DebugBlock(..),
   cmmDebugGen,
   cmmDebugLabels,
   cmmDebugLink,
@@ -58,8 +59,7 @@ data DebugBlock =
   , dblParent     :: !(Maybe DebugBlock)
     -- ^ The parent of this proc. See Note [Splitting DebugBlocks]
   , dblTicks      :: ![CmmTickish] -- ^ Ticks defined in this block
-  , dblSourceTick
-            :: !(Maybe CmmTickish) -- ^ Best source tick covering block
+  , dblSourceTick :: !(Maybe CmmTickish) -- ^ Best source tick covering block
   , dblPosition   :: !(Maybe Int)  -- ^ Output position relative to
                                    -- other blocks. @Nothing@ means
                                    -- the block was optimized out
@@ -67,22 +67,19 @@ data DebugBlock =
   , dblBlocks     :: ![DebugBlock] -- ^ Nested blocks
   }
 
--- | Is this the entry block?
-dblIsEntry :: DebugBlock -> Bool
-dblIsEntry blk = dblProcedure blk == dblLabel blk
-
 instance Outputable DebugBlock where
-  ppr blk = (if dblProcedure blk == dblLabel blk
-             then text "proc "
-             else if dblHasInfoTbl blk
-                  then text "pp-blk "
-                  else text "blk ") <>
+  ppr blk = (if | dblProcedure blk == dblLabel blk
+                -> text "proc"
+                | dblHasInfoTbl blk
+                -> text "pp-blk"
+                | otherwise
+                -> text "blk") <+>
             ppr (dblLabel blk) <+> parens (ppr (dblCLabel blk)) <+>
             (maybe empty ppr (dblSourceTick blk)) <+>
             (maybe (text "removed") ((text "pos " <>) . ppr)
                    (dblPosition blk)) <+>
-            (ppr (dblUnwind blk)) <+>
-            (if null (dblBlocks blk) then empty else ppr (dblBlocks blk))
+            (ppr (dblUnwind blk)) $+$
+            (if null (dblBlocks blk) then empty else nest 4 (ppr (dblBlocks blk)))
 
 -- | Intermediate data structure holding debug-relevant context information
 -- about a block.
diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index fe59a4d789..b735a3e412 100644
--- a/compiler/nativeGen/AsmCodeGen.hs
+++ b/compiler/nativeGen/AsmCodeGen.hs
@@ -347,7 +347,7 @@ finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs
 
         -- dump global NCG stats for graph coloring allocator
         let stats = concat (ngs_colorStats ngs)
-        when (not (null stats)) $ do
+        unless (null stats) $ do
 
           -- build the global register conflict graph
           let graphGlobal
@@ -370,7 +370,7 @@ finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs
 
         -- dump global NCG stats for linear allocator
         let linearStats = concat (ngs_linearStats ngs)
-        when (not (null linearStats)) $
+        unless (null linearStats) $
           dump_stats (Linear.pprStats (concat (ngs_natives ngs)) linearStats)
 
         -- write out the imports
@@ -419,8 +419,9 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
               -- Link native code information into debug blocks
               -- See Note [What is this unwinding business?] in Debug.
               let !ldbgs = cmmDebugLink (ngs_labels ngs') (ngs_unwinds ngs') ndbgs
-              dumpIfSet_dyn dflags Opt_D_dump_debug "Debug Infos"
-                (vcat $ map ppr ldbgs)
+              unless (null ldbgs) $
+                dumpIfSet_dyn dflags Opt_D_dump_debug "Debug Infos"
+                  (vcat $ map ppr ldbgs)
 
               -- Accumulate debug information for emission in finishNativeGen.
               let ngs'' = ngs' { ngs_debug = ngs_debug ngs' ++ ldbgs, ngs_labels = [] }
@@ -477,7 +478,7 @@ cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap = go
           map (pprNatCmmDecl ncgImpl) native
 
         -- force evaluation all this stuff to avoid space leaks
-        {-# SCC "seqString" #-} evaluate $ seqString (showSDoc dflags $ vcat $ map ppr imports)
+        {-# SCC "seqString" #-} evaluate $ seqList (showSDoc dflags $ vcat $ map ppr imports) ()
 
         let !labels' = if debugLevel dflags > 0
                        then cmmDebugLabels isMetaInstr native else []
@@ -495,9 +496,6 @@ cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap = go
                       }
         go us' cmms ngs' (count + 1)
 
-    seqString []            = ()
-    seqString (x:xs)        = x `seq` seqString xs
-
 
 emitNativeCode :: DynFlags -> BufHandle -> SDoc -> IO ()
 emitNativeCode dflags h sdoc = do