2 {-# OPTIONS -fno-implicit-prelude #-}
3 -----------------------------------------------------------------------------
6 -- Copyright : (c) The University of Glasgow, 1992-2002
7 -- License : see libraries/base/LICENSE
9 -- Maintainer : cvs-ghc@haskell.org
10 -- Stability : internal
11 -- Portability : non-portable (GHC Extensions)
13 -- The 'Show' class, and related operations.
15 -----------------------------------------------------------------------------
21 -- Instances for Show: (), [], Bool, Ordering, Int, Char
24 shows, showChar, showString, showParen, showList__, showSpace,
25 showLitChar, protectEsc,
26 intToDigit, digitToInt, showSignedInt,
28 -- Character operations
29 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
30 isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
35 lines, unlines, words, unwords
39 import {-# SOURCE #-} GHC.Err ( error )
44 import GHC.List ( (!!), break, dropWhile
45 #ifdef USE_REPORT_PRELUDE
53 %*********************************************************
55 \subsection{The @Show@ class}
57 %*********************************************************
60 type ShowS = String -> String
63 showsPrec :: Int -> a -> ShowS
65 showList :: [a] -> ShowS
67 showsPrec _ x s = show x ++ s
69 showList ls s = showList__ shows ls s
71 showList__ :: (a -> ShowS) -> [a] -> ShowS
72 showList__ _ [] s = "[]" ++ s
73 showList__ showx (x:xs) s = '[' : showx x (showl xs)
76 showl (y:ys) = ',' : showx y (showl ys)
79 %*********************************************************
81 \subsection{Simple Instances}
83 %*********************************************************
87 instance Show () where
88 showsPrec _ () = showString "()"
90 instance Show a => Show [a] where
91 showsPrec _ = showList
93 instance Show Bool where
94 showsPrec _ True = showString "True"
95 showsPrec _ False = showString "False"
97 instance Show Ordering where
98 showsPrec _ LT = showString "LT"
99 showsPrec _ EQ = showString "EQ"
100 showsPrec _ GT = showString "GT"
102 instance Show Char where
103 showsPrec _ '\'' = showString "'\\''"
104 showsPrec _ c = showChar '\'' . showLitChar c . showChar '\''
106 showList cs = showChar '"' . showl cs
107 where showl "" s = showChar '"' s
108 showl ('"':xs) s = showString "\\\"" (showl xs s)
109 showl (x:xs) s = showLitChar x (showl xs s)
110 -- Making 's' an explicit parameter makes it clear to GHC
111 -- that showl has arity 2, which avoids it allocating an extra lambda
112 -- The sticking point is the recursive call to (showl xs), which
113 -- it can't figure out would be ok with arity 2.
115 instance Show Int where
116 showsPrec = showSignedInt
118 instance Show a => Show (Maybe a) where
119 showsPrec _p Nothing s = showString "Nothing" s
120 showsPrec (I# p#) (Just x) s
121 = (showParen (p# >=# 10#) $
123 showsPrec (I# 10#) x) s
125 instance (Show a, Show b) => Show (Either a b) where
126 showsPrec (I# p#) e s =
127 (showParen (p# >=# 10#) $
129 Left a -> showString "Left " . showsPrec (I# 10#) a
130 Right b -> showString "Right " . showsPrec (I# 10#) b)
136 %*********************************************************
138 \subsection{Show instances for the first few tuples
140 %*********************************************************
143 -- The explicit 's' parameters are important
144 -- Otherwise GHC thinks that "shows x" might take a lot of work to compute
145 -- and generates defns like
146 -- showsPrec _ (x,y) = let sx = shows x; sy = shows y in
147 -- \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s))))
149 instance (Show a, Show b) => Show (a,b) where
150 showsPrec _ (x,y) s = (showChar '(' . shows x . showChar ',' .
151 shows y . showChar ')')
154 instance (Show a, Show b, Show c) => Show (a, b, c) where
155 showsPrec _ (x,y,z) s = (showChar '(' . shows x . showChar ',' .
156 shows y . showChar ',' .
157 shows z . showChar ')')
160 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
161 showsPrec _ (w,x,y,z) s = (showChar '(' . shows w . showChar ',' .
162 shows x . showChar ',' .
163 shows y . showChar ',' .
164 shows z . showChar ')')
167 instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
168 showsPrec _ (v,w,x,y,z) s = (showChar '(' . shows v . showChar ',' .
169 shows w . showChar ',' .
170 shows x . showChar ',' .
171 shows y . showChar ',' .
172 shows z . showChar ')')
177 %*********************************************************
179 \subsection{Support code for @Show@}
181 %*********************************************************
184 shows :: (Show a) => a -> ShowS
185 shows = showsPrec zeroInt
187 showChar :: Char -> ShowS
190 showString :: String -> ShowS
193 showParen :: Bool -> ShowS -> ShowS
194 showParen b p = if b then showChar '(' . p . showChar ')' else p
197 showSpace = {-showChar ' '-} \ xs -> ' ' : xs
200 Code specific for characters
203 showLitChar :: Char -> ShowS
204 showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDigit (shows (ord c)) s)
205 showLitChar '\DEL' s = showString "\\DEL" s
206 showLitChar '\\' s = showString "\\\\" s
207 showLitChar c s | c >= ' ' = showChar c s
208 showLitChar '\a' s = showString "\\a" s
209 showLitChar '\b' s = showString "\\b" s
210 showLitChar '\f' s = showString "\\f" s
211 showLitChar '\n' s = showString "\\n" s
212 showLitChar '\r' s = showString "\\r" s
213 showLitChar '\t' s = showString "\\t" s
214 showLitChar '\v' s = showString "\\v" s
215 showLitChar '\SO' s = protectEsc (== 'H') (showString "\\SO") s
216 showLitChar c s = showString ('\\' : asciiTab!!ord c) s
217 -- I've done manual eta-expansion here, becuase otherwise it's
218 -- impossible to stop (asciiTab!!ord) getting floated out as an MFE
220 protectEsc :: (Char -> Bool) -> ShowS -> ShowS
221 protectEsc p f = f . cont
222 where cont s@(c:_) | p c = "\\&" ++ s
226 Code specific for Ints.
229 intToDigit :: Int -> Char
231 | i >=# 0# && i <=# 9# = unsafeChr (ord '0' `plusInt` I# i)
232 | i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `minusInt` ten `plusInt` I# i)
233 | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))
235 digitToInt :: Char -> Int
237 | isDigit c = ord c `minusInt` ord '0'
238 | c >= 'a' && c <= 'f' = ord c `minusInt` ord 'a' `plusInt` ten
239 | c >= 'A' && c <= 'F' = ord c `minusInt` ord 'A' `plusInt` ten
240 | otherwise = error ("Char.digitToInt: not a digit " ++ show c) -- sigh
244 showSignedInt :: Int -> Int -> ShowS
245 showSignedInt (I# p) (I# n) r
246 | n <# 0# && p ># 6# = '(' : itos n (')' : r)
247 | otherwise = itos n r
249 itos :: Int# -> String -> String
253 in if n'# <# 0# -- minInt?
254 then '-' : itos' (negateInt# (n'# `quotInt#` 10#))
255 (itos' (negateInt# (n'# `remInt#` 10#)) cs)
256 else '-' : itos' n'# cs
257 | otherwise = itos' n# cs
259 itos' :: Int# -> String -> String
261 | n# <# 10# = C# (chr# (ord# '0'# +# n#)) : cs
262 | otherwise = case chr# (ord# '0'# +# (n# `remInt#` 10#)) of { c# ->
263 itos' (n# `quotInt#` 10#) (C# c# : cs) }
267 %*********************************************************
269 \subsection{Character stuff}
271 %*********************************************************
274 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
275 isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
276 isAsciiUpper, isAsciiLower :: Char -> Bool
277 isAscii c = c < '\x80'
278 isLatin1 c = c <= '\xff'
279 isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f'
280 isPrint c = not (isControl c)
282 -- isSpace includes non-breaking space
283 -- Done with explicit equalities both for efficiency, and to avoid a tiresome
284 -- recursion with GHC.List elem
285 isSpace c = c == ' ' ||
293 -- The upper case ISO characters have the multiplication sign dumped
294 -- randomly in the middle of the range. Go figure.
295 isUpper c = c >= 'A' && c <= 'Z' ||
296 c >= '\xC0' && c <= '\xD6' ||
297 c >= '\xD8' && c <= '\xDE'
298 -- The lower case ISO characters have the division sign dumped
299 -- randomly in the middle of the range. Go figure.
300 isLower c = c >= 'a' && c <= 'z' ||
301 c >= '\xDF' && c <= '\xF6' ||
302 c >= '\xF8' && c <= '\xFF'
303 isAsciiLower c = c >= 'a' && c <= 'z'
304 isAsciiUpper c = c >= 'A' && c <= 'Z'
306 isAlpha c = isLower c || isUpper c
307 isDigit c = c >= '0' && c <= '9'
308 isOctDigit c = c >= '0' && c <= '7'
309 isHexDigit c = isDigit c || c >= 'A' && c <= 'F' ||
311 isAlphaNum c = isAlpha c || isDigit c
313 -- Case-changing operations
315 toUpper, toLower :: Char -> Char
317 | isAsciiLower c = C# (chr# (ord# c# -# 32#))
319 -- fall-through to the slower stuff.
320 | isLower c && c /= '\xDF' && c /= '\xFF'
321 = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A')
327 | isAsciiUpper c = C# (chr# (ord# c# +# 32#))
329 | isUpper c = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a')
333 asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ')
334 ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
335 "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",
336 "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
337 "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US",
341 %*********************************************************
343 \subsection{Functions on strings}
345 %*********************************************************
347 lines breaks a string up into a list of strings at newline characters.
348 The resulting strings do not contain newlines. Similary, words
349 breaks a string up into a list of words, which were delimited by
350 white space. unlines and unwords are the inverse operations.
351 unlines joins lines with terminating newlines, and unwords joins
352 words with separating spaces.
355 lines :: String -> [String]
357 lines s = let (l, s') = break (== '\n') s
362 words :: String -> [String]
363 words s = case dropWhile {-partain:Char.-}isSpace s of
367 break {-partain:Char.-}isSpace s'
369 unlines :: [String] -> String
370 #ifdef USE_REPORT_PRELUDE
371 unlines = concatMap (++ "\n")
373 -- HBC version (stolen)
374 -- here's a more efficient version
376 unlines (l:ls) = l ++ '\n' : unlines ls
379 unwords :: [String] -> String
380 #ifdef USE_REPORT_PRELUDE
382 unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
384 -- HBC version (stolen)
385 -- here's a more efficient version
388 unwords (w:ws) = w ++ ' ' : unwords ws