Generate Typeable info at definition sites
[ghc.git] / libraries / base / GHC / Show.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP, NoImplicitPrelude, BangPatterns, StandaloneDeriving,
3 MagicHash, UnboxedTuples #-}
4 {-# OPTIONS_HADDOCK hide #-}
5
6 #include "MachDeps.h"
7 #if SIZEOF_HSWORD == 4
8 #define DIGITS 9
9 #define BASE 1000000000
10 #elif SIZEOF_HSWORD == 8
11 #define DIGITS 18
12 #define BASE 1000000000000000000
13 #else
14 #error Please define DIGITS and BASE
15 -- DIGITS should be the largest integer such that
16 -- 10^DIGITS < 2^(SIZEOF_HSWORD * 8 - 1)
17 -- BASE should be 10^DIGITS. Note that ^ is not available yet.
18 #endif
19
20 -----------------------------------------------------------------------------
21 -- |
22 -- Module : GHC.Show
23 -- Copyright : (c) The University of Glasgow, 1992-2002
24 -- License : see libraries/base/LICENSE
25 --
26 -- Maintainer : cvs-ghc@haskell.org
27 -- Stability : internal
28 -- Portability : non-portable (GHC Extensions)
29 --
30 -- The 'Show' class, and related operations.
31 --
32 -----------------------------------------------------------------------------
33
34 module GHC.Show
35 (
36 Show(..), ShowS,
37
38 -- Instances for Show: (), [], Bool, Ordering, Int, Char
39
40 -- Show support code
41 shows, showChar, showString, showMultiLineString,
42 showParen, showList__, showSpace,
43 showLitChar, showLitString, protectEsc,
44 intToDigit, showSignedInt,
45 appPrec, appPrec1,
46
47 -- Character operations
48 asciiTab,
49 )
50 where
51
52 import GHC.Base
53 import GHC.List ((!!), foldr1, break)
54 import GHC.Num
55
56 -- | The @shows@ functions return a function that prepends the
57 -- output 'String' to an existing 'String'. This allows constant-time
58 -- concatenation of results using function composition.
59 type ShowS = String -> String
60
61 -- | Conversion of values to readable 'String's.
62 --
63 -- Derived instances of 'Show' have the following properties, which
64 -- are compatible with derived instances of 'Text.Read.Read':
65 --
66 -- * The result of 'show' is a syntactically correct Haskell
67 -- expression containing only constants, given the fixity
68 -- declarations in force at the point where the type is declared.
69 -- It contains only the constructor names defined in the data type,
70 -- parentheses, and spaces. When labelled constructor fields are
71 -- used, braces, commas, field names, and equal signs are also used.
72 --
73 -- * If the constructor is defined to be an infix operator, then
74 -- 'showsPrec' will produce infix applications of the constructor.
75 --
76 -- * the representation will be enclosed in parentheses if the
77 -- precedence of the top-level constructor in @x@ is less than @d@
78 -- (associativity is ignored). Thus, if @d@ is @0@ then the result
79 -- is never surrounded in parentheses; if @d@ is @11@ it is always
80 -- surrounded in parentheses, unless it is an atomic expression.
81 --
82 -- * If the constructor is defined using record syntax, then 'show'
83 -- will produce the record-syntax form, with the fields given in the
84 -- same order as the original declaration.
85 --
86 -- For example, given the declarations
87 --
88 -- > infixr 5 :^:
89 -- > data Tree a = Leaf a | Tree a :^: Tree a
90 --
91 -- the derived instance of 'Show' is equivalent to
92 --
93 -- > instance (Show a) => Show (Tree a) where
94 -- >
95 -- > showsPrec d (Leaf m) = showParen (d > app_prec) $
96 -- > showString "Leaf " . showsPrec (app_prec+1) m
97 -- > where app_prec = 10
98 -- >
99 -- > showsPrec d (u :^: v) = showParen (d > up_prec) $
100 -- > showsPrec (up_prec+1) u .
101 -- > showString " :^: " .
102 -- > showsPrec (up_prec+1) v
103 -- > where up_prec = 5
104 --
105 -- Note that right-associativity of @:^:@ is ignored. For example,
106 --
107 -- * @'show' (Leaf 1 :^: Leaf 2 :^: Leaf 3)@ produces the string
108 -- @\"Leaf 1 :^: (Leaf 2 :^: Leaf 3)\"@.
109
110 class Show a where
111 {-# MINIMAL showsPrec | show #-}
112
113 -- | Convert a value to a readable 'String'.
114 --
115 -- 'showsPrec' should satisfy the law
116 --
117 -- > showsPrec d x r ++ s == showsPrec d x (r ++ s)
118 --
119 -- Derived instances of 'Text.Read.Read' and 'Show' satisfy the following:
120 --
121 -- * @(x,\"\")@ is an element of
122 -- @('Text.Read.readsPrec' d ('showsPrec' d x \"\"))@.
123 --
124 -- That is, 'Text.Read.readsPrec' parses the string produced by
125 -- 'showsPrec', and delivers the value that 'showsPrec' started with.
126
127 showsPrec :: Int -- ^ the operator precedence of the enclosing
128 -- context (a number from @0@ to @11@).
129 -- Function application has precedence @10@.
130 -> a -- ^ the value to be converted to a 'String'
131 -> ShowS
132
133 -- | A specialised variant of 'showsPrec', using precedence context
134 -- zero, and returning an ordinary 'String'.
135 show :: a -> String
136
137 -- | The method 'showList' is provided to allow the programmer to
138 -- give a specialised way of showing lists of values.
139 -- For example, this is used by the predefined 'Show' instance of
140 -- the 'Char' type, where values of type 'String' should be shown
141 -- in double quotes, rather than between square brackets.
142 showList :: [a] -> ShowS
143
144 showsPrec _ x s = show x ++ s
145 show x = shows x ""
146 showList ls s = showList__ shows ls s
147
148 showList__ :: (a -> ShowS) -> [a] -> ShowS
149 showList__ _ [] s = "[]" ++ s
150 showList__ showx (x:xs) s = '[' : showx x (showl xs)
151 where
152 showl [] = ']' : s
153 showl (y:ys) = ',' : showx y (showl ys)
154
155 appPrec, appPrec1 :: Int
156 -- Use unboxed stuff because we don't have overloaded numerics yet
157 appPrec = I# 10# -- Precedence of application:
158 -- one more than the maximum operator precedence of 9
159 appPrec1 = I# 11# -- appPrec + 1
160
161 --------------------------------------------------------------
162 -- Simple Instances
163 --------------------------------------------------------------
164
165 deriving instance Show ()
166
167 instance Show a => Show [a] where
168 {-# SPECIALISE instance Show [String] #-}
169 {-# SPECIALISE instance Show [Char] #-}
170 {-# SPECIALISE instance Show [Int] #-}
171 showsPrec _ = showList
172
173 deriving instance Show Bool
174 deriving instance Show Ordering
175
176 instance Show Char where
177 showsPrec _ '\'' = showString "'\\''"
178 showsPrec _ c = showChar '\'' . showLitChar c . showChar '\''
179
180 showList cs = showChar '"' . showLitString cs . showChar '"'
181
182 instance Show Int where
183 showsPrec = showSignedInt
184
185 instance Show Word where
186 showsPrec _ (W# w) = showWord w
187
188 showWord :: Word# -> ShowS
189 showWord w# cs
190 | isTrue# (w# `ltWord#` 10##) = C# (chr# (ord# '0'# +# word2Int# w#)) : cs
191 | otherwise = case chr# (ord# '0'# +# word2Int# (w# `remWord#` 10##)) of
192 c# ->
193 showWord (w# `quotWord#` 10##) (C# c# : cs)
194
195 deriving instance Show a => Show (Maybe a)
196
197 instance Show TyCon where
198 showsPrec p (TyCon _ _ _ tc_name) = showsPrec p tc_name
199
200 instance Show TrName where
201 showsPrec _ (TrNameS s) = showString (unpackCString# s)
202 showsPrec _ (TrNameD s) = showString s
203
204 instance Show Module where
205 showsPrec _ (Module p m) = shows p . (':' :) . shows m
206
207 --------------------------------------------------------------
208 -- Show instances for the first few tuple
209 --------------------------------------------------------------
210
211 -- The explicit 's' parameters are important
212 -- Otherwise GHC thinks that "shows x" might take a lot of work to compute
213 -- and generates defns like
214 -- showsPrec _ (x,y) = let sx = shows x; sy = shows y in
215 -- \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s))))
216
217 instance (Show a, Show b) => Show (a,b) where
218 showsPrec _ (a,b) s = show_tuple [shows a, shows b] s
219
220 instance (Show a, Show b, Show c) => Show (a, b, c) where
221 showsPrec _ (a,b,c) s = show_tuple [shows a, shows b, shows c] s
222
223 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
224 showsPrec _ (a,b,c,d) s = show_tuple [shows a, shows b, shows c, shows d] s
225
226 instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
227 showsPrec _ (a,b,c,d,e) s = show_tuple [shows a, shows b, shows c, shows d, shows e] s
228
229 instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a,b,c,d,e,f) where
230 showsPrec _ (a,b,c,d,e,f) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f] s
231
232 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g)
233 => Show (a,b,c,d,e,f,g) where
234 showsPrec _ (a,b,c,d,e,f,g) s
235 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g] s
236
237 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h)
238 => Show (a,b,c,d,e,f,g,h) where
239 showsPrec _ (a,b,c,d,e,f,g,h) s
240 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h] s
241
242 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i)
243 => Show (a,b,c,d,e,f,g,h,i) where
244 showsPrec _ (a,b,c,d,e,f,g,h,i) s
245 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
246 shows i] s
247
248 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j)
249 => Show (a,b,c,d,e,f,g,h,i,j) where
250 showsPrec _ (a,b,c,d,e,f,g,h,i,j) s
251 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
252 shows i, shows j] s
253
254 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k)
255 => Show (a,b,c,d,e,f,g,h,i,j,k) where
256 showsPrec _ (a,b,c,d,e,f,g,h,i,j,k) s
257 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
258 shows i, shows j, shows k] s
259
260 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
261 Show l)
262 => Show (a,b,c,d,e,f,g,h,i,j,k,l) where
263 showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l) s
264 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
265 shows i, shows j, shows k, shows l] s
266
267 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
268 Show l, Show m)
269 => Show (a,b,c,d,e,f,g,h,i,j,k,l,m) where
270 showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m) s
271 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
272 shows i, shows j, shows k, shows l, shows m] s
273
274 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
275 Show l, Show m, Show n)
276 => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
277 showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m,n) s
278 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
279 shows i, shows j, shows k, shows l, shows m, shows n] s
280
281 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
282 Show l, Show m, Show n, Show o)
283 => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
284 showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) s
285 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
286 shows i, shows j, shows k, shows l, shows m, shows n, shows o] s
287
288 show_tuple :: [ShowS] -> ShowS
289 show_tuple ss = showChar '('
290 . foldr1 (\s r -> s . showChar ',' . r) ss
291 . showChar ')'
292
293 --------------------------------------------------------------
294 -- Support code for Show
295 --------------------------------------------------------------
296
297 -- | equivalent to 'showsPrec' with a precedence of 0.
298 shows :: (Show a) => a -> ShowS
299 shows = showsPrec 0
300
301 -- | utility function converting a 'Char' to a show function that
302 -- simply prepends the character unchanged.
303 showChar :: Char -> ShowS
304 showChar = (:)
305
306 -- | utility function converting a 'String' to a show function that
307 -- simply prepends the string unchanged.
308 showString :: String -> ShowS
309 showString = (++)
310
311 -- | utility function that surrounds the inner show function with
312 -- parentheses when the 'Bool' parameter is 'True'.
313 showParen :: Bool -> ShowS -> ShowS
314 showParen b p = if b then showChar '(' . p . showChar ')' else p
315
316 showSpace :: ShowS
317 showSpace = {-showChar ' '-} \ xs -> ' ' : xs
318
319 -- Code specific for characters
320
321 -- | Convert a character to a string using only printable characters,
322 -- using Haskell source-language escape conventions. For example:
323 --
324 -- > showLitChar '\n' s = "\\n" ++ s
325 --
326 showLitChar :: Char -> ShowS
327 showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDec (shows (ord c)) s)
328 showLitChar '\DEL' s = showString "\\DEL" s
329 showLitChar '\\' s = showString "\\\\" s
330 showLitChar c s | c >= ' ' = showChar c s
331 showLitChar '\a' s = showString "\\a" s
332 showLitChar '\b' s = showString "\\b" s
333 showLitChar '\f' s = showString "\\f" s
334 showLitChar '\n' s = showString "\\n" s
335 showLitChar '\r' s = showString "\\r" s
336 showLitChar '\t' s = showString "\\t" s
337 showLitChar '\v' s = showString "\\v" s
338 showLitChar '\SO' s = protectEsc (== 'H') (showString "\\SO") s
339 showLitChar c s = showString ('\\' : asciiTab!!ord c) s
340 -- I've done manual eta-expansion here, because otherwise it's
341 -- impossible to stop (asciiTab!!ord) getting floated out as an MFE
342
343 showLitString :: String -> ShowS
344 -- | Same as 'showLitChar', but for strings
345 -- It converts the string to a string using Haskell escape conventions
346 -- for non-printable characters. Does not add double-quotes around the
347 -- whole thing; the caller should do that.
348 -- The main difference from showLitChar (apart from the fact that the
349 -- argument is a string not a list) is that we must escape double-quotes
350 showLitString [] s = s
351 showLitString ('"' : cs) s = showString "\\\"" (showLitString cs s)
352 showLitString (c : cs) s = showLitChar c (showLitString cs s)
353 -- Making 's' an explicit parameter makes it clear to GHC that
354 -- showLitString has arity 2, which avoids it allocating an extra lambda
355 -- The sticking point is the recursive call to (showLitString cs), which
356 -- it can't figure out would be ok with arity 2.
357
358 showMultiLineString :: String -> [String]
359 -- | Like 'showLitString' (expand escape characters using Haskell
360 -- escape conventions), but
361 -- * break the string into multiple lines
362 -- * wrap the entire thing in double quotes
363 -- Example: @showMultiLineString "hello\ngoodbye\nblah"@
364 -- returns @["\"hello\\n\\", "\\goodbye\n\\", "\\blah\""]@
365 showMultiLineString str
366 = go '\"' str
367 where
368 go ch s = case break (== '\n') s of
369 (l, _:s'@(_:_)) -> (ch : showLitString l "\\n\\") : go '\\' s'
370 (l, "\n") -> [ch : showLitString l "\\n\""]
371 (l, _) -> [ch : showLitString l "\""]
372
373 isDec :: Char -> Bool
374 isDec c = c >= '0' && c <= '9'
375
376 protectEsc :: (Char -> Bool) -> ShowS -> ShowS
377 protectEsc p f = f . cont
378 where cont s@(c:_) | p c = "\\&" ++ s
379 cont s = s
380
381
382 asciiTab :: [String]
383 asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ')
384 ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
385 "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",
386 "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
387 "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US",
388 "SP"]
389
390 -- Code specific for Ints.
391
392 -- | Convert an 'Int' in the range @0@..@15@ to the corresponding single
393 -- digit 'Char'. This function fails on other inputs, and generates
394 -- lower-case hexadecimal digits.
395 intToDigit :: Int -> Char
396 intToDigit (I# i)
397 | isTrue# (i >=# 0#) && isTrue# (i <=# 9#) = unsafeChr (ord '0' + I# i)
398 | isTrue# (i >=# 10#) && isTrue# (i <=# 15#) = unsafeChr (ord 'a' + I# i - 10)
399 | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))
400
401 showSignedInt :: Int -> Int -> ShowS
402 showSignedInt (I# p) (I# n) r
403 | isTrue# (n <# 0#) && isTrue# (p ># 6#) = '(' : itos n (')' : r)
404 | otherwise = itos n r
405
406 itos :: Int# -> String -> String
407 itos n# cs
408 | isTrue# (n# <# 0#) =
409 let !(I# minInt#) = minInt in
410 if isTrue# (n# ==# minInt#)
411 -- negateInt# minInt overflows, so we can't do that:
412 then '-' : (case n# `quotRemInt#` 10# of
413 (# q, r #) ->
414 itos' (negateInt# q) (itos' (negateInt# r) cs))
415 else '-' : itos' (negateInt# n#) cs
416 | otherwise = itos' n# cs
417 where
418 itos' :: Int# -> String -> String
419 itos' x# cs'
420 | isTrue# (x# <# 10#) = C# (chr# (ord# '0'# +# x#)) : cs'
421 | otherwise = case x# `quotRemInt#` 10# of
422 (# q, r #) ->
423 case chr# (ord# '0'# +# r) of
424 c# ->
425 itos' q (C# c# : cs')
426
427 --------------------------------------------------------------
428 -- The Integer instances for Show
429 --------------------------------------------------------------
430
431 instance Show Integer where
432 showsPrec p n r
433 | p > 6 && n < 0 = '(' : integerToString n (')' : r)
434 -- Minor point: testing p first gives better code
435 -- in the not-uncommon case where the p argument
436 -- is a constant
437 | otherwise = integerToString n r
438 showList = showList__ (showsPrec 0)
439
440 -- Divide an conquer implementation of string conversion
441 integerToString :: Integer -> String -> String
442 integerToString n0 cs0
443 | n0 < 0 = '-' : integerToString' (- n0) cs0
444 | otherwise = integerToString' n0 cs0
445 where
446 integerToString' :: Integer -> String -> String
447 integerToString' n cs
448 | n < BASE = jhead (fromInteger n) cs
449 | otherwise = jprinth (jsplitf (BASE*BASE) n) cs
450
451 -- Split n into digits in base p. We first split n into digits
452 -- in base p*p and then split each of these digits into two.
453 -- Note that the first 'digit' modulo p*p may have a leading zero
454 -- in base p that we need to drop - this is what jsplith takes care of.
455 -- jsplitb the handles the remaining digits.
456 jsplitf :: Integer -> Integer -> [Integer]
457 jsplitf p n
458 | p > n = [n]
459 | otherwise = jsplith p (jsplitf (p*p) n)
460
461 jsplith :: Integer -> [Integer] -> [Integer]
462 jsplith p (n:ns) =
463 case n `quotRemInteger` p of
464 (# q, r #) ->
465 if q > 0 then q : r : jsplitb p ns
466 else r : jsplitb p ns
467 jsplith _ [] = error "jsplith: []"
468
469 jsplitb :: Integer -> [Integer] -> [Integer]
470 jsplitb _ [] = []
471 jsplitb p (n:ns) = case n `quotRemInteger` p of
472 (# q, r #) ->
473 q : r : jsplitb p ns
474
475 -- Convert a number that has been split into digits in base BASE^2
476 -- this includes a last splitting step and then conversion of digits
477 -- that all fit into a machine word.
478 jprinth :: [Integer] -> String -> String
479 jprinth (n:ns) cs =
480 case n `quotRemInteger` BASE of
481 (# q', r' #) ->
482 let q = fromInteger q'
483 r = fromInteger r'
484 in if q > 0 then jhead q $ jblock r $ jprintb ns cs
485 else jhead r $ jprintb ns cs
486 jprinth [] _ = error "jprinth []"
487
488 jprintb :: [Integer] -> String -> String
489 jprintb [] cs = cs
490 jprintb (n:ns) cs = case n `quotRemInteger` BASE of
491 (# q', r' #) ->
492 let q = fromInteger q'
493 r = fromInteger r'
494 in jblock q $ jblock r $ jprintb ns cs
495
496 -- Convert an integer that fits into a machine word. Again, we have two
497 -- functions, one that drops leading zeros (jhead) and one that doesn't
498 -- (jblock)
499 jhead :: Int -> String -> String
500 jhead n cs
501 | n < 10 = case unsafeChr (ord '0' + n) of
502 c@(C# _) -> c : cs
503 | otherwise = case unsafeChr (ord '0' + r) of
504 c@(C# _) -> jhead q (c : cs)
505 where
506 (q, r) = n `quotRemInt` 10
507
508 jblock = jblock' {- ' -} DIGITS
509
510 jblock' :: Int -> Int -> String -> String
511 jblock' d n cs
512 | d == 1 = case unsafeChr (ord '0' + n) of
513 c@(C# _) -> c : cs
514 | otherwise = case unsafeChr (ord '0' + r) of
515 c@(C# _) -> jblock' (d - 1) q (c : cs)
516 where
517 (q, r) = n `quotRemInt` 10