1 % ------------------------------------------------------------------------------
2 % $Id: PrelShow.lhs,v 1.12 2000/09/14 13:46:42 simonpj Exp $
4 % (c) The University of Glasgow, 1992-2000
7 \section{Module @PrelShow@}
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 #-} PrelErr ( error )
39 import PrelList ( (!!), 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 p n = showSignedInt p n
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' `plusInt` I# i `minusInt` I# 10#)
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
238 | n >=# 0# = itos' n r
239 | negateInt# n <# 0# = -- n is minInt, a difficult number
240 itos (n `quotInt#` 10#) (itos' (negateInt# (n `remInt#` 10#)) r)
241 | otherwise = '-':itos' (negateInt# n) r
243 itos' :: Int# -> String -> String
246 | x <# 10# = C# (chr# (x +# ord# '0'#)) : cs
247 | otherwise = itos' (x `quotInt#` 10#)
248 (C# (chr# (x `remInt#` 10# +# ord# '0'#)) : cs)
251 %*********************************************************
253 \subsection{Character stuff}
255 %*********************************************************
258 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
259 isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
260 isAsciiUpper, isAsciiLower :: Char -> Bool
261 isAscii c = c < '\x80'
262 isLatin1 c = c <= '\xff'
263 isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f'
264 isPrint c = not (isControl c)
266 -- isSpace includes non-breaking space
267 -- Done with explicit equalities both for efficiency, and to avoid a tiresome
268 -- recursion with PrelList elem
269 isSpace c = c == ' ' ||
277 -- The upper case ISO characters have the multiplication sign dumped
278 -- randomly in the middle of the range. Go figure.
279 isUpper c = c >= 'A' && c <= 'Z' ||
280 c >= '\xC0' && c <= '\xD6' ||
281 c >= '\xD8' && c <= '\xDE'
282 -- The lower case ISO characters have the division sign dumped
283 -- randomly in the middle of the range. Go figure.
284 isLower c = c >= 'a' && c <= 'z' ||
285 c >= '\xDF' && c <= '\xF6' ||
286 c >= '\xF8' && c <= '\xFF'
287 isAsciiLower c = c >= 'a' && c <= 'z'
288 isAsciiUpper c = c >= 'A' && c <= 'Z'
290 isAlpha c = isLower c || isUpper c
291 isDigit c = c >= '0' && c <= '9'
292 isOctDigit c = c >= '0' && c <= '7'
293 isHexDigit c = isDigit c || c >= 'A' && c <= 'F' ||
295 isAlphaNum c = isAlpha c || isDigit c
297 -- Case-changing operations
299 toUpper, toLower :: Char -> Char
301 | isAsciiLower c = C# (chr# (ord# c# -# 32#))
303 -- fall-through to the slower stuff.
304 | isLower c && c /= '\xDF' && c /= '\xFF'
305 = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A')
312 | isAsciiUpper c = C# (chr# (ord# c# +# 32#))
314 | isUpper c = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a')
318 asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ')
319 ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
320 "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",
321 "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
322 "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US",
326 %*********************************************************
328 \subsection{Functions on strings}
330 %*********************************************************
332 lines breaks a string up into a list of strings at newline characters.
333 The resulting strings do not contain newlines. Similary, words
334 breaks a string up into a list of words, which were delimited by
335 white space. unlines and unwords are the inverse operations.
336 unlines joins lines with terminating newlines, and unwords joins
337 words with separating spaces.
340 lines :: String -> [String]
342 lines s = let (l, s') = break (== '\n') s
347 words :: String -> [String]
348 words s = case dropWhile {-partain:Char.-}isSpace s of
352 break {-partain:Char.-}isSpace s'
354 unlines :: [String] -> String
355 #ifdef USE_REPORT_PRELUDE
356 unlines = concatMap (++ "\n")
358 -- HBC version (stolen)
359 -- here's a more efficient version
361 unlines (l:ls) = l ++ '\n' : unlines ls
364 unwords :: [String] -> String
365 #ifdef USE_REPORT_PRELUDE
367 unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
369 -- HBC version (stolen)
370 -- here's a more efficient version
373 unwords (w:ws) = w ++ ' ' : unwords ws