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