1 % ------------------------------------------------------------------------------
2 % $Id: Show.lhs,v 1.3 2001/07/03 14:13:32 simonmar Exp $
4 % (c) The University of Glasgow, 1992-2000
7 \section{Module @GHC.Show@}
11 {-# OPTIONS -fno-implicit-prelude #-}
17 -- Instances for Show: (), [], Bool, Ordering, Int, Char
20 shows, showChar, showString, showParen, showList__, showSpace,
21 showLitChar, protectEsc,
22 intToDigit, showSignedInt,
24 -- Character operations
25 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
26 isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
31 lines, unlines, words, unwords
35 import {-# SOURCE #-} GHC.Err ( error )
39 import GHC.List ( (!!), break, dropWhile
40 #ifdef USE_REPORT_PRELUDE
48 %*********************************************************
50 \subsection{The @Show@ class}
52 %*********************************************************
55 type ShowS = String -> String
58 showsPrec :: Int -> a -> ShowS
60 showList :: [a] -> ShowS
62 showsPrec _ x s = show x ++ s
64 showList ls s = showList__ shows ls s
66 showList__ :: (a -> ShowS) -> [a] -> ShowS
67 showList__ _ [] s = "[]" ++ s
68 showList__ showx (x:xs) s = '[' : showx x (showl xs)
71 showl (y:ys) = ',' : showx y (showl ys)
74 %*********************************************************
76 \subsection{Simple Instances}
78 %*********************************************************
82 instance Show () where
83 showsPrec _ () = showString "()"
85 instance Show a => Show [a] where
86 showsPrec _ = showList
88 instance Show Bool where
89 showsPrec _ True = showString "True"
90 showsPrec _ False = showString "False"
92 instance Show Ordering where
93 showsPrec _ LT = showString "LT"
94 showsPrec _ EQ = showString "EQ"
95 showsPrec _ GT = showString "GT"
97 instance Show Char where
98 showsPrec _ '\'' = showString "'\\''"
99 showsPrec _ c = showChar '\'' . showLitChar c . showChar '\''
101 showList cs = showChar '"' . showl cs
102 where showl "" s = showChar '"' s
103 showl ('"':xs) s = showString "\\\"" (showl xs s)
104 showl (x:xs) s = showLitChar x (showl xs s)
105 -- Making 's' an explicit parameter makes it clear to GHC
106 -- that showl has arity 2, which avoids it allocating an extra lambda
107 -- The sticking point is the recursive call to (showl xs), which
108 -- it can't figure out would be ok with arity 2.
110 instance Show Int where
111 showsPrec = showSignedInt
113 instance Show a => Show (Maybe a) where
114 showsPrec _p Nothing s = showString "Nothing" s
115 showsPrec (I# p#) (Just x) s
116 = (showParen (p# >=# 10#) $
118 showsPrec (I# 10#) x) s
120 instance (Show a, Show b) => Show (Either a b) where
121 showsPrec (I# p#) e s =
122 (showParen (p# >=# 10#) $
124 Left a -> showString "Left " . showsPrec (I# 10#) a
125 Right b -> showString "Right " . showsPrec (I# 10#) b)
131 %*********************************************************
133 \subsection{Show instances for the first few tuples
135 %*********************************************************
138 -- The explicit 's' parameters are important
139 -- Otherwise GHC thinks that "shows x" might take a lot of work to compute
140 -- and generates defns like
141 -- showsPrec _ (x,y) = let sx = shows x; sy = shows y in
142 -- \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s))))
144 instance (Show a, Show b) => Show (a,b) where
145 showsPrec _ (x,y) s = (showChar '(' . shows x . showChar ',' .
146 shows y . showChar ')')
149 instance (Show a, Show b, Show c) => Show (a, b, c) where
150 showsPrec _ (x,y,z) s = (showChar '(' . shows x . showChar ',' .
151 shows y . showChar ',' .
152 shows z . showChar ')')
155 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
156 showsPrec _ (w,x,y,z) s = (showChar '(' . shows w . showChar ',' .
157 shows x . showChar ',' .
158 shows y . showChar ',' .
159 shows z . showChar ')')
162 instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
163 showsPrec _ (v,w,x,y,z) s = (showChar '(' . shows v . showChar ',' .
164 shows w . showChar ',' .
165 shows x . showChar ',' .
166 shows y . showChar ',' .
167 shows z . showChar ')')
172 %*********************************************************
174 \subsection{Support code for @Show@}
176 %*********************************************************
179 shows :: (Show a) => a -> ShowS
180 shows = showsPrec zeroInt
182 showChar :: Char -> ShowS
185 showString :: String -> ShowS
188 showParen :: Bool -> ShowS -> ShowS
189 showParen b p = if b then showChar '(' . p . showChar ')' else p
192 showSpace = {-showChar ' '-} \ xs -> ' ' : xs
195 Code specific for characters
198 showLitChar :: Char -> ShowS
199 showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDigit (shows (ord c)) s)
200 showLitChar '\DEL' s = showString "\\DEL" s
201 showLitChar '\\' s = showString "\\\\" s
202 showLitChar c s | c >= ' ' = showChar c s
203 showLitChar '\a' s = showString "\\a" s
204 showLitChar '\b' s = showString "\\b" s
205 showLitChar '\f' s = showString "\\f" s
206 showLitChar '\n' s = showString "\\n" s
207 showLitChar '\r' s = showString "\\r" s
208 showLitChar '\t' s = showString "\\t" s
209 showLitChar '\v' s = showString "\\v" s
210 showLitChar '\SO' s = protectEsc (== 'H') (showString "\\SO") s
211 showLitChar c s = showString ('\\' : asciiTab!!ord c) s
212 -- I've done manual eta-expansion here, becuase otherwise it's
213 -- impossible to stop (asciiTab!!ord) getting floated out as an MFE
215 protectEsc :: (Char -> Bool) -> ShowS -> ShowS
216 protectEsc p f = f . cont
217 where cont s@(c:_) | p c = "\\&" ++ s
220 intToDigit :: Int -> Char
222 | i >=# 0# && i <=# 9# = unsafeChr (ord '0' `plusInt` I# i)
223 | i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `minusInt` I# 10# `plusInt` I# i)
224 | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))
228 Code specific for Ints.
231 showSignedInt :: Int -> Int -> ShowS
232 showSignedInt (I# p) (I# n) r
233 | n <# 0# && p ># 6# = '(' : itos n (')' : r)
234 | otherwise = itos n r
236 itos :: Int# -> String -> String
240 in if n'# <# 0# -- minInt?
241 then '-' : itos' (negateInt# (n'# `quotInt#` 10#))
242 (itos' (negateInt# (n'# `remInt#` 10#)) cs)
243 else '-' : itos' n'# cs
244 | otherwise = itos' n# cs
246 itos' :: Int# -> String -> String
248 | n# <# 10# = C# (chr# (ord# '0'# +# n#)) : cs
249 | otherwise = itos' (n# `quotInt#` 10#)
250 (C# (chr# (ord# '0'# +# (n# `remInt#` 10#))) : cs)
253 %*********************************************************
255 \subsection{Character stuff}
257 %*********************************************************
260 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
261 isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
262 isAsciiUpper, isAsciiLower :: Char -> Bool
263 isAscii c = c < '\x80'
264 isLatin1 c = c <= '\xff'
265 isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f'
266 isPrint c = not (isControl c)
268 -- isSpace includes non-breaking space
269 -- Done with explicit equalities both for efficiency, and to avoid a tiresome
270 -- recursion with GHC.List elem
271 isSpace c = c == ' ' ||
279 -- The upper case ISO characters have the multiplication sign dumped
280 -- randomly in the middle of the range. Go figure.
281 isUpper c = c >= 'A' && c <= 'Z' ||
282 c >= '\xC0' && c <= '\xD6' ||
283 c >= '\xD8' && c <= '\xDE'
284 -- The lower case ISO characters have the division sign dumped
285 -- randomly in the middle of the range. Go figure.
286 isLower c = c >= 'a' && c <= 'z' ||
287 c >= '\xDF' && c <= '\xF6' ||
288 c >= '\xF8' && c <= '\xFF'
289 isAsciiLower c = c >= 'a' && c <= 'z'
290 isAsciiUpper c = c >= 'A' && c <= 'Z'
292 isAlpha c = isLower c || isUpper c
293 isDigit c = c >= '0' && c <= '9'
294 isOctDigit c = c >= '0' && c <= '7'
295 isHexDigit c = isDigit c || c >= 'A' && c <= 'F' ||
297 isAlphaNum c = isAlpha c || isDigit c
299 -- Case-changing operations
301 toUpper, toLower :: Char -> Char
303 | isAsciiLower c = C# (chr# (ord# c# -# 32#))
305 -- fall-through to the slower stuff.
306 | isLower c && c /= '\xDF' && c /= '\xFF'
307 = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A')
314 | isAsciiUpper c = C# (chr# (ord# c# +# 32#))
316 | isUpper c = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a')
320 asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ')
321 ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
322 "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",
323 "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
324 "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US",
328 %*********************************************************
330 \subsection{Functions on strings}
332 %*********************************************************
334 lines breaks a string up into a list of strings at newline characters.
335 The resulting strings do not contain newlines. Similary, words
336 breaks a string up into a list of words, which were delimited by
337 white space. unlines and unwords are the inverse operations.
338 unlines joins lines with terminating newlines, and unwords joins
339 words with separating spaces.
342 lines :: String -> [String]
344 lines s = let (l, s') = break (== '\n') s
349 words :: String -> [String]
350 words s = case dropWhile {-partain:Char.-}isSpace s of
354 break {-partain:Char.-}isSpace s'
356 unlines :: [String] -> String
357 #ifdef USE_REPORT_PRELUDE
358 unlines = concatMap (++ "\n")
360 -- HBC version (stolen)
361 -- here's a more efficient version
363 unlines (l:ls) = l ++ '\n' : unlines ls
366 unwords :: [String] -> String
367 #ifdef USE_REPORT_PRELUDE
369 unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
371 -- HBC version (stolen)
372 -- here's a more efficient version
375 unwords (w:ws) = w ++ ' ' : unwords ws