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