4aeecb15f3ff5594db874afd68bbda9b39b07c22
[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 --------------------------------------------------------------
198 -- Show instances for the first few tuple
199 --------------------------------------------------------------
200
201 -- The explicit 's' parameters are important
202 -- Otherwise GHC thinks that "shows x" might take a lot of work to compute
203 -- and generates defns like
204 -- showsPrec _ (x,y) = let sx = shows x; sy = shows y in
205 -- \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s))))
206
207 instance (Show a, Show b) => Show (a,b) where
208 showsPrec _ (a,b) s = show_tuple [shows a, shows b] s
209
210 instance (Show a, Show b, Show c) => Show (a, b, c) where
211 showsPrec _ (a,b,c) s = show_tuple [shows a, shows b, shows c] s
212
213 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
214 showsPrec _ (a,b,c,d) s = show_tuple [shows a, shows b, shows c, shows d] s
215
216 instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
217 showsPrec _ (a,b,c,d,e) s = show_tuple [shows a, shows b, shows c, shows d, shows e] s
218
219 instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a,b,c,d,e,f) where
220 showsPrec _ (a,b,c,d,e,f) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f] s
221
222 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g)
223 => Show (a,b,c,d,e,f,g) where
224 showsPrec _ (a,b,c,d,e,f,g) s
225 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g] s
226
227 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h)
228 => Show (a,b,c,d,e,f,g,h) where
229 showsPrec _ (a,b,c,d,e,f,g,h) s
230 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h] s
231
232 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i)
233 => Show (a,b,c,d,e,f,g,h,i) where
234 showsPrec _ (a,b,c,d,e,f,g,h,i) s
235 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
236 shows i] s
237
238 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j)
239 => Show (a,b,c,d,e,f,g,h,i,j) where
240 showsPrec _ (a,b,c,d,e,f,g,h,i,j) s
241 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
242 shows i, shows j] s
243
244 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k)
245 => Show (a,b,c,d,e,f,g,h,i,j,k) where
246 showsPrec _ (a,b,c,d,e,f,g,h,i,j,k) s
247 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
248 shows i, shows j, shows k] s
249
250 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
251 Show l)
252 => Show (a,b,c,d,e,f,g,h,i,j,k,l) where
253 showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l) s
254 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
255 shows i, shows j, shows k, shows l] s
256
257 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
258 Show l, Show m)
259 => Show (a,b,c,d,e,f,g,h,i,j,k,l,m) where
260 showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m) s
261 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
262 shows i, shows j, shows k, shows l, shows m] s
263
264 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
265 Show l, Show m, Show n)
266 => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
267 showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m,n) s
268 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
269 shows i, shows j, shows k, shows l, shows m, shows n] s
270
271 instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k,
272 Show l, Show m, Show n, Show o)
273 => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
274 showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) s
275 = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h,
276 shows i, shows j, shows k, shows l, shows m, shows n, shows o] s
277
278 show_tuple :: [ShowS] -> ShowS
279 show_tuple ss = showChar '('
280 . foldr1 (\s r -> s . showChar ',' . r) ss
281 . showChar ')'
282
283 --------------------------------------------------------------
284 -- Support code for Show
285 --------------------------------------------------------------
286
287 -- | equivalent to 'showsPrec' with a precedence of 0.
288 shows :: (Show a) => a -> ShowS
289 shows = showsPrec 0
290
291 -- | utility function converting a 'Char' to a show function that
292 -- simply prepends the character unchanged.
293 showChar :: Char -> ShowS
294 showChar = (:)
295
296 -- | utility function converting a 'String' to a show function that
297 -- simply prepends the string unchanged.
298 showString :: String -> ShowS
299 showString = (++)
300
301 -- | utility function that surrounds the inner show function with
302 -- parentheses when the 'Bool' parameter is 'True'.
303 showParen :: Bool -> ShowS -> ShowS
304 showParen b p = if b then showChar '(' . p . showChar ')' else p
305
306 showSpace :: ShowS
307 showSpace = {-showChar ' '-} \ xs -> ' ' : xs
308
309 -- Code specific for characters
310
311 -- | Convert a character to a string using only printable characters,
312 -- using Haskell source-language escape conventions. For example:
313 --
314 -- > showLitChar '\n' s = "\\n" ++ s
315 --
316 showLitChar :: Char -> ShowS
317 showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDec (shows (ord c)) s)
318 showLitChar '\DEL' s = showString "\\DEL" s
319 showLitChar '\\' s = showString "\\\\" s
320 showLitChar c s | c >= ' ' = showChar c s
321 showLitChar '\a' s = showString "\\a" s
322 showLitChar '\b' s = showString "\\b" s
323 showLitChar '\f' s = showString "\\f" s
324 showLitChar '\n' s = showString "\\n" s
325 showLitChar '\r' s = showString "\\r" s
326 showLitChar '\t' s = showString "\\t" s
327 showLitChar '\v' s = showString "\\v" s
328 showLitChar '\SO' s = protectEsc (== 'H') (showString "\\SO") s
329 showLitChar c s = showString ('\\' : asciiTab!!ord c) s
330 -- I've done manual eta-expansion here, because otherwise it's
331 -- impossible to stop (asciiTab!!ord) getting floated out as an MFE
332
333 showLitString :: String -> ShowS
334 -- | Same as 'showLitChar', but for strings
335 -- It converts the string to a string using Haskell escape conventions
336 -- for non-printable characters. Does not add double-quotes around the
337 -- whole thing; the caller should do that.
338 -- The main difference from showLitChar (apart from the fact that the
339 -- argument is a string not a list) is that we must escape double-quotes
340 showLitString [] s = s
341 showLitString ('"' : cs) s = showString "\\\"" (showLitString cs s)
342 showLitString (c : cs) s = showLitChar c (showLitString cs s)
343 -- Making 's' an explicit parameter makes it clear to GHC that
344 -- showLitString has arity 2, which avoids it allocating an extra lambda
345 -- The sticking point is the recursive call to (showLitString cs), which
346 -- it can't figure out would be ok with arity 2.
347
348 showMultiLineString :: String -> [String]
349 -- | Like 'showLitString' (expand escape characters using Haskell
350 -- escape conventions), but
351 -- * break the string into multiple lines
352 -- * wrap the entire thing in double quotes
353 -- Example: @showMultiLineString "hello\ngoodbye\nblah"@
354 -- returns @["\"hello\\n\\", "\\goodbye\n\\", "\\blah\""]@
355 showMultiLineString str
356 = go '\"' str
357 where
358 go ch s = case break (== '\n') s of
359 (l, _:s'@(_:_)) -> (ch : showLitString l "\\n\\") : go '\\' s'
360 (l, "\n") -> [ch : showLitString l "\\n\""]
361 (l, _) -> [ch : showLitString l "\""]
362
363 isDec :: Char -> Bool
364 isDec c = c >= '0' && c <= '9'
365
366 protectEsc :: (Char -> Bool) -> ShowS -> ShowS
367 protectEsc p f = f . cont
368 where cont s@(c:_) | p c = "\\&" ++ s
369 cont s = s
370
371
372 asciiTab :: [String]
373 asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ')
374 ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
375 "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",
376 "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
377 "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US",
378 "SP"]
379
380 -- Code specific for Ints.
381
382 -- | Convert an 'Int' in the range @0@..@15@ to the corresponding single
383 -- digit 'Char'. This function fails on other inputs, and generates
384 -- lower-case hexadecimal digits.
385 intToDigit :: Int -> Char
386 intToDigit (I# i)
387 | isTrue# (i >=# 0#) && isTrue# (i <=# 9#) = unsafeChr (ord '0' + I# i)
388 | isTrue# (i >=# 10#) && isTrue# (i <=# 15#) = unsafeChr (ord 'a' + I# i - 10)
389 | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))
390
391 showSignedInt :: Int -> Int -> ShowS
392 showSignedInt (I# p) (I# n) r
393 | isTrue# (n <# 0#) && isTrue# (p ># 6#) = '(' : itos n (')' : r)
394 | otherwise = itos n r
395
396 itos :: Int# -> String -> String
397 itos n# cs
398 | isTrue# (n# <# 0#) =
399 let !(I# minInt#) = minInt in
400 if isTrue# (n# ==# minInt#)
401 -- negateInt# minInt overflows, so we can't do that:
402 then '-' : (case n# `quotRemInt#` 10# of
403 (# q, r #) ->
404 itos' (negateInt# q) (itos' (negateInt# r) cs))
405 else '-' : itos' (negateInt# n#) cs
406 | otherwise = itos' n# cs
407 where
408 itos' :: Int# -> String -> String
409 itos' x# cs'
410 | isTrue# (x# <# 10#) = C# (chr# (ord# '0'# +# x#)) : cs'
411 | otherwise = case x# `quotRemInt#` 10# of
412 (# q, r #) ->
413 case chr# (ord# '0'# +# r) of
414 c# ->
415 itos' q (C# c# : cs')
416
417 --------------------------------------------------------------
418 -- The Integer instances for Show
419 --------------------------------------------------------------
420
421 instance Show Integer where
422 showsPrec p n r
423 | p > 6 && n < 0 = '(' : integerToString n (')' : r)
424 -- Minor point: testing p first gives better code
425 -- in the not-uncommon case where the p argument
426 -- is a constant
427 | otherwise = integerToString n r
428 showList = showList__ (showsPrec 0)
429
430 -- Divide an conquer implementation of string conversion
431 integerToString :: Integer -> String -> String
432 integerToString n0 cs0
433 | n0 < 0 = '-' : integerToString' (- n0) cs0
434 | otherwise = integerToString' n0 cs0
435 where
436 integerToString' :: Integer -> String -> String
437 integerToString' n cs
438 | n < BASE = jhead (fromInteger n) cs
439 | otherwise = jprinth (jsplitf (BASE*BASE) n) cs
440
441 -- Split n into digits in base p. We first split n into digits
442 -- in base p*p and then split each of these digits into two.
443 -- Note that the first 'digit' modulo p*p may have a leading zero
444 -- in base p that we need to drop - this is what jsplith takes care of.
445 -- jsplitb the handles the remaining digits.
446 jsplitf :: Integer -> Integer -> [Integer]
447 jsplitf p n
448 | p > n = [n]
449 | otherwise = jsplith p (jsplitf (p*p) n)
450
451 jsplith :: Integer -> [Integer] -> [Integer]
452 jsplith p (n:ns) =
453 case n `quotRemInteger` p of
454 (# q, r #) ->
455 if q > 0 then q : r : jsplitb p ns
456 else r : jsplitb p ns
457 jsplith _ [] = error "jsplith: []"
458
459 jsplitb :: Integer -> [Integer] -> [Integer]
460 jsplitb _ [] = []
461 jsplitb p (n:ns) = case n `quotRemInteger` p of
462 (# q, r #) ->
463 q : r : jsplitb p ns
464
465 -- Convert a number that has been split into digits in base BASE^2
466 -- this includes a last splitting step and then conversion of digits
467 -- that all fit into a machine word.
468 jprinth :: [Integer] -> String -> String
469 jprinth (n:ns) cs =
470 case n `quotRemInteger` BASE of
471 (# q', r' #) ->
472 let q = fromInteger q'
473 r = fromInteger r'
474 in if q > 0 then jhead q $ jblock r $ jprintb ns cs
475 else jhead r $ jprintb ns cs
476 jprinth [] _ = error "jprinth []"
477
478 jprintb :: [Integer] -> String -> String
479 jprintb [] cs = cs
480 jprintb (n:ns) cs = case n `quotRemInteger` BASE of
481 (# q', r' #) ->
482 let q = fromInteger q'
483 r = fromInteger r'
484 in jblock q $ jblock r $ jprintb ns cs
485
486 -- Convert an integer that fits into a machine word. Again, we have two
487 -- functions, one that drops leading zeros (jhead) and one that doesn't
488 -- (jblock)
489 jhead :: Int -> String -> String
490 jhead n cs
491 | n < 10 = case unsafeChr (ord '0' + n) of
492 c@(C# _) -> c : cs
493 | otherwise = case unsafeChr (ord '0' + r) of
494 c@(C# _) -> jhead q (c : cs)
495 where
496 (q, r) = n `quotRemInt` 10
497
498 jblock = jblock' {- ' -} DIGITS
499
500 jblock' :: Int -> Int -> String -> String
501 jblock' d n cs
502 | d == 1 = case unsafeChr (ord '0' + n) of
503 c@(C# _) -> c : cs
504 | otherwise = case unsafeChr (ord '0' + r) of
505 c@(C# _) -> jblock' (d - 1) q (c : cs)
506 where
507 (q, r) = n `quotRemInt` 10