Add Outputable.blankLine and use it

diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 1be8862..9f284c8 100644 (file)
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -92,7 +92,7 @@ writeCs dflags handle cmms
 --
 
 pprC :: RawCmm -> SDoc
 --
 
 pprC :: RawCmm -> SDoc

-pprC (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
+pprC (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops

 
 --
 -- top level procs
 
 --
 -- top level procs

@@ -107,7 +107,7 @@ pprTop (CmmProc info clbl _params (ListGraph blocks)) =
         [] -> empty
          -- the first block doesn't get a label:
         (BasicBlock _ stmts : rest) -> vcat [
         [] -> empty
          -- the first block doesn't get a label:
         (BasicBlock _ stmts : rest) -> vcat [

-          text "",
+          blankLine,

           extern_decls,
            (if (externallyVisibleCLabel clbl)
                     then mkFN_ else mkIF_) (pprCLabel clbl) <+> lbrace,
           extern_decls,
            (if (externallyVisibleCLabel clbl)
                     then mkFN_ else mkIF_) (pprCLabel clbl) <+> lbrace,

diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index 9f622c0..d8d34c3 100644 (file)
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -115,7 +115,7 @@ instance Outputable CmmInfo where
 -----------------------------------------------------------------------------
 
 pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc
 -----------------------------------------------------------------------------
 
 pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc

-pprCmm (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
+pprCmm (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops

 
 -- --------------------------------------------------------------------------
 -- Top level `procedure' blocks.
 
 -- --------------------------------------------------------------------------
 -- Top level `procedure' blocks.

@@ -506,9 +506,8 @@ pprLit :: CmmLit -> SDoc
 pprLit lit = case lit of
     CmmInt i rep ->
         hcat [ (if i < 0 then parens else id)(integer i)
 pprLit lit = case lit of
     CmmInt i rep ->
         hcat [ (if i < 0 then parens else id)(integer i)

-             , (if rep == wordWidth
-                    then empty 
-                    else space <> dcolon <+> ppr rep) ]
+             , ppUnless (rep == wordWidth) $
+               space <> dcolon <+> ppr rep ]

 
     CmmFloat f rep     -> hsep [ rational f, dcolon, ppr rep ]
     CmmLabel clbl      -> pprCLabel clbl
 
     CmmFloat f rep     -> hsep [ rational f, dcolon, ppr rep ]
     CmmLabel clbl      -> pprCLabel clbl

diff --git a/compiler/cmm/ZipCfgCmmRep.hs b/compiler/cmm/ZipCfgCmmRep.hs
index d83e7e2..451450e 100644 (file)
--- a/compiler/cmm/ZipCfgCmmRep.hs
+++ b/compiler/cmm/ZipCfgCmmRep.hs
@@ -459,10 +459,9 @@ pprMiddle stmt = pp_stmt <+> pp_debug
        -- call "ccall" foo(x, y)[r1, r2];
        -- ToDo ppr volatile
        MidForeignCall safety target results args ->
        -- call "ccall" foo(x, y)[r1, r2];
        -- ToDo ppr volatile
        MidForeignCall safety target results args ->

-           hsep [ if null results
-                     then empty
-                     else parens (commafy $ map ppr results) <+> equals,
-                      ppr_safety safety,
+           hsep [ ppUnless (null results) $
+                     parens (commafy $ map ppr results) <+> equals,
+                   ppr_safety safety,

                   ptext $ sLit "call", 
                   ppr_call_target target <> parens (commafy $ map ppr args) <> semi]
 
                   ptext $ sLit "call", 
                   ppr_call_target target <> parens (commafy $ map ppr args) <> semi]
 

diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs
index 4e04e04..a3ba3ae 100644 (file)
--- a/compiler/coreSyn/CoreLint.lhs
+++ b/compiler/coreSyn/CoreLint.lhs
@@ -650,7 +650,7 @@ initL :: LintM a -> Maybe Message {- errors -}
 initL m
   = case unLintM m [] emptyTvSubst emptyBag of
       (_, errs) | isEmptyBag errs -> Nothing
 initL m
   = case unLintM m [] emptyTvSubst emptyBag of
       (_, errs) | isEmptyBag errs -> Nothing

-               | otherwise       -> Just (vcat (punctuate (text "") (bagToList errs)))
+               | otherwise       -> Just (vcat (punctuate blankLine (bagToList errs)))

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs
index 3b829f7..84bf868 100644 (file)
--- a/compiler/coreSyn/PprCore.lhs
+++ b/compiler/coreSyn/PprCore.lhs
@@ -71,13 +71,16 @@ pprTopBinds binds = vcat (map pprTopBind binds)
 
 pprTopBind :: OutputableBndr a => Bind a -> SDoc
 pprTopBind (NonRec binder expr)
 
 pprTopBind :: OutputableBndr a => Bind a -> SDoc
 pprTopBind (NonRec binder expr)

- = ppr_binding (binder,expr) $$ text ""
+ = ppr_binding (binder,expr) $$ blankLine

 
 

-pprTopBind (Rec binds)
+pprTopBind (Rec [])
+  = ptext (sLit "Rec { }")
+pprTopBind (Rec (b:bs))

   = vcat [ptext (sLit "Rec {"),
   = vcat [ptext (sLit "Rec {"),

-         vcat (map ppr_binding binds),
+         ppr_binding b,
+         vcat [blankLine $$ ppr_binding b | b <- bs],

          ptext (sLit "end Rec }"),
          ptext (sLit "end Rec }"),

-         text ""]
+         blankLine]

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs
index a92f83c..521d1ad 100644 (file)
--- a/compiler/deSugar/Desugar.lhs
+++ b/compiler/deSugar/Desugar.lhs
@@ -243,7 +243,7 @@ addExportFlags target exports keep_alive prs rules
 ppr_ds_rules :: [CoreRule] -> SDoc
 ppr_ds_rules [] = empty
 ppr_ds_rules rules
 ppr_ds_rules :: [CoreRule] -> SDoc
 ppr_ds_rules [] = empty
 ppr_ds_rules rules

-  = text "" $$ text "-------------- DESUGARED RULES -----------------" $$
+  = blankLine $$ text "-------------- DESUGARED RULES -----------------" $$

     pprRules rules
 \end{code}
 
     pprRules rules
 \end{code}
 

diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index 46d88ac..273cc98 100644 (file)
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -225,7 +225,7 @@ instance OutputableBndr name => Outputable (HsGroup name) where
                ppr_ds foreign_decls]
        where
          ppr_ds [] = empty
                ppr_ds foreign_decls]
        where
          ppr_ds [] = empty

-         ppr_ds ds = text "" $$ vcat (map ppr ds)
+         ppr_ds ds = blankLine $$ vcat (map ppr ds)

 
 data SpliceDecl id = SpliceDecl (Located (HsExpr id))  -- Top level splice
 
 
 data SpliceDecl id = SpliceDecl (Located (HsExpr id))  -- Top level splice
 

diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs
index f1f4770..656ced2 100644 (file)
--- a/compiler/main/DriverMkDepend.hs
+++ b/compiler/main/DriverMkDepend.hs
@@ -352,7 +352,7 @@ dumpModCycles dflags mod_summaries
     cycles = [ c | CyclicSCC c <- GHC.topSortModuleGraph True mod_summaries Nothing ]
 
     pp_cycles = vcat [ (ptext (sLit "---------- Cycle") <+> int n <+> ptext (sLit "----------"))
     cycles = [ c | CyclicSCC c <- GHC.topSortModuleGraph True mod_summaries Nothing ]
 
     pp_cycles = vcat [ (ptext (sLit "---------- Cycle") <+> int n <+> ptext (sLit "----------"))

-                        $$ pprCycle c $$ text ""
+                        $$ pprCycle c $$ blankLine

                      | (n,c) <- [1..] `zip` cycles ]
 
 pprCycle :: [ModSummary] -> SDoc
                      | (n,c) <- [1..] `zip` cycles ]
 
 pprCycle :: [ModSummary] -> SDoc

diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs
index f406c33..66ade90 100644 (file)
--- a/compiler/main/ErrUtils.lhs
+++ b/compiler/main/ErrUtils.lhs
@@ -230,10 +230,10 @@ dumpIfSet_dyn_or dflags flags hdr doc
 
 mkDumpDoc :: String -> SDoc -> SDoc
 mkDumpDoc hdr doc 
 
 mkDumpDoc :: String -> SDoc -> SDoc
 mkDumpDoc hdr doc 

-   = vcat [text "", 
+   = vcat [blankLine,

           line <+> text hdr <+> line,
           doc,
           line <+> text hdr <+> line,
           doc,

-          text ""]
+          blankLine]

      where 
         line = text (replicate 20 '=')
 
      where 
         line = text (replicate 20 '=')
 

diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs
index c467659..514fda6 100644 (file)
--- a/compiler/simplCore/SimplMonad.lhs
+++ b/compiler/simplCore/SimplMonad.lhs
@@ -243,10 +243,10 @@ pprSimplCount VerySimplZero    = ptext (sLit "Total ticks: ZERO!")
 pprSimplCount VerySimplNonZero = ptext (sLit "Total ticks: NON-ZERO!")
 pprSimplCount (SimplCount { ticks = tks, details = dts, log1 = l1, log2 = l2 })
   = vcat [ptext (sLit "Total ticks:    ") <+> int tks,
 pprSimplCount VerySimplNonZero = ptext (sLit "Total ticks: NON-ZERO!")
 pprSimplCount (SimplCount { ticks = tks, details = dts, log1 = l1, log2 = l2 })
   = vcat [ptext (sLit "Total ticks:    ") <+> int tks,

-         text "",
+         blankLine,

          pprTickCounts (fmToList dts),
          if verboseSimplStats then
          pprTickCounts (fmToList dts),
          if verboseSimplStats then

-               vcat [text "",
+               vcat [blankLine,

                      ptext (sLit "Log (most recent first)"),
                      nest 4 (vcat (map ppr l1) $$ vcat (map ppr l2))]
          else empty
                      ptext (sLit "Log (most recent first)"),
                      nest 4 (vcat (map ppr l1) $$ vcat (map ppr l2))]
          else empty

diff --git a/compiler/stgSyn/StgLint.lhs b/compiler/stgSyn/StgLint.lhs
index 21db424..cb08c40 100644 (file)
--- a/compiler/stgSyn/StgLint.lhs
+++ b/compiler/stgSyn/StgLint.lhs
@@ -316,7 +316,7 @@ initL (LintM m)
     if isEmptyBag errs then
         Nothing
     else
     if isEmptyBag errs then
         Nothing
     else

-        Just (vcat (punctuate (text "") (bagToList errs)))
+        Just (vcat (punctuate blankLine (bagToList errs)))

     }
 
 instance Monad LintM where
     }
 
 instance Monad LintM where

diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index 622138c..fd50fb5 100644 (file)
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -25,6 +25,7 @@ module Outputable (
        parens, cparen, brackets, braces, quotes, doubleQuotes, angleBrackets,
        semi, comma, colon, dcolon, space, equals, dot, arrow,
        lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
        parens, cparen, brackets, braces, quotes, doubleQuotes, angleBrackets,
        semi, comma, colon, dcolon, space, equals, dot, arrow,
        lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,

+       blankLine,

        (<>), (<+>), hcat, hsep, 
        ($$), ($+$), vcat,
        sep, cat, 
        (<>), (<+>), hcat, hsep, 
        ($$), ($+$), vcat,
        sep, cat, 

@@ -56,7 +57,7 @@ module Outputable (
        ifPprDebug, qualName, qualModule,
        mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle,
         mkUserStyle, Depth(..),
        ifPprDebug, qualName, qualModule,
        mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle,
         mkUserStyle, Depth(..),

-
+       

        -- * Error handling and debugging utilities
        pprPanic, assertPprPanic, pprPanicFastInt, pprPgmError, 
        pprTrace, warnPprTrace,
        -- * Error handling and debugging utilities
        pprPanic, assertPprPanic, pprPanicFastInt, pprPgmError, 
        pprTrace, warnPprTrace,

@@ -291,7 +292,7 @@ hPrintDump h doc = do
    Pretty.printDoc PageMode h (better_doc defaultDumpStyle)
    hFlush h
  where
    Pretty.printDoc PageMode h (better_doc defaultDumpStyle)
    hFlush h
  where

-   better_doc = doc $$ text ""
+   better_doc = doc $$ blankLine

 
 printForUser :: Handle -> PrintUnqualified -> SDoc -> IO ()
 printForUser handle unqual doc 
 
 printForUser :: Handle -> PrintUnqualified -> SDoc -> IO ()
 printForUser handle unqual doc 

@@ -397,23 +398,24 @@ quotes d sty = case show pp_d of
               pp_d = d sty
 
 semi, comma, colon, equals, space, dcolon, arrow, underscore, dot :: SDoc
               pp_d = d sty
 
 semi, comma, colon, equals, space, dcolon, arrow, underscore, dot :: SDoc

-lparen, rparen, lbrack, rbrack, lbrace, rbrace :: SDoc
-
-semi _sty   = Pretty.semi
-comma _sty  = Pretty.comma
-colon _sty  = Pretty.colon
-equals _sty = Pretty.equals
-space _sty  = Pretty.space
-dcolon _sty = Pretty.ptext (sLit "::")
-arrow  _sty = Pretty.ptext (sLit "->")
-underscore  = char '_'
-dot        = char '.'
-lparen _sty = Pretty.lparen
-rparen _sty = Pretty.rparen
-lbrack _sty = Pretty.lbrack
-rbrack _sty = Pretty.rbrack
-lbrace _sty = Pretty.lbrace
-rbrace _sty = Pretty.rbrace
+lparen, rparen, lbrack, rbrack, lbrace, rbrace, blankLine :: SDoc
+
+blankLine _sty = Pretty.ptext (sLit "")
+dcolon _sty    = Pretty.ptext (sLit "::")
+arrow  _sty    = Pretty.ptext (sLit "->")
+semi _sty      = Pretty.semi
+comma _sty     = Pretty.comma
+colon _sty     = Pretty.colon
+equals _sty    = Pretty.equals
+space _sty     = Pretty.space
+underscore     = char '_'
+dot           = char '.'
+lparen _sty    = Pretty.lparen
+rparen _sty    = Pretty.rparen
+lbrack _sty    = Pretty.lbrack
+rbrack _sty    = Pretty.rbrack
+lbrace _sty    = Pretty.lbrace
+rbrace _sty    = Pretty.rbrace

 
 nest :: Int -> SDoc -> SDoc
 -- ^ Indent 'SDoc' some specified amount
 
 nest :: Int -> SDoc -> SDoc
 -- ^ Indent 'SDoc' some specified amount