ghc/compiler/utils/Outputable.lhs

   1 %
   2 % (c) The GRASP Project, Glasgow University, 1992-1996
   3 %
   4 \section[Outputable]{Classes for pretty-printing}
   5
   6 Defines classes for pretty-printing and forcing, both forms of
   7 ``output.''
   8
   9 \begin{code}
  10 #include "HsVersions.h"
  11
  12 module Outputable (
  13         Outputable(..),         -- class
  14
  15         PprStyle(..),
  16         codeStyle, ifaceStyle, userStyle,
  17         ifPprDebug,
  18         ifnotPprForUser,
  19         ifPprShowAll, ifnotPprShowAll,
  20         ifPprInterface,
  21         pprQuote,
  22
  23         printDoc, printErrs, pprCols, pprDumpStyle, pprErrorsStyle,
  24
  25         interppSP, interpp'SP,
  26
  27         speakNth
  28
  29 #if __GLASGOW_HASKELL__ <= 200
  30         , Mode
  31 #endif
  32
  33     ) where
  34
  35 #if __GLASGOW_HASKELL__ >= 202
  36 import IO
  37 import GlaExts
  38 # if __GLASGOW_HASKELL__ >= 209
  39 import Addr
  40 # endif
  41
  42 #else
  43 import Ubiq             ( Uniquable(..), Unique, Name ) -- FastString mentions it; todo: rm
  44
  45 #endif
  46
  47 import CmdLineOpts      ( opt_PprStyle_All, opt_PprStyle_Debug, opt_PprStyle_User )
  48 import FastString
  49 import Pretty
  50 import Util             ( cmpPString )
  51 \end{code}
  52
  53
  54 %************************************************************************
  55 %*                                                                      *
  56 \subsection{The @PprStyle@ data type}
  57 %*                                                                      *
  58 %************************************************************************
  59
  60 \begin{code}
  61 data PprStyle
  62   = PprForUser Int              -- Pretty-print in a way that will
  63                                 -- make sense to the ordinary user;
  64                                 -- must be very close to Haskell
  65                                 -- syntax, etc.
  66                                 -- Parameterised over how much to expand
  67                                 -- a pretty-printed value (<= 0 => stop pp).
  68   | PprQuote                    -- Like PprForUser, but also quote the whole thing
  69
  70   | PprDebug                    -- Standard debugging output
  71   | PprShowAll                  -- Debugging output which leaves
  72                                 -- nothing to the imagination
  73
  74   | PprInterface                -- Interface generation
  75
  76   | PprForC                     -- must print out C-acceptable names
  77
  78   | PprForAsm                   -- must print out assembler-acceptable names
  79         Bool                    -- prefix CLabel with underscore?
  80         (String -> String)      -- format AsmTempLabel
  81
  82 \end{code}
  83
  84 Orthogonal to the above printing styles are (possibly) some
  85 command-line flags that affect printing (often carried with the
  86 style).  The most likely ones are variations on how much type info is
  87 shown.
  88
  89 The following test decides whether or not we are actually generating
  90 code (either C or assembly), or generating interface files.
  91 \begin{code}
  92 codeStyle :: PprStyle -> Bool
  93 codeStyle PprForC         = True
  94 codeStyle (PprForAsm _ _) = True
  95 codeStyle _               = False
  96
  97 ifaceStyle :: PprStyle -> Bool
  98 ifaceStyle PprInterface   = True
  99 ifaceStyle other          = False
 100
 101 userStyle ::  PprStyle -> Bool
 102 userStyle PprQuote   = True
 103 userStyle (PprForUser _) = True
 104 userStyle other      = False
 105 \end{code}
 106
 107 \begin{code}
 108 ifPprDebug      sty p = case sty of PprDebug     -> p ; _ -> empty
 109 ifPprShowAll    sty p = case sty of PprShowAll   -> p ; _ -> empty
 110 ifPprInterface  sty p = case sty of PprInterface -> p ; _ -> empty
 111
 112 ifnotPprForUser   sty p = case sty of { PprForUser _ -> empty ; PprQuote -> empty; _ -> p }
 113 ifnotPprShowAll   sty p = case sty of { PprShowAll -> empty ; _ -> p }
 114 \end{code}
 115
 116 \begin{code}
 117 pprQuote :: PprStyle -> (PprStyle -> Doc) -> Doc
 118 pprQuote PprQuote fn = quotes (fn (PprForUser 5{-opt_PprUserLength-}))
 119 pprQuote sty      fn = fn sty
 120 \end{code}
 121
 122
 123
 124 %************************************************************************
 125 %*                                                                      *
 126 \subsection[Outputable-class]{The @Outputable@ class}
 127 %*                                                                      *
 128 %************************************************************************
 129
 130 \begin{code}
 131 class Outputable a where
 132         ppr :: PprStyle -> a -> Doc
 133 \end{code}
 134
 135 \begin{code}
 136 instance Outputable Bool where
 137     ppr sty True = ptext SLIT("True")
 138     ppr sty False = ptext SLIT("False")
 139
 140 instance Outputable Int where
 141    ppr sty n = int n
 142
 143 instance (Outputable a) => Outputable [a] where
 144     ppr sty xs = brackets (fsep (punctuate comma (map (ppr sty) xs)))
 145
 146 instance (Outputable a, Outputable b) => Outputable (a, b) where
 147     ppr sty (x,y) =
 148       hang (hcat [lparen, ppr sty x, comma]) 4 ((<>) (ppr sty y) rparen)
 149
 150 -- ToDo: may not be used
 151 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
 152     ppr sty (x,y,z) =
 153       parens (sep [ (<>) (ppr sty x) comma,
 154                       (<>) (ppr sty y) comma,
 155                       ppr sty z ])
 156 \end{code}
 157
 158
 159 %************************************************************************
 160 %*                                                                      *
 161 \subsection{Other helper functions}
 162 %*                                                                      *
 163 %************************************************************************
 164
 165 \begin{code}
 166 pprCols = (100 :: Int) -- could make configurable
 167
 168 -- pprErrorsStyle is the style to print ordinary error messages with
 169 -- pprDumpStyle   is the style to print -ddump-xx information in
 170 (pprDumpStyle, pprErrorsStyle)
 171   | opt_PprStyle_All   = (PprShowAll, PprShowAll)
 172   | opt_PprStyle_Debug = (PprDebug,   PprDebug)
 173   | otherwise          = (PprDebug,   PprQuote)
 174
 175 printDoc :: Mode -> Handle -> Doc -> IO ()
 176 printDoc mode hdl doc
 177   = fullRender mode pprCols 1.5 put done doc
 178   where
 179     put (Chr c)  next = hPutChar hdl c >> next
 180     put (Str s)  next = hPutStr  hdl s >> next
 181     put (PStr s) next = hPutFS   hdl s >> next
 182
 183     done = hPutChar hdl '\n'
 184
 185 -- I'm not sure whether the direct-IO approach of printDoc
 186 -- above is better or worse than the put-big-string approach here
 187 printErrs :: Doc -> IO ()
 188 printErrs doc = hPutStr stderr (show (doc $$ text ""))
 189 \end{code}
 190
 191
 192 \begin{code}
 193 interppSP  :: Outputable a => PprStyle -> [a] -> Doc
 194 interppSP  sty xs = hsep (map (ppr sty) xs)
 195
 196 interpp'SP :: Outputable a => PprStyle -> [a] -> Doc
 197 interpp'SP sty xs
 198   = hsep (punctuate comma (map (ppr sty) xs))
 199 \end{code}
 200
 201
 202
 203
 204 %************************************************************************
 205 %*                                                                      *
 206 \subsection{Printing numbers verbally}
 207 %*                                                                      *
 208 %************************************************************************
 209
 210 @speakNth@ converts an integer to a verbal index; eg 1 maps to
 211 ``first'' etc.
 212
 213 \begin{code}
 214 speakNth :: Int -> Doc
 215
 216 speakNth 1 = ptext SLIT("first")
 217 speakNth 2 = ptext SLIT("second")
 218 speakNth 3 = ptext SLIT("third")
 219 speakNth 4 = ptext SLIT("fourth")
 220 speakNth 5 = ptext SLIT("fifth")
 221 speakNth 6 = ptext SLIT("sixth")
 222 speakNth n = hcat [ int n, text st_nd_rd_th ]
 223   where
 224     st_nd_rd_th | n_rem_10 == 1 = "st"
 225                 | n_rem_10 == 2 = "nd"
 226                 | n_rem_10 == 3 = "rd"
 227                 | otherwise     = "th"
 228
 229     n_rem_10 = n `rem` 10
 230 \end{code}