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,
29 -- Character operations
30 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
31 isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
36 lines, unlines, words, unwords
40 import {-# SOURCE #-} GHC.Err ( error )
45 import GHC.List ( (!!), break, dropWhile
46 #ifdef USE_REPORT_PRELUDE
54 %*********************************************************
56 \subsection{The @Show@ class}
58 %*********************************************************
61 type ShowS = String -> String
64 showsPrec :: Int -> a -> ShowS
66 showList :: [a] -> ShowS
68 showsPrec _ x s = show x ++ s
70 showList ls s = showList__ shows ls s
72 showList__ :: (a -> ShowS) -> [a] -> ShowS
73 showList__ _ [] s = "[]" ++ s
74 showList__ showx (x:xs) s = '[' : showx x (showl xs)
77 showl (y:ys) = ',' : showx y (showl ys)
79 appPrec, appPrec1 :: Int
80 -- Use unboxed stuff because we don't have overloaded numerics yet
81 appPrec = I# 10# -- Precedence of application:
82 -- one more than the maximum operator precedence of 9
83 appPrec1 = I# 11# -- appPrec + 1
86 %*********************************************************
88 \subsection{Simple Instances}
90 %*********************************************************
94 instance Show () where
95 showsPrec _ () = showString "()"
97 instance Show a => Show [a] where
98 showsPrec _ = showList
100 instance Show Bool where
101 showsPrec _ True = showString "True"
102 showsPrec _ False = showString "False"
104 instance Show Ordering where
105 showsPrec _ LT = showString "LT"
106 showsPrec _ EQ = showString "EQ"
107 showsPrec _ GT = showString "GT"
109 instance Show Char where
110 showsPrec _ '\'' = showString "'\\''"
111 showsPrec _ c = showChar '\'' . showLitChar c . showChar '\''
113 showList cs = showChar '"' . showl cs
114 where showl "" s = showChar '"' s
115 showl ('"':xs) s = showString "\\\"" (showl xs s)
116 showl (x:xs) s = showLitChar x (showl xs s)
117 -- Making 's' an explicit parameter makes it clear to GHC
118 -- that showl has arity 2, which avoids it allocating an extra lambda
119 -- The sticking point is the recursive call to (showl xs), which
120 -- it can't figure out would be ok with arity 2.
122 instance Show Int where
123 showsPrec = showSignedInt
125 instance Show a => Show (Maybe a) where
126 showsPrec _p Nothing s = showString "Nothing" s
127 showsPrec p (Just x) s
128 = (showParen (p > appPrec) $
130 showsPrec appPrec1 x) s
132 instance (Show a, Show b) => Show (Either a b) where
134 (showParen (p > appPrec) $
136 Left a -> showString "Left " . showsPrec appPrec1 a
137 Right b -> showString "Right " . showsPrec appPrec1 b)
142 %*********************************************************
144 \subsection{Show instances for the first few tuples
146 %*********************************************************
149 -- The explicit 's' parameters are important
150 -- Otherwise GHC thinks that "shows x" might take a lot of work to compute
151 -- and generates defns like
152 -- showsPrec _ (x,y) = let sx = shows x; sy = shows y in
153 -- \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s))))
155 instance (Show a, Show b) => Show (a,b) where
156 showsPrec _ (x,y) s = (showChar '(' . shows x . showChar ',' .
157 shows y . showChar ')')
160 instance (Show a, Show b, Show c) => Show (a, b, c) where
161 showsPrec _ (x,y,z) s = (showChar '(' . shows x . showChar ',' .
162 shows y . showChar ',' .
163 shows z . showChar ')')
166 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
167 showsPrec _ (w,x,y,z) s = (showChar '(' . shows w . showChar ',' .
168 shows x . showChar ',' .
169 shows y . showChar ',' .
170 shows z . showChar ')')
173 instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
174 showsPrec _ (v,w,x,y,z) s = (showChar '(' . shows v . showChar ',' .
175 shows w . showChar ',' .
176 shows x . showChar ',' .
177 shows y . showChar ',' .
178 shows z . showChar ')')
183 %*********************************************************
185 \subsection{Support code for @Show@}
187 %*********************************************************
190 shows :: (Show a) => a -> ShowS
191 shows = showsPrec zeroInt
193 showChar :: Char -> ShowS
196 showString :: String -> ShowS
199 showParen :: Bool -> ShowS -> ShowS
200 showParen b p = if b then showChar '(' . p . showChar ')' else p
203 showSpace = {-showChar ' '-} \ xs -> ' ' : xs
206 Code specific for characters
209 showLitChar :: Char -> ShowS
210 showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDigit (shows (ord c)) s)
211 showLitChar '\DEL' s = showString "\\DEL" s
212 showLitChar '\\' s = showString "\\\\" s
213 showLitChar c s | c >= ' ' = showChar c s
214 showLitChar '\a' s = showString "\\a" s
215 showLitChar '\b' s = showString "\\b" s
216 showLitChar '\f' s = showString "\\f" s
217 showLitChar '\n' s = showString "\\n" s
218 showLitChar '\r' s = showString "\\r" s
219 showLitChar '\t' s = showString "\\t" s
220 showLitChar '\v' s = showString "\\v" s
221 showLitChar '\SO' s = protectEsc (== 'H') (showString "\\SO") s
222 showLitChar c s = showString ('\\' : asciiTab!!ord c) s
223 -- I've done manual eta-expansion here, becuase otherwise it's
224 -- impossible to stop (asciiTab!!ord) getting floated out as an MFE
226 protectEsc :: (Char -> Bool) -> ShowS -> ShowS
227 protectEsc p f = f . cont
228 where cont s@(c:_) | p c = "\\&" ++ s
232 Code specific for Ints.
235 intToDigit :: Int -> Char
237 | i >=# 0# && i <=# 9# = unsafeChr (ord '0' `plusInt` I# i)
238 | i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `minusInt` ten `plusInt` I# i)
239 | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))
241 digitToInt :: Char -> Int
243 | isDigit c = ord c `minusInt` ord '0'
244 | c >= 'a' && c <= 'f' = ord c `minusInt` ord 'a' `plusInt` ten
245 | c >= 'A' && c <= 'F' = ord c `minusInt` ord 'A' `plusInt` ten
246 | otherwise = error ("Char.digitToInt: not a digit " ++ show c) -- sigh
250 showSignedInt :: Int -> Int -> ShowS
251 showSignedInt (I# p) (I# n) r
252 | n <# 0# && p ># 6# = '(' : itos n (')' : r)
253 | otherwise = itos n r
255 itos :: Int# -> String -> String
259 in if n'# <# 0# -- minInt?
260 then '-' : itos' (negateInt# (n'# `quotInt#` 10#))
261 (itos' (negateInt# (n'# `remInt#` 10#)) cs)
262 else '-' : itos' n'# cs
263 | otherwise = itos' n# cs
265 itos' :: Int# -> String -> String
267 | n# <# 10# = C# (chr# (ord# '0'# +# n#)) : cs
268 | otherwise = case chr# (ord# '0'# +# (n# `remInt#` 10#)) of { c# ->
269 itos' (n# `quotInt#` 10#) (C# c# : cs) }
273 %*********************************************************
275 \subsection{Character stuff}
277 %*********************************************************
280 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
281 isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
282 isAsciiUpper, isAsciiLower :: Char -> Bool
283 isAscii c = c < '\x80'
284 isLatin1 c = c <= '\xff'
285 isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f'
286 isPrint c = not (isControl c)
288 -- isSpace includes non-breaking space
289 -- Done with explicit equalities both for efficiency, and to avoid a tiresome
290 -- recursion with GHC.List elem
291 isSpace c = c == ' ' ||
299 -- The upper case ISO characters have the multiplication sign dumped
300 -- randomly in the middle of the range. Go figure.
301 isUpper c = c >= 'A' && c <= 'Z' ||
302 c >= '\xC0' && c <= '\xD6' ||
303 c >= '\xD8' && c <= '\xDE'
304 -- The lower case ISO characters have the division sign dumped
305 -- randomly in the middle of the range. Go figure.
306 isLower c = c >= 'a' && c <= 'z' ||
307 c >= '\xDF' && c <= '\xF6' ||
308 c >= '\xF8' && c <= '\xFF'
309 isAsciiLower c = c >= 'a' && c <= 'z'
310 isAsciiUpper c = c >= 'A' && c <= 'Z'
312 isAlpha c = isLower c || isUpper c
313 isDigit c = c >= '0' && c <= '9'
314 isOctDigit c = c >= '0' && c <= '7'
315 isHexDigit c = isDigit c || c >= 'A' && c <= 'F' ||
317 isAlphaNum c = isAlpha c || isDigit c
319 -- Case-changing operations
321 toUpper, toLower :: Char -> Char
323 | isAsciiLower c = C# (chr# (ord# c# -# 32#))
325 -- fall-through to the slower stuff.
326 | isLower c && c /= '\xDF' && c /= '\xFF'
327 = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A')
333 | isAsciiUpper c = C# (chr# (ord# c# +# 32#))
335 | isUpper c = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a')
339 asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ')
340 ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
341 "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",
342 "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
343 "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US",
347 %*********************************************************
349 \subsection{Functions on strings}
351 %*********************************************************
353 lines breaks a string up into a list of strings at newline characters.
354 The resulting strings do not contain newlines. Similary, words
355 breaks a string up into a list of words, which were delimited by
356 white space. unlines and unwords are the inverse operations.
357 unlines joins lines with terminating newlines, and unwords joins
358 words with separating spaces.
361 lines :: String -> [String]
363 lines s = let (l, s') = break (== '\n') s
368 words :: String -> [String]
369 words s = case dropWhile {-partain:Char.-}isSpace s of
373 break {-partain:Char.-}isSpace s'
375 unlines :: [String] -> String
376 #ifdef USE_REPORT_PRELUDE
377 unlines = concatMap (++ "\n")
379 -- HBC version (stolen)
380 -- here's a more efficient version
382 unlines (l:ls) = l ++ '\n' : unlines ls
385 unwords :: [String] -> String
386 #ifdef USE_REPORT_PRELUDE
388 unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
390 -- HBC version (stolen)
391 -- here's a more efficient version
394 unwords (w:ws) = w ++ ' ' : unwords ws