From 5a83cc6e1cea4be2af10f4bfa08bd387ec19ed56 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Fri, 11 Feb 2000 13:06:39 +0000
Subject: [PATCH] [project @ 2000-02-11 13:06:39 by simonpj] Add a few
 functions to Outputable

---
 ghc/compiler/utils/Outputable.lhs |   35 +++++++++++++++++++++++++----------
 1 file changed, 25 insertions(+), 10 deletions(-)

diff --git a/ghc/compiler/utils/Outputable.lhs b/ghc/compiler/utils/Outputable.lhs
index 4508e1b..5dd86b7 100644
--- a/ghc/compiler/utils/Outputable.lhs
+++ b/ghc/compiler/utils/Outputable.lhs
@@ -14,17 +14,17 @@ Defines classes for pretty-printing and forcing, both forms of
 module Outputable (
 	Outputable(..),			-- Class
 
-	PprStyle, CodeStyle(..),
+	PprStyle, CodeStyle(..), 
 	getPprStyle, withPprStyle, pprDeeper,
 	codeStyle, ifaceStyle, userStyle, debugStyle, asmStyle,
 	ifPprDebug, ifNotPprForUser,
 
 	SDoc, 		-- Abstract
-	interppSP, interpp'SP, pprQuotedList,
+	interppSP, interpp'SP, pprQuotedList, pprWithCommas,
 	empty, nest,
 	text, char, ptext,
 	int, integer, float, double, rational,
-	parens, brackets, braces, quotes, doubleQuotes,
+	parens, brackets, braces, quotes, doubleQuotes, angleBrackets,
 	semi, comma, colon, dcolon, space, equals, dot,
 	lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
 	(<>), (<+>), hcat, hsep, 
@@ -35,9 +35,10 @@ module Outputable (
 	speakNth, speakNTimes,
 
 	printSDoc, printErrs, printDump, 
-	printForC, printForAsm, printForIface,
+	printForC, printForAsm, printForIface, printForUser,
 	pprCode, pprCols,
-	showSDoc, showSDocDebug, showsPrecSDoc, pprFSAsString,
+	showSDoc, showSDocDebug, showSDocIface, showsPrecSDoc, 
+	pprFSAsString,
 
 
 	-- error handling
@@ -160,16 +161,15 @@ printErrs doc = printDoc PageMode stderr (final_doc user_style)
 		user_style = mkUserStyle (PartWay opt_PprUserLength)
 
 printDump :: SDoc -> IO ()
-printDump doc = printDoc PageMode stderr (final_doc user_style)
-	      where
-		final_doc = doc $$ text ""
-		user_style = mkUserStyle (PartWay opt_PprUserLength)
+printDump doc = printForUser stderr (doc $$ text "")
 		-- We used to always print in debug style, but I want
 		-- to try the effect of a more user-ish style (unless you
 		-- say -dppr-debug
 
+printForUser :: Handle -> SDoc -> IO ()
+printForUser handle doc = printDoc PageMode handle (doc (mkUserStyle AllTheWay))
 
--- printForC, printForAsm doe what they sound like
+-- printForC, printForAsm do what they sound like
 printForC :: Handle -> SDoc -> IO ()
 printForC handle doc = printDoc LeftMode handle (doc (PprCode CStyle))
 
@@ -190,6 +190,9 @@ pprCode cs d = withPprStyle (PprCode cs) d
 showSDoc :: SDoc -> String
 showSDoc d = show (d (mkUserStyle AllTheWay))
 
+showSDocIface :: SDoc -> String
+showSDocIface doc = showDocWith OneLineMode (doc PprInterface)
+
 showSDocDebug :: SDoc -> String
 showSDocDebug d = show (d PprDebug)
 
@@ -215,6 +218,7 @@ parens d sty       = Pretty.parens (d sty)
 braces d sty       = Pretty.braces (d sty)
 brackets d sty     = Pretty.brackets (d sty)
 doubleQuotes d sty = Pretty.doubleQuotes (d sty)
+angleBrackets d    = char '<' <> d <> char '>'
 
 -- quotes encloses something in single quotes...
 -- but it omits them if the thing ends in a single quote
@@ -331,10 +335,21 @@ printDoc mode hdl doc
     put (PStr s) next = hPutFS   hdl s >> next 
 
     done = hPutChar hdl '\n'
+
+showDocWith :: Mode -> Doc -> String
+showDocWith mode doc
+  = fullRender PageMode 100 1.5 put "" doc
+  where
+    put (Chr c)   s  = c:s
+    put (Str s1)  s2 = s1 ++ s2
+    put (PStr s1) s2 = _UNPK_ s1 ++ s2
 \end{code}
 
 
 \begin{code}
+pprWithCommas :: (a -> SDoc) -> [a] -> SDoc
+pprWithCommas pp xs = hsep (punctuate comma (map pp xs))
+
 interppSP  :: Outputable a => [a] -> SDoc
 interppSP  xs = hsep (map ppr xs)
 
-- 
1.7.10.4