From 8e74cdbbe4b82ea16e09c57c2f3d46aa1bde726f Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Mon, 26 May 1997 01:16:46 +0000
Subject: [PATCH] [project @ 1997-05-26 01:16:46 by sof] Old PprStyle module
 merged into Outputable

---
 ghc/compiler/utils/Outputable.lhs |  130 ++++++++++++++++++++++++++++---------
 1 file changed, 101 insertions(+), 29 deletions(-)

diff --git a/ghc/compiler/utils/Outputable.lhs b/ghc/compiler/utils/Outputable.lhs
index 40386d9..8dc611b 100644
--- a/ghc/compiler/utils/Outputable.lhs
+++ b/ghc/compiler/utils/Outputable.lhs
@@ -12,14 +12,15 @@ Defines classes for pretty-printing and forcing, both forms of
 module Outputable (
 	Outputable(..), 	-- class
 
-	printDoc,
-
-	interppSP, interpp'SP,
-	ifnotPprForUser,
+	PprStyle(..),
+	codeStyle, ifaceStyle, userStyle,
 	ifPprDebug,
+	ifnotPprForUser,
 	ifPprShowAll, ifnotPprShowAll,
 	ifPprInterface,
-	pprQuote,
+	pprQuote, 
+
+	printDoc, interppSP, interpp'SP,
 
 	speakNth
 	
@@ -29,48 +30,71 @@ module Outputable (
 
     ) where
 
-IMP_Ubiq(){-uitous-}
-
 #if __GLASGOW_HASKELL__ >= 202
 import IO
+import GlaExts
+#else
+import Ubiq		( Uniquable(..), Unique, Name )	-- FastString mentions it; todo: rm
+
 #endif
 
-import PprStyle		( PprStyle(..) )
+import FastString
 import Pretty
 import Util		( cmpPString )
 \end{code}
 
+
 %************************************************************************
 %*									*
-\subsection[Outputable-class]{The @Outputable@ class}
+\subsection{The @PprStyle@ data type}
 %*									*
 %************************************************************************
 
 \begin{code}
-class Outputable a where
-	ppr :: PprStyle -> a -> Doc
-\end{code}
+data PprStyle
+  = PprForUser Int 		-- Pretty-print in a way that will
+				-- make sense to the ordinary user;
+				-- must be very close to Haskell
+				-- syntax, etc.
+				-- Parameterised over how much to expand
+				-- a pretty-printed value (<= 0 => stop pp).
+  | PprQuote			-- Like PprForUser, but also quote the whole thing
 
-\begin{code}
-printDoc :: Mode -> Handle -> Doc -> IO ()
-printDoc mode hdl doc
-  = fullRender mode 100 1.5 put done doc
-  where
-    put (Chr c)  next = hPutChar hdl c >> next 
-    put (Str s)  next = hPutStr  hdl s >> next 
-    put (PStr s) next = hPutFS   hdl s >> next 
+  | PprDebug			-- Standard debugging output
+  | PprShowAll			-- Debugging output which leaves
+				-- nothing to the imagination
+
+  | PprInterface		-- Interface generation
+
+  | PprForC			-- must print out C-acceptable names
+
+  | PprForAsm			-- must print out assembler-acceptable names
+	Bool	        	-- prefix CLabel with underscore?
+	(String -> String)    	-- format AsmTempLabel
 
-    done = hPutChar hdl '\n'
 \end{code}
 
+Orthogonal to the above printing styles are (possibly) some
+command-line flags that affect printing (often carried with the
+style).  The most likely ones are variations on how much type info is
+shown.
 
+The following test decides whether or not we are actually generating
+code (either C or assembly), or generating interface files.
 \begin{code}
-interppSP  :: Outputable a => PprStyle -> [a] -> Doc
-interppSP  sty xs = hsep (map (ppr sty) xs)
-
-interpp'SP :: Outputable a => PprStyle -> [a] -> Doc
-interpp'SP sty xs
-  = hsep (punctuate comma (map (ppr sty) xs))
+codeStyle :: PprStyle -> Bool
+codeStyle PprForC	  = True
+codeStyle (PprForAsm _ _) = True
+codeStyle _		  = False
+
+ifaceStyle :: PprStyle -> Bool
+ifaceStyle PprInterface	  = True
+ifaceStyle other	  = False
+
+userStyle ::  PprStyle -> Bool
+userStyle PprQuote   = True
+userStyle (PprForUser _) = True
+userStyle other      = False
 \end{code}
 
 \begin{code}
@@ -78,17 +102,29 @@ ifPprDebug	sty p = case sty of PprDebug	 -> p ; _ -> empty
 ifPprShowAll	sty p = case sty of PprShowAll	 -> p ; _ -> empty
 ifPprInterface  sty p = case sty of PprInterface -> p ; _ -> empty
 
-ifnotPprForUser	  sty p = case sty of { PprForUser -> empty ; PprQuote -> empty; _ -> p }
+ifnotPprForUser	  sty p = case sty of { PprForUser _ -> empty ; PprQuote -> empty; _ -> p }
 ifnotPprShowAll	  sty p = case sty of { PprShowAll -> empty ; _ -> p }
 \end{code}
 
 \begin{code}
 pprQuote :: PprStyle -> (PprStyle -> Doc) -> Doc
-pprQuote PprQuote fn = quotes (fn PprForUser)
+pprQuote PprQuote fn = quotes (fn (PprForUser 5{-opt_PprUserLength-}))
 pprQuote sty	  fn = fn sty
 \end{code}
 
 
+
+%************************************************************************
+%*									*
+\subsection[Outputable-class]{The @Outputable@ class}
+%*									*
+%************************************************************************
+
+\begin{code}
+class Outputable a where
+	ppr :: PprStyle -> a -> Doc
+\end{code}
+
 \begin{code}
 instance Outputable Bool where
     ppr sty True = ptext SLIT("True")
@@ -110,6 +146,42 @@ instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) wher
 \end{code}
 
 
+%************************************************************************
+%*									*
+\subsection{Other helper functions}
+%*									*
+%************************************************************************
+
+\begin{code}
+printDoc :: Mode -> Handle -> Doc -> IO ()
+printDoc mode hdl doc
+  = fullRender mode 100 1.5 put done doc
+  where
+    put (Chr c)  next = hPutChar hdl c >> next 
+    put (Str s)  next = hPutStr  hdl s >> next 
+    put (PStr s) next = hPutFS   hdl s >> next 
+
+    done = hPutChar hdl '\n'
+\end{code}
+
+
+\begin{code}
+interppSP  :: Outputable a => PprStyle -> [a] -> Doc
+interppSP  sty xs = hsep (map (ppr sty) xs)
+
+interpp'SP :: Outputable a => PprStyle -> [a] -> Doc
+interpp'SP sty xs
+  = hsep (punctuate comma (map (ppr sty) xs))
+\end{code}
+
+
+
+
+%************************************************************************
+%*									*
+\subsection{Printing numbers verbally}
+%*									*
+%************************************************************************
 
 @speakNth@ converts an integer to a verbal index; eg 1 maps to
 ``first'' etc.
-- 
1.7.10.4