ghc/lib/std/PrelShow.lhs

   1 %
   2 % (c) The GRAP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section{Module @PrelShow@}
   5
   6
   7 \begin{code}
   8 {-# OPTIONS -fno-implicit-prelude #-}
   9
  10 module PrelShow
  11         (
  12         Show(..), ShowS,
  13
  14         -- Instances for Show: (), [], Bool, Ordering, Int, Char
  15
  16         -- Show support code
  17         shows, showChar, showString, showParen, showList__, showSpace,
  18         showLitChar, protectEsc,
  19         intToDigit, showSignedInt,
  20
  21         -- Character operations
  22         isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
  23         isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
  24         toUpper, toLower,
  25         asciiTab,
  26
  27         -- String operations
  28         lines, unlines, words, unwords
  29   )
  30         where
  31
  32 import {-# SOURCE #-} PrelErr ( error )
  33 import PrelBase
  34 import PrelMaybe
  35 import PrelList ( (!!), break, dropWhile
  36 #ifdef USE_REPORT_PRELUDE
  37                 , concatMap, foldr1
  38 #endif
  39                 )
  40 \end{code}
  41
  42
  43
  44 %*********************************************************
  45 %*                                                      *
  46 \subsection{The @Show@ class}
  47 %*                                                      *
  48 %*********************************************************
  49
  50 \begin{code}
  51 type ShowS = String -> String
  52
  53 class  Show a  where
  54     showsPrec :: Int -> a -> ShowS
  55     show      :: a   -> String
  56     showList  :: [a] -> ShowS
  57
  58     showsPrec _ x s = show x ++ s
  59     show x          = shows x ""
  60     showList ls   s = showList__ shows ls s
  61
  62 showList__ :: (a -> ShowS) ->  [a] -> ShowS
  63 showList__ _     []     s = "[]" ++ s
  64 showList__ showx (x:xs) s = '[' : showx x (showl xs)
  65   where
  66     showl []     = ']' : s
  67     showl (y:ys) = ',' : showx y (showl ys)
  68 \end{code}
  69
  70 %*********************************************************
  71 %*                                                      *
  72 \subsection{Simple Instances}
  73 %*                                                      *
  74 %*********************************************************
  75
  76 \begin{code}
  77
  78 instance  Show ()  where
  79     showsPrec _ () = showString "()"
  80
  81 instance Show a => Show [a]  where
  82     showsPrec _         = showList
  83
  84 instance Show Bool where
  85   showsPrec _ True  = showString "True"
  86   showsPrec _ False = showString "False"
  87
  88 instance Show Ordering where
  89   showsPrec _ LT = showString "LT"
  90   showsPrec _ EQ = showString "EQ"
  91   showsPrec _ GT = showString "GT"
  92
  93 instance  Show Char  where
  94     showsPrec _ '\'' = showString "'\\''"
  95     showsPrec _ c    = showChar '\'' . showLitChar c . showChar '\''
  96
  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.
 105
 106 instance  Show Int  where
 107     showsPrec p n = showSignedInt p n
 108
 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#) $
 113                              showString "Just " .
 114                              showsPrec (I# 10#) x) s
 115
 116 instance (Show a, Show b) => Show (Either a b) where
 117     showsPrec p@(I# p#) e s =
 118        (showParen (p# >=# 10#) $
 119         case e of
 120          Left  a -> showString "Left "  . showsPrec (I# 10#) a
 121          Right b -> showString "Right " . showsPrec (I# 10#) b)
 122        s
 123
 124 \end{code}
 125
 126
 127 %*********************************************************
 128 %*                                                      *
 129 \subsection{Show instances for the first few tuples
 130 %*                                                      *
 131 %*********************************************************
 132
 133 \begin{code}
 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))))
 139
 140 instance  (Show a, Show b) => Show (a,b)  where
 141     showsPrec _ (x,y) s = (showChar '(' . shows x . showChar ',' .
 142                                           shows y . showChar ')')
 143                           s
 144
 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 ')')
 149                             s
 150
 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 ')')
 156                               s
 157
 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 ')')
 164                                 s
 165 \end{code}
 166
 167
 168 %*********************************************************
 169 %*                                                      *
 170 \subsection{Support code for @Show@}
 171 %*                                                      *
 172 %*********************************************************
 173
 174 \begin{code}
 175 shows           :: (Show a) => a -> ShowS
 176 shows           =  showsPrec zeroInt
 177
 178 showChar        :: Char -> ShowS
 179 showChar        =  (:)
 180
 181 showString      :: String -> ShowS
 182 showString      =  (++)
 183
 184 showParen       :: Bool -> ShowS -> ShowS
 185 showParen b p   =  if b then showChar '(' . p . showChar ')' else p
 186
 187 showSpace :: ShowS
 188 showSpace = {-showChar ' '-} \ xs -> ' ' : xs
 189 \end{code}
 190
 191 Code specific for characters
 192
 193 \begin{code}
 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
 211
 212 protectEsc :: (Char -> Bool) -> ShowS -> ShowS
 213 protectEsc p f             = f . cont
 214                              where cont s@(c:_) | p c = "\\&" ++ s
 215                                    cont s             = s
 216
 217 intToDigit :: Int -> Char
 218 intToDigit (I# i)
 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))
 222
 223 \end{code}
 224
 225 Code specific for Ints.
 226
 227 \begin{code}
 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
 232
 233 itos :: Int# -> String -> String
 234 itos n r
 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
 239  where
 240    itos' :: Int# -> String -> String
 241         -- x >= 0
 242    itos' x cs
 243      | x <# 10#  = C# (chr# (x +# ord# '0'#)) : cs
 244      | otherwise = itos' (x `quotInt#` 10#)
 245                          (C# (chr# (x `remInt#` 10# +# ord# '0'#)) : cs)
 246 \end{code}
 247
 248 %*********************************************************
 249 %*                                                      *
 250 \subsection{Character stuff}
 251 %*                                                      *
 252 %*********************************************************
 253
 254 \begin{code}
 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)
 261
 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 == ' '     ||
 266                            c == '\t'    ||
 267                            c == '\n'    ||
 268                            c == '\r'    ||
 269                            c == '\f'    ||
 270                            c == '\v'    ||
 271                            c == '\xa0'
 272
 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'
 285
 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' ||
 290                                         c >= 'a' && c <= 'f'
 291 isAlphaNum c            =  isAlpha c || isDigit c
 292
 293 -- Case-changing operations
 294
 295 toUpper, toLower        :: Char -> Char
 296 toUpper c@(C# c#)
 297   | isAsciiLower c    = C# (chr# (ord# c# -# 32#))
 298   | isAscii c         = c
 299     -- fall-through to the slower stuff.
 300   | isLower c   && c /= '\xDF' && c /= '\xFF'
 301   = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A')
 302   | otherwise
 303   = c
 304
 305
 306
 307 toLower c@(C# c#)
 308   | isAsciiUpper c = C# (chr# (ord# c# +# 32#))
 309   | isAscii c      = c
 310   | isUpper c      = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a')
 311   | otherwise      =  c
 312
 313 asciiTab :: [String]
 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",
 319             "SP"]
 320 \end{code}
 321
 322 %*********************************************************
 323 %*                                                      *
 324 \subsection{Functions on strings}
 325 %*                                                      *
 326 %*********************************************************
 327
 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.
 334
 335 \begin{code}
 336 lines                   :: String -> [String]
 337 lines ""                =  []
 338 lines s                 =  let (l, s') = break (== '\n') s
 339                            in  l : case s' of
 340                                         []      -> []
 341                                         (_:s'') -> lines s''
 342
 343 words                   :: String -> [String]
 344 words s                 =  case dropWhile {-partain:Char.-}isSpace s of
 345                                 "" -> []
 346                                 s' -> w : words s''
 347                                       where (w, s'') =
 348                                              break {-partain:Char.-}isSpace s'
 349
 350 unlines                 :: [String] -> String
 351 #ifdef USE_REPORT_PRELUDE
 352 unlines                 =  concatMap (++ "\n")
 353 #else
 354 -- HBC version (stolen)
 355 -- here's a more efficient version
 356 unlines [] = []
 357 unlines (l:ls) = l ++ '\n' : unlines ls
 358 #endif
 359
 360 unwords                 :: [String] -> String
 361 #ifdef USE_REPORT_PRELUDE
 362 unwords []              =  ""
 363 unwords ws              =  foldr1 (\w s -> w ++ ' ':s) ws
 364 #else
 365 -- HBC version (stolen)
 366 -- here's a more efficient version
 367 unwords []              =  ""
 368 unwords [w]             = w
 369 unwords (w:ws)          = w ++ ' ' : unwords ws
 370 #endif
 371
 372 \end{code}