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 = showList__ shows ls
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 "" = showChar '"'
99 showl ('"':xs) = showString "\\\"" . showl xs
100 showl (x:xs) = showLitChar x . showl xs
102 instance Show Int where
103 showsPrec p n = showSignedInt p n
105 instance Show a => Show (Maybe a) where
106 showsPrec _p Nothing = showString "Nothing"
107 showsPrec _p (Just x) = showString "Just " . shows x
108 -- Not sure I have the priorities right here
110 instance (Show a, Show b) => Show (Either a b) where
111 showsPrec _p (Left a) = showString "Left " . shows a
112 showsPrec _p (Right b) = showString "Right " . shows b
113 -- Not sure I have the priorities right here
117 %*********************************************************
119 \subsection{Show instances for the first few tuples
121 %*********************************************************
124 instance (Show a, Show b) => Show (a,b) where
125 showsPrec _ (x,y) = showChar '(' . shows x . showChar ',' .
126 shows y . showChar ')'
128 instance (Show a, Show b, Show c) => Show (a, b, c) where
129 showsPrec _ (x,y,z) = showChar '(' . shows x . showChar ',' .
130 shows y . showChar ',' .
131 shows z . showChar ')'
133 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
134 showsPrec _ (w,x,y,z) = showChar '(' . shows w . showChar ',' .
135 shows x . showChar ',' .
136 shows y . showChar ',' .
137 shows z . showChar ')'
139 instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
140 showsPrec _ (v,w,x,y,z) = showChar '(' . shows v . showChar ',' .
141 shows w . showChar ',' .
142 shows x . showChar ',' .
143 shows y . showChar ',' .
144 shows z . showChar ')'
148 %*********************************************************
150 \subsection{Support code for @Show@}
152 %*********************************************************
155 shows :: (Show a) => a -> ShowS
156 shows = showsPrec zeroInt
158 showChar :: Char -> ShowS
161 showString :: String -> ShowS
164 showParen :: Bool -> ShowS -> ShowS
165 showParen b p = if b then showChar '(' . p . showChar ')' else p
168 showSpace = {-showChar ' '-} \ xs -> ' ' : xs
171 Code specific for characters
174 showLitChar :: Char -> ShowS
175 showLitChar c | c > '\DEL' = showChar '\\' . protectEsc isDigit (shows (ord c))
176 showLitChar '\DEL' = showString "\\DEL"
177 showLitChar '\\' = showString "\\\\"
178 showLitChar c | c >= ' ' = showChar c
179 showLitChar '\a' = showString "\\a"
180 showLitChar '\b' = showString "\\b"
181 showLitChar '\f' = showString "\\f"
182 showLitChar '\n' = showString "\\n"
183 showLitChar '\r' = showString "\\r"
184 showLitChar '\t' = showString "\\t"
185 showLitChar '\v' = showString "\\v"
186 showLitChar '\SO' = protectEsc (== 'H') (showString "\\SO")
187 showLitChar c = showString ('\\' : asciiTab!!ord c)
189 protectEsc :: (Char -> Bool) -> ShowS -> ShowS
190 protectEsc p f = f . cont
191 where cont s@(c:_) | p c = "\\&" ++ s
194 intToDigit :: Int -> Char
196 | i >=# 0# && i <=# 9# = unsafeChr (ord '0' `plusInt` I# i)
197 | i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `plusInt` I# i `minusInt` I# 10#)
198 | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))
202 Code specific for Ints.
205 showSignedInt :: Int -> Int -> ShowS
206 showSignedInt (I# p) (I# n) r
207 | n <# 0# && p ># 6# = '(':itos n (')':r)
208 | otherwise = itos n r
210 itos :: Int# -> String -> String
212 | n >=# 0# = itos' n r
213 | negateInt# n <# 0# = -- n is minInt, a difficult number
214 itos (n `quotInt#` 10#) (itos' (negateInt# (n `remInt#` 10#)) r)
215 | otherwise = '-':itos' (negateInt# n) r
217 itos' :: Int# -> String -> String
220 | x <# 10# = C# (chr# (x +# ord# '0'#)) : cs
221 | otherwise = itos' (x `quotInt#` 10#)
222 (C# (chr# (x `remInt#` 10# +# ord# '0'#)) : cs)
227 %*********************************************************
229 \subsection{Character stuff}
231 %*********************************************************
234 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
235 isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum :: Char -> Bool
236 isAscii c = c < '\x80'
237 isLatin1 c = c <= '\xff'
238 isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f'
239 isPrint c = not (isControl c)
241 -- isSpace includes non-breaking space
242 -- Done with explicit equalities both for efficiency, and to avoid a tiresome
243 -- recursion with PrelList elem
244 isSpace c = c == ' ' ||
252 -- The upper case ISO characters have the multiplication sign dumped
253 -- randomly in the middle of the range. Go figure.
254 isUpper c = c >= 'A' && c <= 'Z' ||
255 c >= '\xC0' && c <= '\xD6' ||
256 c >= '\xD8' && c <= '\xDE'
257 -- The lower case ISO characters have the division sign dumped
258 -- randomly in the middle of the range. Go figure.
259 isLower c = c >= 'a' && c <= 'z' ||
260 c >= '\xDF' && c <= '\xF6' ||
261 c >= '\xF8' && c <= '\xFF'
262 isAsciiLower c = c >= 'a' && c <= 'z'
263 isAsciiUpper c = c >= 'A' && c <= 'Z'
265 isAlpha c = isLower c || isUpper c
266 isDigit c = c >= '0' && c <= '9'
267 isOctDigit c = c >= '0' && c <= '7'
268 isHexDigit c = isDigit c || c >= 'A' && c <= 'F' ||
270 isAlphaNum c = isAlpha c || isDigit c
272 -- Case-changing operations
274 toUpper, toLower :: Char -> Char
276 | isAsciiLower c = C# (chr# (ord# c# -# 32#))
278 -- fall-through to the slower stuff.
279 | isLower c && c /= '\xDF' && c /= '\xFF'
280 = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A')
287 | isAsciiUpper c = C# (chr# (ord# c# +# 32#))
289 | isUpper c = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a')
293 asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ')
294 ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
295 "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",
296 "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
297 "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US",
301 %*********************************************************
303 \subsection{Functions on strings}
305 %*********************************************************
307 lines breaks a string up into a list of strings at newline characters.
308 The resulting strings do not contain newlines. Similary, words
309 breaks a string up into a list of words, which were delimited by
310 white space. unlines and unwords are the inverse operations.
311 unlines joins lines with terminating newlines, and unwords joins
312 words with separating spaces.
315 lines :: String -> [String]
317 lines s = let (l, s') = break (== '\n') s
322 words :: String -> [String]
323 words s = case dropWhile {-partain:Char.-}isSpace s of
327 break {-partain:Char.-}isSpace s'
329 unlines :: [String] -> String
330 #ifdef USE_REPORT_PRELUDE
331 unlines = concatMap (++ "\n")
333 -- HBC version (stolen)
334 -- here's a more efficient version
336 unlines (l:ls) = l ++ '\n' : unlines ls
339 unwords :: [String] -> String
340 #ifdef USE_REPORT_PRELUDE
342 unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
344 -- HBC version (stolen)
345 -- here's a more efficient version
348 unwords (w:ws) = w ++ ' ' : unwords ws