[project @ 2005-01-11 16:04:08 by simonmar]
[packages/old-time.git] / GHC / Show.lhs
1 \begin{code}
2 {-# OPTIONS_GHC -fno-implicit-prelude #-}
3 -----------------------------------------------------------------------------
4 -- |
5 -- Module      :  GHC.Show
6 -- Copyright   :  (c) The University of Glasgow, 1992-2002
7 -- License     :  see libraries/base/LICENSE
8 -- 
9 -- Maintainer  :  cvs-ghc@haskell.org
10 -- Stability   :  internal
11 -- Portability :  non-portable (GHC Extensions)
12 --
13 -- The 'Show' class, and related operations.
14 --
15 -----------------------------------------------------------------------------
16
17 module GHC.Show
18         (
19         Show(..), ShowS,
20
21         -- Instances for Show: (), [], Bool, Ordering, Int, Char
22
23         -- Show support code
24         shows, showChar, showString, showParen, showList__, showSpace,
25         showLitChar, protectEsc, 
26         intToDigit, showSignedInt,
27         appPrec, appPrec1,
28
29         -- Character operations
30         asciiTab,
31   ) 
32         where
33
34 import {-# SOURCE #-} GHC.Err ( error )
35 import GHC.Base
36 import GHC.Enum
37 import Data.Maybe
38 import Data.Either
39 import GHC.List ( (!!),
40 #ifdef USE_REPORT_PRELUDE
41                 , concatMap, foldr1
42 #endif
43                 )
44 \end{code}
45
46
47
48 %*********************************************************
49 %*                                                      *
50 \subsection{The @Show@ class}
51 %*                                                      *
52 %*********************************************************
53
54 \begin{code}
55 -- | The @shows@ functions return a function that prepends the
56 -- output 'String' to an existing 'String'.  This allows constant-time
57 -- concatenation of results using function composition.
58 type ShowS = String -> String
59
60 -- | Conversion of values to readable 'String's.
61 --
62 -- Minimal complete definition: 'showsPrec' or 'show'.
63 --
64 -- Derived instances of 'Show' have the following properties, which
65 -- are compatible with derived instances of 'Text.Read.Read':
66 --
67 -- * The result of 'show' is a syntactically correct Haskell
68 --   expression containing only constants, given the fixity
69 --   declarations in force at the point where the type is declared.
70 --   It contains only the constructor names defined in the data type,
71 --   parentheses, and spaces.  When labelled constructor fields are
72 --   used, braces, commas, field names, and equal signs are also used.
73 --
74 -- * If the constructor is defined to be an infix operator, then
75 --   'showsPrec' will produce infix applications of the constructor.
76 --
77 -- * the representation will be enclosed in parentheses if the
78 --   precedence of the top-level constructor in @x@ is less than @d@
79 --   (associativity is ignored).  Thus, if @d@ is @0@ then the result
80 --   is never surrounded in parentheses; if @d@ is @11@ it is always
81 --   surrounded in parentheses, unless it is an atomic expression.
82 --
83 -- * If the constructor is defined using record syntax, then 'show'
84 --   will produce the record-syntax form, with the fields given in the
85 --   same order as the original declaration.
86 --
87 -- For example, given the declarations
88 --
89 -- > infixr 5 :^:
90 -- > data Tree a =  Leaf a  |  Tree a :^: Tree a
91 --
92 -- the derived instance of 'Show' is equivalent to
93 --
94 -- > instance (Show a) => Show (Tree a) where
95 -- >
96 -- >        showsPrec d (Leaf m) = showParen (d > app_prec) $
97 -- >             showString "Leaf " . showsPrec (app_prec+1) m
98 -- >          where app_prec = 10
99 -- >
100 -- >        showsPrec d (u :^: v) = showParen (d > up_prec) $
101 -- >             showsPrec (up_prec+1) u . 
102 -- >             showString " :^: "      .
103 -- >             showsPrec (up_prec+1) v
104 -- >          where up_prec = 5
105 --
106 -- Note that right-associativity of @:^:@ is ignored.  For example,
107 --
108 -- * @'show' (Leaf 1 :^: Leaf 2 :^: Leaf 3)@ produces the string
109 --   @\"Leaf 1 :^: (Leaf 2 :^: Leaf 3)\"@.
110
111 class  Show a  where
112     -- | Convert a value to a readable 'String'.
113     --
114     -- 'showsPrec' should satisfy the law
115     --
116     -- > showsPrec d x r ++ s  ==  showsPrec d x (r ++ s)
117     --
118     -- Derived instances of 'Text.Read.Read' and 'Show' satisfy the following:
119     --
120     -- * @(x,\"\")@ is an element of
121     --   @('Text.Read.readsPrec' d ('showsPrec' d x \"\"))@.
122     --
123     -- That is, 'Text.Read.readsPrec' parses the string produced by
124     -- 'showsPrec', and delivers the value that 'showsPrec' started with.
125
126     showsPrec :: Int    -- ^ the operator precedence of the enclosing
127                         -- context (a number from @0@ to @11@).
128                         -- Function application has precedence @10@.
129               -> a      -- ^ the value to be converted to a 'String'
130               -> ShowS
131
132     -- | A specialised variant of 'showsPrec', using precedence context
133     -- zero, and returning an ordinary 'String'.
134     show      :: a   -> String
135
136     -- | The method 'showList' is provided to allow the programmer to
137     -- give a specialised way of showing lists of values.
138     -- For example, this is used by the predefined 'Show' instance of
139     -- the 'Char' type, where values of type 'String' should be shown
140     -- in double quotes, rather than between square brackets.
141     showList  :: [a] -> ShowS
142
143     showsPrec _ x s = show x ++ s
144     show x          = shows x ""
145     showList ls   s = showList__ shows ls s
146
147 showList__ :: (a -> ShowS) ->  [a] -> ShowS
148 showList__ _     []     s = "[]" ++ s
149 showList__ showx (x:xs) s = '[' : showx x (showl xs)
150   where
151     showl []     = ']' : s
152     showl (y:ys) = ',' : showx y (showl ys)
153
154 appPrec, appPrec1 :: Int
155         -- Use unboxed stuff because we don't have overloaded numerics yet
156 appPrec = I# 10#        -- Precedence of application:
157                         --   one more than the maximum operator precedence of 9
158 appPrec1 = I# 11#       -- appPrec + 1
159 \end{code}
160
161 %*********************************************************
162 %*                                                      *
163 \subsection{Simple Instances}
164 %*                                                      *
165 %*********************************************************
166
167 \begin{code}
168  
169 instance  Show ()  where
170     showsPrec _ () = showString "()"
171
172 instance Show a => Show [a]  where
173     showsPrec _         = showList
174
175 instance Show Bool where
176   showsPrec _ True  = showString "True"
177   showsPrec _ False = showString "False"
178
179 instance Show Ordering where
180   showsPrec _ LT = showString "LT"
181   showsPrec _ EQ = showString "EQ"
182   showsPrec _ GT = showString "GT"
183
184 instance  Show Char  where
185     showsPrec _ '\'' = showString "'\\''"
186     showsPrec _ c    = showChar '\'' . showLitChar c . showChar '\''
187
188     showList cs = showChar '"' . showl cs
189                  where showl ""       s = showChar '"' s
190                        showl ('"':xs) s = showString "\\\"" (showl xs s)
191                        showl (x:xs)   s = showLitChar x (showl xs s)
192                 -- Making 's' an explicit parameter makes it clear to GHC
193                 -- that showl has arity 2, which avoids it allocating an extra lambda
194                 -- The sticking point is the recursive call to (showl xs), which
195                 -- it can't figure out would be ok with arity 2.
196
197 instance Show Int where
198     showsPrec = showSignedInt
199
200 instance Show a => Show (Maybe a) where
201     showsPrec _p Nothing s = showString "Nothing" s
202     showsPrec p (Just x) s
203                           = (showParen (p > appPrec) $ 
204                              showString "Just " . 
205                              showsPrec appPrec1 x) s
206
207 instance (Show a, Show b) => Show (Either a b) where
208     showsPrec p e s =
209        (showParen (p > appPrec) $
210         case e of
211          Left  a -> showString "Left "  . showsPrec appPrec1 a
212          Right b -> showString "Right " . showsPrec appPrec1 b)
213        s
214 \end{code}
215
216
217 %*********************************************************
218 %*                                                      *
219 \subsection{Show instances for the first few tuples
220 %*                                                      *
221 %*********************************************************
222
223 \begin{code}
224 -- The explicit 's' parameters are important
225 -- Otherwise GHC thinks that "shows x" might take a lot of work to compute
226 -- and generates defns like
227 --      showsPrec _ (x,y) = let sx = shows x; sy = shows y in
228 --                          \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s))))
229
230 instance  (Show a, Show b) => Show (a,b)  where
231     showsPrec _ (x,y) s = (showChar '(' . shows x . showChar ',' .
232                                           shows y . showChar ')') 
233                           s
234
235 instance (Show a, Show b, Show c) => Show (a, b, c) where
236     showsPrec _ (x,y,z) s = (showChar '(' . shows x . showChar ',' .
237                                             shows y . showChar ',' .
238                                             shows z . showChar ')')
239                             s
240
241 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
242     showsPrec _ (w,x,y,z) s = (showChar '(' . shows w . showChar ',' .
243                                               shows x . showChar ',' .
244                                               shows y . showChar ',' .
245                                               shows z . showChar ')')
246                               s
247
248 instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
249     showsPrec _ (v,w,x,y,z) s = (showChar '(' . shows v . showChar ',' .
250                                                 shows w . showChar ',' .
251                                                 shows x . showChar ',' .
252                                                 shows y . showChar ',' .
253                                                 shows z . showChar ')') 
254                                 s
255 \end{code}
256
257
258 %*********************************************************
259 %*                                                      *
260 \subsection{Support code for @Show@}
261 %*                                                      *
262 %*********************************************************
263
264 \begin{code}
265 -- | equivalent to 'showsPrec' with a precedence of 0.
266 shows           :: (Show a) => a -> ShowS
267 shows           =  showsPrec zeroInt
268
269 -- | utility function converting a 'Char' to a show function that
270 -- simply prepends the character unchanged.
271 showChar        :: Char -> ShowS
272 showChar        =  (:)
273
274 -- | utility function converting a 'String' to a show function that
275 -- simply prepends the string unchanged.
276 showString      :: String -> ShowS
277 showString      =  (++)
278
279 -- | utility function that surrounds the inner show function with
280 -- parentheses when the 'Bool' parameter is 'True'.
281 showParen       :: Bool -> ShowS -> ShowS
282 showParen b p   =  if b then showChar '(' . p . showChar ')' else p
283
284 showSpace :: ShowS
285 showSpace = {-showChar ' '-} \ xs -> ' ' : xs
286 \end{code}
287
288 Code specific for characters
289
290 \begin{code}
291 -- | Convert a character to a string using only printable characters,
292 -- using Haskell source-language escape conventions.  For example:
293 --
294 -- > showLitChar '\n' s  =  "\\n" ++ s
295 --
296 showLitChar                :: Char -> ShowS
297 showLitChar c s | c > '\DEL' =  showChar '\\' (protectEsc isDec (shows (ord c)) s)
298 showLitChar '\DEL'         s =  showString "\\DEL" s
299 showLitChar '\\'           s =  showString "\\\\" s
300 showLitChar c s | c >= ' '   =  showChar c s
301 showLitChar '\a'           s =  showString "\\a" s
302 showLitChar '\b'           s =  showString "\\b" s
303 showLitChar '\f'           s =  showString "\\f" s
304 showLitChar '\n'           s =  showString "\\n" s
305 showLitChar '\r'           s =  showString "\\r" s
306 showLitChar '\t'           s =  showString "\\t" s
307 showLitChar '\v'           s =  showString "\\v" s
308 showLitChar '\SO'          s =  protectEsc (== 'H') (showString "\\SO") s
309 showLitChar c              s =  showString ('\\' : asciiTab!!ord c) s
310         -- I've done manual eta-expansion here, becuase otherwise it's
311         -- impossible to stop (asciiTab!!ord) getting floated out as an MFE
312
313 isDec c = c >= '0' && c <= '9'
314
315 protectEsc :: (Char -> Bool) -> ShowS -> ShowS
316 protectEsc p f             = f . cont
317                              where cont s@(c:_) | p c = "\\&" ++ s
318                                    cont s             = s
319
320
321 asciiTab :: [String]
322 asciiTab = -- Using an array drags in the array module.  listArray ('\NUL', ' ')
323            ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
324             "BS",  "HT",  "LF",  "VT",  "FF",  "CR",  "SO",  "SI", 
325             "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
326             "CAN", "EM",  "SUB", "ESC", "FS",  "GS",  "RS",  "US", 
327             "SP"] 
328 \end{code}
329
330 Code specific for Ints.
331
332 \begin{code}
333 -- | Convert an 'Int' in the range @0@..@15@ to the corresponding single
334 -- digit 'Char'.  This function fails on other inputs, and generates
335 -- lower-case hexadecimal digits.
336 intToDigit :: Int -> Char
337 intToDigit (I# i)
338     | i >=# 0#  && i <=#  9# =  unsafeChr (ord '0' `plusInt` I# i)
339     | i >=# 10# && i <=# 15# =  unsafeChr (ord 'a' `minusInt` ten `plusInt` I# i)
340     | otherwise           =  error ("Char.intToDigit: not a digit " ++ show (I# i))
341
342 ten = I# 10#
343
344 showSignedInt :: Int -> Int -> ShowS
345 showSignedInt (I# p) (I# n) r
346     | n <# 0# && p ># 6# = '(' : itos n (')' : r)
347     | otherwise          = itos n r
348
349 itos :: Int# -> String -> String
350 itos n# cs
351     | n# <# 0# = let
352         n'# = negateInt# n#
353         in if n'# <# 0# -- minInt?
354             then '-' : itos' (negateInt# (n'# `quotInt#` 10#))
355                              (itos' (negateInt# (n'# `remInt#` 10#)) cs)
356             else '-' : itos' n'# cs
357     | otherwise = itos' n# cs
358     where
359     itos' :: Int# -> String -> String
360     itos' n# cs
361         | n# <# 10#  = C# (chr# (ord# '0'# +# n#)) : cs
362         | otherwise = case chr# (ord# '0'# +# (n# `remInt#` 10#)) of { c# ->
363                       itos' (n# `quotInt#` 10#) (C# c# : cs) }
364 \end{code}