From: simonpj@microsoft.com Date: Thu, 29 Oct 2009 12:01:55 +0000 (+0000) Subject: Add Outputable.blankLine and use it X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=f96194794bf099020706c3816d1a5678b40addbb Add Outputable.blankLine and use it --- diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index 1be8862..9f284c8 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -92,7 +92,7 @@ writeCs dflags handle cmms -- pprC :: RawCmm -> SDoc -pprC (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops +pprC (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops -- -- 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 [ - text "", + blankLine, 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 --- 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 (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops +pprCmm (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops -- -------------------------------------------------------------------------- -- 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) - , (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 diff --git a/compiler/cmm/ZipCfgCmmRep.hs b/compiler/cmm/ZipCfgCmmRep.hs index d83e7e2..451450e 100644 --- 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 -> - 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] diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs index 4e04e04..a3ba3ae 100644 --- 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 - | otherwise -> Just (vcat (punctuate (text "") (bagToList errs))) + | otherwise -> Just (vcat (punctuate blankLine (bagToList errs))) \end{code} \begin{code} diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs index 3b829f7..84bf868 100644 --- 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) - = 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 (map ppr_binding binds), + ppr_binding b, + vcat [blankLine $$ ppr_binding b | b <- bs], ptext (sLit "end Rec }"), - text ""] + blankLine] \end{code} \begin{code} diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs index a92f83c..521d1ad 100644 --- 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 - = text "" $$ text "-------------- DESUGARED RULES -----------------" $$ + = blankLine $$ text "-------------- DESUGARED RULES -----------------" $$ pprRules rules \end{code} diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs index 46d88ac..273cc98 100644 --- 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 ds = text "" $$ vcat (map ppr ds) + ppr_ds ds = blankLine $$ vcat (map ppr ds) 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 --- 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 "----------")) - $$ pprCycle c $$ text "" + $$ pprCycle c $$ blankLine | (n,c) <- [1..] `zip` cycles ] pprCycle :: [ModSummary] -> SDoc diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index f406c33..66ade90 100644 --- 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 - = vcat [text "", + = vcat [blankLine, line <+> text hdr <+> line, doc, - text ""] + blankLine] where line = text (replicate 20 '=') diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs index c467659..514fda6 100644 --- 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, - text "", + blankLine, 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 diff --git a/compiler/stgSyn/StgLint.lhs b/compiler/stgSyn/StgLint.lhs index 21db424..cb08c40 100644 --- a/compiler/stgSyn/StgLint.lhs +++ b/compiler/stgSyn/StgLint.lhs @@ -316,7 +316,7 @@ initL (LintM m) if isEmptyBag errs then Nothing else - Just (vcat (punctuate (text "") (bagToList errs))) + Just (vcat (punctuate blankLine (bagToList errs))) } instance Monad LintM where diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs index 622138c..fd50fb5 100644 --- 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, + blankLine, (<>), (<+>), hcat, hsep, ($$), ($+$), vcat, sep, cat, @@ -56,7 +57,7 @@ module Outputable ( ifPprDebug, qualName, qualModule, mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle, mkUserStyle, Depth(..), - + -- * 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 - better_doc = doc $$ text "" + better_doc = doc $$ blankLine 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 -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