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 a) => Outputable [a] where
 134     ppr sty xs = brackets (fsep (punctuate comma (map (ppr sty) xs)))
 135
 136 instance (Outputable a, Outputable b) => Outputable (a, b) where
 137     ppr sty (x,y) =
 138       hang (hcat [lparen, ppr sty x, comma]) 4 ((<>) (ppr sty y) rparen)
 139
 140 -- ToDo: may not be used
 141 instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
 142     ppr sty (x,y,z) =
 143       parens (sep [ (<>) (ppr sty x) comma,
 144                       (<>) (ppr sty y) comma,
 145                       ppr sty z ])
 146 \end{code}
 147
 148
 149 %************************************************************************
 150 %*                                                                      *
 151 \subsection{Other helper functions}
 152 %*                                                                      *
 153 %************************************************************************
 154
 155 \begin{code}
 156 printDoc :: Mode -> Handle -> Doc -> IO ()
 157 printDoc mode hdl doc
 158   = fullRender mode 100 1.5 put done doc
 159   where
 160     put (Chr c)  next = hPutChar hdl c >> next
 161     put (Str s)  next = hPutStr  hdl s >> next
 162     put (PStr s) next = hPutFS   hdl s >> next
 163
 164     done = hPutChar hdl '\n'
 165 \end{code}
 166
 167
 168 \begin{code}
 169 interppSP  :: Outputable a => PprStyle -> [a] -> Doc
 170 interppSP  sty xs = hsep (map (ppr sty) xs)
 171
 172 interpp'SP :: Outputable a => PprStyle -> [a] -> Doc
 173 interpp'SP sty xs
 174   = hsep (punctuate comma (map (ppr sty) xs))
 175 \end{code}
 176
 177
 178
 179
 180 %************************************************************************
 181 %*                                                                      *
 182 \subsection{Printing numbers verbally}
 183 %*                                                                      *
 184 %************************************************************************
 185
 186 @speakNth@ converts an integer to a verbal index; eg 1 maps to
 187 ``first'' etc.
 188
 189 \begin{code}
 190 speakNth :: Int -> Doc
 191
 192 speakNth 1 = ptext SLIT("first")
 193 speakNth 2 = ptext SLIT("second")
 194 speakNth 3 = ptext SLIT("third")
 195 speakNth 4 = ptext SLIT("fourth")
 196 speakNth 5 = ptext SLIT("fifth")
 197 speakNth 6 = ptext SLIT("sixth")
 198 speakNth n = hcat [ int n, text st_nd_rd_th ]
 199   where
 200     st_nd_rd_th | n_rem_10 == 1 = "st"
 201                 | n_rem_10 == 2 = "nd"
 202                 | n_rem_10 == 3 = "rd"
 203                 | otherwise     = "th"
 204
 205     n_rem_10 = n `rem` 10
 206 \end{code}