2 % (c) The GRAP/AQUA Project, Glasgow University, 1992-1996
4 \section{Module @PrelShow@}
8 {-# OPTIONS -fno-implicit-prelude #-}
14 -- Instances for Show: (), [], Bool, Ordering, Int, Char
17 shows, showChar, showString, showParen, showList__, showSpace,
18 showLitChar, protectEsc,
19 intToDigit, showSignedInt,
21 -- Character operations
22 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
23 isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
28 lines, unlines, words, unwords
32 import {-# SOURCE #-} PrelErr ( error )
35 import PrelList ( (!!), break, dropWhile
36 #ifdef USE_REPORT_PRELUDE
44 %*********************************************************
46 \subsection{The @Show@ class}
48 %*********************************************************
51 type ShowS = String -> String
54 showsPrec :: Int -> a -> ShowS
56 showList :: [a] -> ShowS
58 showsPrec _ x s = show x ++ s
60 showList ls s = showList__ shows ls s
62 showList__ :: (a -> ShowS) -> [a] -> ShowS
63 showList__ _ [] s = "[]" ++ s
64 showList__ showx (x:xs) s = '[' : showx x (showl xs)
67 showl (y:ys) = ',' : showx y (showl ys)
70 %*********************************************************
72 \subsection{Simple Instances}
74 %*********************************************************
78 instance Show () where
79 showsPrec _ () = showString "()"
81 instance Show a => Show [a] where
82 showsPrec _ = showList
84 instance Show Bool where
85 showsPrec _ True = showString "True"
86 showsPrec _ False = showString "False"
88 instance Show Ordering where
89 showsPrec _ LT = showString "LT"
90 showsPrec _ EQ = showString "EQ"
91 showsPrec _ GT = showString "GT"
93 instance Show Char where
94 showsPrec _ '\'' = showString "'\\''"
95 showsPrec _ c = showChar '\'' . showLitChar c . showChar '\''
97 showList cs = showChar '"' . showl cs
98 where showl "" s = showChar '"' s
99 showl ('"':xs) s = showString "\\\"" (showl xs s)
100 showl (x:xs) s = showLitChar x (showl xs s)
101 -- Making 's' an explicit parameter makes it clear to GHC
102 -- that showl has arity 2, which avoids it allocating an extra lambda
103 -- The sticking point is the recursive call to (showl xs), which
104 -- it can't figure out would be ok with arity 2.
106 instance Show Int where
107 showsPrec p n = showSignedInt p n
109 instance Show a => Show (Maybe a) where
110 showsPrec _p Nothing s = showString "Nothing" s
111 showsPrec p@(I# p#) (Just x) s
112 = (showParen (p# >=# 10#) $
114 showsPrec (I# 10#) x) s
116 instance (Show a, Show b) => Show (Either a b) where
117 showsPrec p@(I# p#) e s =
118 (showParen (p# >=# 10#) $
120 Left a -> showString "Left " . showsPrec (I# 10#) a
121 Right b -> showString "Right " . showsPrec (I# 10#) b)
127 %*********************************************************
129 \subsection{Show instances for the first few tuples
131 %*********************************************************
134 -- The explicit 's' parameters are important
135 -- Otherwise GHC thinks that "shows x" might take a lot of work to compute
136 -- and generates defns like
137 -- showsPrec _ (x,y) = let sx = shows x; sy = shows y in
138 -- \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s))))
140 instance (Show a, Show b) => Show (a,b) where
141 showsPrec _ (x,y) s = (showChar '(' . shows x . showChar ',' .
142 shows y . showChar ')')
145 instance (Show a, Show b, Show c) => Show (a, b, c) where
146 showsPrec _ (x,y,z) s = (showChar '(' . shows x . showChar ',' .
147 shows y . showChar ',' .
148 shows z . showChar ')')
151 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
152 showsPrec _ (w,x,y,z) s = (showChar '(' . shows w . showChar ',' .
153 shows x . showChar ',' .
154 shows y . showChar ',' .
155 shows z . showChar ')')
158 instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
159 showsPrec _ (v,w,x,y,z) s = (showChar '(' . shows v . showChar ',' .
160 shows w . showChar ',' .
161 shows x . showChar ',' .
162 shows y . showChar ',' .
163 shows z . showChar ')')
168 %*********************************************************
170 \subsection{Support code for @Show@}
172 %*********************************************************
175 shows :: (Show a) => a -> ShowS
176 shows = showsPrec zeroInt
178 showChar :: Char -> ShowS
181 showString :: String -> ShowS
184 showParen :: Bool -> ShowS -> ShowS
185 showParen b p = if b then showChar '(' . p . showChar ')' else p
188 showSpace = {-showChar ' '-} \ xs -> ' ' : xs
191 Code specific for characters
194 showLitChar :: Char -> ShowS
195 showLitChar c | c > '\DEL' = \s -> showChar '\\' (protectEsc isDigit (shows (ord c)) s)
196 showLitChar '\DEL' = showString "\\DEL"
197 showLitChar '\\' = showString "\\\\"
198 showLitChar c | c >= ' ' = showChar c
199 showLitChar '\a' = showString "\\a"
200 showLitChar '\b' = showString "\\b"
201 showLitChar '\f' = showString "\\f"
202 showLitChar '\n' = showString "\\n"
203 showLitChar '\r' = showString "\\r"
204 showLitChar '\t' = showString "\\t"
205 showLitChar '\v' = showString "\\v"
206 showLitChar '\SO' = \s -> protectEsc (== 'H') (showString "\\SO") s
207 showLitChar c = \s -> showString ('\\' : asciiTab!!ord c) s
208 -- The "\s ->" here means that GHC knows it's ok to put the
209 -- asciiTab!!ord c inside the lambda. Otherwise we get an extra
210 -- lambda allocated, and that can be pretty bad
212 protectEsc :: (Char -> Bool) -> ShowS -> ShowS
213 protectEsc p f = f . cont
214 where cont s@(c:_) | p c = "\\&" ++ s
217 intToDigit :: Int -> Char
219 | i >=# 0# && i <=# 9# = unsafeChr (ord '0' `plusInt` I# i)
220 | i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `plusInt` I# i `minusInt` I# 10#)
221 | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))
225 Code specific for Ints.
228 showSignedInt :: Int -> Int -> ShowS
229 showSignedInt (I# p) (I# n) r
230 | n <# 0# && p ># 6# = '(':itos n (')':r)
231 | otherwise = itos n r
233 itos :: Int# -> String -> String
235 | n >=# 0# = itos' n r
236 | negateInt# n <# 0# = -- n is minInt, a difficult number
237 itos (n `quotInt#` 10#) (itos' (negateInt# (n `remInt#` 10#)) r)
238 | otherwise = '-':itos' (negateInt# n) r
240 itos' :: Int# -> String -> String
243 | x <# 10# = C# (chr# (x +# ord# '0'#)) : cs
244 | otherwise = itos' (x `quotInt#` 10#)
245 (C# (chr# (x `remInt#` 10# +# ord# '0'#)) : cs)
248 %*********************************************************
250 \subsection{Character stuff}
252 %*********************************************************
255 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
256 isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum :: Char -> Bool
257 isAscii c = c < '\x80'
258 isLatin1 c = c <= '\xff'
259 isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f'
260 isPrint c = not (isControl c)
262 -- isSpace includes non-breaking space
263 -- Done with explicit equalities both for efficiency, and to avoid a tiresome
264 -- recursion with PrelList elem
265 isSpace c = c == ' ' ||
273 -- The upper case ISO characters have the multiplication sign dumped
274 -- randomly in the middle of the range. Go figure.
275 isUpper c = c >= 'A' && c <= 'Z' ||
276 c >= '\xC0' && c <= '\xD6' ||
277 c >= '\xD8' && c <= '\xDE'
278 -- The lower case ISO characters have the division sign dumped
279 -- randomly in the middle of the range. Go figure.
280 isLower c = c >= 'a' && c <= 'z' ||
281 c >= '\xDF' && c <= '\xF6' ||
282 c >= '\xF8' && c <= '\xFF'
283 isAsciiLower c = c >= 'a' && c <= 'z'
284 isAsciiUpper c = c >= 'A' && c <= 'Z'
286 isAlpha c = isLower c || isUpper c
287 isDigit c = c >= '0' && c <= '9'
288 isOctDigit c = c >= '0' && c <= '7'
289 isHexDigit c = isDigit c || c >= 'A' && c <= 'F' ||
291 isAlphaNum c = isAlpha c || isDigit c
293 -- Case-changing operations
295 toUpper, toLower :: Char -> Char
297 | isAsciiLower c = C# (chr# (ord# c# -# 32#))
299 -- fall-through to the slower stuff.
300 | isLower c && c /= '\xDF' && c /= '\xFF'
301 = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A')
308 | isAsciiUpper c = C# (chr# (ord# c# +# 32#))
310 | isUpper c = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a')
314 asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ')
315 ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
316 "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",
317 "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
318 "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US",
322 %*********************************************************
324 \subsection{Functions on strings}
326 %*********************************************************
328 lines breaks a string up into a list of strings at newline characters.
329 The resulting strings do not contain newlines. Similary, words
330 breaks a string up into a list of words, which were delimited by
331 white space. unlines and unwords are the inverse operations.
332 unlines joins lines with terminating newlines, and unwords joins
333 words with separating spaces.
336 lines :: String -> [String]
338 lines s = let (l, s') = break (== '\n') s
343 words :: String -> [String]
344 words s = case dropWhile {-partain:Char.-}isSpace s of
348 break {-partain:Char.-}isSpace s'
350 unlines :: [String] -> String
351 #ifdef USE_REPORT_PRELUDE
352 unlines = concatMap (++ "\n")
354 -- HBC version (stolen)
355 -- here's a more efficient version
357 unlines (l:ls) = l ++ '\n' : unlines ls
360 unwords :: [String] -> String
361 #ifdef USE_REPORT_PRELUDE
363 unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
365 -- HBC version (stolen)
366 -- here's a more efficient version
369 unwords (w:ws) = w ++ ' ' : unwords ws