From: sof <unknown>
Date: Sun, 18 May 1997 04:55:31 +0000 (+0000)
Subject: [project @ 1997-05-18 04:55:31 by sof]
X-Git-Tag: Approximately_1000_patches_recorded~649
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=cf4ec40184f701aecbc78dfa8c4ee366827f135f;p=ghc-hetmet.git

[project @ 1997-05-18 04:55:31 by sof]
Updated for new PP
---

diff --git a/ghc/compiler/utils/Outputable.lhs b/ghc/compiler/utils/Outputable.lhs
index 0ed69ce..40386d9 100644
--- a/ghc/compiler/utils/Outputable.lhs
+++ b/ghc/compiler/utils/Outputable.lhs
@@ -12,15 +12,29 @@ Defines classes for pretty-printing and forcing, both forms of
 module Outputable (
 	Outputable(..), 	-- class
 
+	printDoc,
+
 	interppSP, interpp'SP,
 	ifnotPprForUser,
 	ifPprDebug,
 	ifPprShowAll, ifnotPprShowAll,
-	ifPprInterface
+	ifPprInterface,
+	pprQuote,
+
+	speakNth
+	
+#if __GLASGOW_HASKELL__ <= 200
+	, Mode
+#endif
+
     ) where
 
 IMP_Ubiq(){-uitous-}
 
+#if __GLASGOW_HASKELL__ >= 202
+import IO
+#endif
+
 import PprStyle		( PprStyle(..) )
 import Pretty
 import Util		( cmpPString )
@@ -34,49 +48,87 @@ import Util		( cmpPString )
 
 \begin{code}
 class Outputable a where
-	ppr :: PprStyle -> a -> Pretty
+	ppr :: PprStyle -> a -> Doc
 \end{code}
 
 \begin{code}
--- the ppSep in the ppInterleave puts in the spaces
--- Death to ppSep! (WDP 94/11)
+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 
 
-interppSP  :: Outputable a => PprStyle -> [a] -> Pretty
-interppSP  sty xs = ppIntersperse ppSP (map (ppr sty) xs)
+    done = hPutChar hdl '\n'
+\end{code}
 
-interpp'SP :: Outputable a => PprStyle -> [a] -> Pretty
+
+\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
-  = ppIntersperse sep (map (ppr sty) xs)
-  where
-    sep = ppBeside ppComma ppSP
+  = hsep (punctuate comma (map (ppr sty) xs))
 \end{code}
 
 \begin{code}
-ifPprDebug	sty p = case sty of PprDebug	 -> p ; _ -> ppNil
-ifPprShowAll	sty p = case sty of PprShowAll	 -> p ; _ -> ppNil
-ifPprInterface  sty p = case sty of PprInterface -> p ; _ -> ppNil
+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 }
+ifnotPprShowAll	  sty p = case sty of { PprShowAll -> empty ; _ -> p }
+\end{code}
 
-ifnotPprForUser	  sty p = case sty of PprForUser -> ppNil ; _ -> p
-ifnotPprShowAll	  sty p = case sty of PprShowAll -> ppNil ; _ -> p
+\begin{code}
+pprQuote :: PprStyle -> (PprStyle -> Doc) -> Doc
+pprQuote PprQuote fn = quotes (fn PprForUser)
+pprQuote sty	  fn = fn sty
 \end{code}
 
+
 \begin{code}
 instance Outputable Bool where
-    ppr sty True = ppPStr SLIT("True")
-    ppr sty False = ppPStr SLIT("False")
+    ppr sty True = ptext SLIT("True")
+    ppr sty False = ptext SLIT("False")
 
 instance (Outputable a) => Outputable [a] where
-    ppr sty xs =
-      ppBesides [ ppLbrack, ppInterleave ppComma (map (ppr sty) xs), ppRbrack ]
+    ppr sty xs = brackets (fsep (punctuate comma (map (ppr sty) xs)))
 
 instance (Outputable a, Outputable b) => Outputable (a, b) where
     ppr sty (x,y) =
-      ppHang (ppBesides [ppLparen, ppr sty x, ppComma]) 4 (ppBeside (ppr sty y) ppRparen)
+      hang (hcat [lparen, ppr sty x, comma]) 4 ((<>) (ppr sty y) rparen)
 
 -- ToDo: may not be used
 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
     ppr sty (x,y,z) =
-      ppSep [ ppBesides [ppLparen, ppr sty x, ppComma],
-	      ppBeside (ppr sty y) ppComma,
-	      ppBeside (ppr sty z) ppRparen ]
+      parens (sep [ (<>) (ppr sty x) comma,
+		      (<>) (ppr sty y) comma,
+		      ppr sty z ])
+\end{code}
+
+
+
+@speakNth@ converts an integer to a verbal index; eg 1 maps to
+``first'' etc.
+
+\begin{code}
+speakNth :: Int -> Doc
+
+speakNth 1 = ptext SLIT("first")
+speakNth 2 = ptext SLIT("second")
+speakNth 3 = ptext SLIT("third")
+speakNth 4 = ptext SLIT("fourth")
+speakNth 5 = ptext SLIT("fifth")
+speakNth 6 = ptext SLIT("sixth")
+speakNth n = hcat [ int n, text st_nd_rd_th ]
+  where
+    st_nd_rd_th | n_rem_10 == 1 = "st"
+		| n_rem_10 == 2 = "nd"
+		| n_rem_10 == 3 = "rd"
+		| otherwise     = "th"
+
+    n_rem_10 = n `rem` 10
 \end{code}