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 )
40 %*********************************************************
42 \subsection{The @Show@ class}
44 %*********************************************************
47 type ShowS = String -> String
50 showsPrec :: Int -> a -> ShowS
52 showList :: [a] -> ShowS
54 showsPrec _ x s = show x ++ s
56 showList ls = showList__ shows ls
58 showList__ :: (a -> ShowS) -> [a] -> ShowS
59 showList__ _ [] s = "[]" ++ s
60 showList__ showx (x:xs) s = '[' : showx x (showl xs)
63 showl (y:ys) = ',' : showx y (showl ys)
66 %*********************************************************
68 \subsection{Simple Instances}
70 %*********************************************************
74 instance Show () where
75 showsPrec _ () = showString "()"
77 instance Show a => Show [a] where
78 showsPrec _ = showList
80 instance Show Bool where
81 showsPrec _ True = showString "True"
82 showsPrec _ False = showString "False"
84 instance Show Ordering where
85 showsPrec _ LT = showString "LT"
86 showsPrec _ EQ = showString "EQ"
87 showsPrec _ GT = showString "EQ"
89 instance Show Char where
90 showsPrec _ '\'' = showString "'\\''"
91 showsPrec _ c = showChar '\'' . showLitChar c . showChar '\''
93 showList cs = showChar '"' . showl cs
94 where showl "" = showChar '"'
95 showl ('"':xs) = showString "\\\"" . showl xs
96 showl (x:xs) = showLitChar x . showl xs
98 instance Show Int where
99 showsPrec p n = showSignedInt p n
101 instance Show a => Show (Maybe a) where
102 showsPrec p Nothing = showString "Nothing"
103 showsPrec p (Just x) = showString "Just " . shows x
104 -- Not sure I have the priorities right here
106 instance (Show a, Show b) => Show (Either a b) where
107 showsPrec p (Left a) = showString "Left " . shows a
108 showsPrec p (Right b) = showString "Right " . shows b
109 -- Not sure I have the priorities right here
113 %*********************************************************
115 \subsection{Show instances for the first few tuples
117 %*********************************************************
120 instance (Show a, Show b) => Show (a,b) where
121 showsPrec _ (x,y) = showChar '(' . shows x . showChar ',' .
122 shows y . showChar ')'
124 instance (Show a, Show b, Show c) => Show (a, b, c) where
125 showsPrec _ (x,y,z) = showChar '(' . shows x . showChar ',' .
126 shows y . showChar ',' .
127 shows z . showChar ')'
129 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
130 showsPrec _ (w,x,y,z) = showChar '(' . shows w . showChar ',' .
131 shows x . showChar ',' .
132 shows y . showChar ',' .
133 shows z . showChar ')'
135 instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
136 showsPrec _ (v,w,x,y,z) = showChar '(' . shows v . showChar ',' .
137 shows w . showChar ',' .
138 shows x . showChar ',' .
139 shows y . showChar ',' .
140 shows z . showChar ')'
144 %*********************************************************
146 \subsection{Support code for @Show@}
148 %*********************************************************
151 shows :: (Show a) => a -> ShowS
152 shows = showsPrec zeroInt
154 showChar :: Char -> ShowS
157 showString :: String -> ShowS
160 showParen :: Bool -> ShowS -> ShowS
161 showParen b p = if b then showChar '(' . p . showChar ')' else p
164 showSpace = {-showChar ' '-} \ xs -> ' ' : xs
167 Code specific for characters
170 showLitChar :: Char -> ShowS
171 showLitChar c | c > '\DEL' = showChar '\\' . protectEsc isDigit (shows (ord c))
172 showLitChar '\DEL' = showString "\\DEL"
173 showLitChar '\\' = showString "\\\\"
174 showLitChar c | c >= ' ' = showChar c
175 showLitChar '\a' = showString "\\a"
176 showLitChar '\b' = showString "\\b"
177 showLitChar '\f' = showString "\\f"
178 showLitChar '\n' = showString "\\n"
179 showLitChar '\r' = showString "\\r"
180 showLitChar '\t' = showString "\\t"
181 showLitChar '\v' = showString "\\v"
182 showLitChar '\SO' = protectEsc (== 'H') (showString "\\SO")
183 showLitChar c = showString ('\\' : asciiTab!!ord c)
185 protectEsc :: (Char -> Bool) -> ShowS -> ShowS
186 protectEsc p f = f . cont
187 where cont s@(c:_) | p c = "\\&" ++ s
190 intToDigit :: Int -> Char
192 | i >=# 0# && i <=# 9# = unsafeChr (ord '0' `plusInt` I# i)
193 | i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `plusInt` I# i `minusInt` I# 10#)
194 | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))
198 Code specific for Ints.
201 showSignedInt :: Int -> Int -> ShowS
202 showSignedInt (I# p) (I# n) r
203 | n <# 0# && p ># 6# = '(':itos n (')':r)
204 | otherwise = itos n r
206 itos :: Int# -> String -> String
208 | n >=# 0# = itos' n r
209 | negateInt# n <# 0# = -- n is minInt, a difficult number
210 itos (n `quotInt#` 10#) (itos' (negateInt# (n `remInt#` 10#)) r)
211 | otherwise = '-':itos' (negateInt# n) r
213 itos' :: Int# -> String -> String
216 | x <# 10# = C# (chr# (x +# ord# '0'#)) : cs
217 | otherwise = itos' (x `quotInt#` 10#)
218 (C# (chr# (x `remInt#` 10# +# ord# '0'#)) : cs)
223 %*********************************************************
225 \subsection{Character stuff}
227 %*********************************************************
230 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
231 isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum :: Char -> Bool
232 isAscii c = c < '\x80'
233 isLatin1 c = c <= '\xff'
234 isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f'
235 isPrint c = not (isControl c)
237 -- isSpace includes non-breaking space
238 -- Done with explicit equalities both for efficiency, and to avoid a tiresome
239 -- recursion with PrelList elem
240 isSpace c = c == ' ' ||
248 -- The upper case ISO characters have the multiplication sign dumped
249 -- randomly in the middle of the range. Go figure.
250 isUpper c = c >= 'A' && c <= 'Z' ||
251 c >= '\xC0' && c <= '\xD6' ||
252 c >= '\xD8' && c <= '\xDE'
253 -- The lower case ISO characters have the division sign dumped
254 -- randomly in the middle of the range. Go figure.
255 isLower c = c >= 'a' && c <= 'z' ||
256 c >= '\xDF' && c <= '\xF6' ||
257 c >= '\xF8' && c <= '\xFF'
258 isAsciiLower c = c >= 'a' && c <= 'z'
259 isAsciiUpper c = c >= 'A' && c <= 'Z'
261 isAlpha c = isLower c || isUpper c
262 isDigit c = c >= '0' && c <= '9'
263 isOctDigit c = c >= '0' && c <= '7'
264 isHexDigit c = isDigit c || c >= 'A' && c <= 'F' ||
266 isAlphaNum c = isAlpha c || isDigit c
268 -- Case-changing operations
270 toUpper, toLower :: Char -> Char
272 | isAsciiLower c = C# (chr# (ord# c# -# 32#))
274 -- fall-through to the slower stuff.
275 | isLower c && c /= '\xDF' && c /= '\xFF'
276 = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A')
283 | isAsciiUpper c = C# (chr# (ord# c# +# 32#))
285 | isUpper c = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a')
289 asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ')
290 ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
291 "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",
292 "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
293 "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US",
297 %*********************************************************
299 \subsection{Functions on strings}
301 %*********************************************************
303 lines breaks a string up into a list of strings at newline characters.
304 The resulting strings do not contain newlines. Similary, words
305 breaks a string up into a list of words, which were delimited by
306 white space. unlines and unwords are the inverse operations.
307 unlines joins lines with terminating newlines, and unwords joins
308 words with separating spaces.
311 lines :: String -> [String]
313 lines s = let (l, s') = break (== '\n') s
318 words :: String -> [String]
319 words s = case dropWhile {-partain:Char.-}isSpace s of
323 break {-partain:Char.-}isSpace s'
325 unlines :: [String] -> String
326 #ifdef USE_REPORT_PRELUDE
327 unlines = concatMap (++ "\n")
329 -- HBC version (stolen)
330 -- here's a more efficient version
332 unlines (l:ls) = l ++ '\n' : unlines ls
335 unwords :: [String] -> String
336 #ifdef USE_REPORT_PRELUDE
338 unwords ws = foldr1 (\w s -> w ++ ' ':s) ws
340 -- HBC version (stolen)
341 -- here's a more efficient version
344 unwords (w:ws) = w ++ ' ' : unwords ws