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