[project @ 2002-05-24 09:52:12 by simonpj]

[ghc-hetmet.git] / ghc / compiler / utils / Outputable.lhs

diff --git a/ghc/compiler/utils/Outputable.lhs b/ghc/compiler/utils/Outputable.lhs
index 96d611f..2be035c 100644 (file)
--- a/ghc/compiler/utils/Outputable.lhs
+++ b/ghc/compiler/utils/Outputable.lhs
@@ -13,14 +13,14 @@ module Outputable (
 
        PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify,
        getPprStyle, withPprStyle, withPprStyleDoc, pprDeeper,
-       codeStyle, ifaceStyle, userStyle, debugStyle, asmStyle,
+       codeStyle, userStyle, debugStyle, asmStyle,
        ifPprDebug, unqualStyle,
 
        SDoc,           -- Abstract
        docToSDoc,
        interppSP, interpp'SP, pprQuotedList, pprWithCommas,
        empty, nest,
-       text, char, ptext,
+       text, char, ftext, ptext,
        int, integer, float, double, rational,
        parens, brackets, braces, quotes, doubleQuotes, angleBrackets,
        semi, comma, colon, dcolon, space, equals, dot,
@@ -33,9 +33,9 @@ module Outputable (
        speakNth, speakNTimes,
 
        printSDoc, printErrs, printDump,
-       printForC, printForAsm, printForIface, printForUser,
+       printForC, printForAsm, printForUser,
        pprCode, mkCodeStyle,
-       showSDoc, showSDocForUser, showSDocDebug, showSDocIface, 
+       showSDoc, showSDocForUser, showSDocDebug,
        showSDocUnqual, showsPrecSDoc,
        pprHsChar, pprHsString,
 
@@ -53,7 +53,7 @@ import {-# SOURCE #-}         Name( Name )
 import CmdLineOpts     ( opt_PprStyle_Debug, opt_PprUserLength )
 import FastString
 import qualified Pretty
-import Pretty          ( Doc, Mode(..), TextDetails(..), fullRender )
+import Pretty          ( Doc, Mode(..) )
 import Panic
 
 import Word            ( Word32 )
@@ -151,10 +151,6 @@ asmStyle :: PprStyle -> Bool
 asmStyle (PprCode AsmStyle)  = True
 asmStyle other               = False
 
-ifaceStyle :: PprStyle -> Bool
-ifaceStyle (PprInterface _) = True
-ifaceStyle other           = False
-
 debugStyle :: PprStyle -> Bool
 debugStyle PprDebug      = True
 debugStyle other         = False
@@ -191,12 +187,6 @@ printForUser :: Handle -> PrintUnqualified -> SDoc -> IO ()
 printForUser handle unqual doc 
   = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual AllTheWay))
 
--- printForIface prints all on one line for interface files.
--- It's called repeatedly for successive lines
-printForIface :: Handle -> PrintUnqualified -> SDoc -> IO ()
-printForIface handle unqual doc 
-  = Pretty.printDoc LeftMode handle (doc (PprInterface unqual))
-
 -- printForC, printForAsm do what they sound like
 printForC :: Handle -> SDoc -> IO ()
 printForC handle doc = Pretty.printDoc LeftMode handle (doc (PprCode CStyle))
@@ -226,9 +216,6 @@ showSDocUnqual d = show (d (mkUserStyle neverQualify AllTheWay))
 showsPrecSDoc :: Int -> SDoc -> ShowS
 showsPrecSDoc p d = showsPrec p (d defaultUserStyle)
 
-showSDocIface :: SDoc -> String
-showSDocIface doc = showDocWith OneLineMode (doc (PprInterface alwaysQualify))
-
 showSDocDebug :: SDoc -> String
 showSDocDebug d = show (d PprDebug)
 \end{code}
@@ -240,6 +227,7 @@ docToSDoc d = \_ -> d
 empty sty      = Pretty.empty
 text s sty     = Pretty.text s
 char c sty     = Pretty.char c
+ftext s sty    = Pretty.ftext s
 ptext s sty    = Pretty.ptext s
 int n sty      = Pretty.int n
 integer n sty  = Pretty.integer n
@@ -359,8 +347,8 @@ instance Outputable FastString where
 pprHsChar :: Int -> SDoc
 pprHsChar c = char '\'' <> text (showCharLit c "") <> char '\''
 
-pprHsString :: FAST_STRING -> SDoc
-pprHsString fs = doubleQuotes (text (foldr showCharLit "" (_UNPK_INT_ fs)))
+pprHsString :: FastString -> SDoc
+pprHsString fs = doubleQuotes (text (foldr showCharLit "" (unpackIntFS fs)))
 
 showCharLit :: Int -> String -> String
 showCharLit c rest
@@ -404,17 +392,6 @@ instance Show FastString  where
 %************************************************************************
 
 \begin{code}
-showDocWith :: Mode -> Doc -> String
-showDocWith mode doc
-  = fullRender mode 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))
 
@@ -448,14 +425,15 @@ 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 ]
+speakNth n = hcat [ int n, text suffix ]
   where
-    st_nd_rd_th | n_rem_10 == 1 = "st"
-               | n_rem_10 == 2 = "nd"
-               | n_rem_10 == 3 = "rd"
-               | otherwise     = "th"
+    suffix | n <= 20       = "th"      -- 11,12,13 are non-std
+          | last_dig == 1 = "st"
+          | last_dig == 2 = "nd"
+          | last_dig == 3 = "rd"
+          | otherwise     = "th"
 
-    n_rem_10 = n `rem` 10
+    last_dig = n `rem` 10
 \end{code}
 
 \begin{code}