GHC/Show.lhs

   1 \begin{code}
   2 {-# OPTIONS -fno-implicit-prelude #-}
   3 -----------------------------------------------------------------------------
   4 -- |
   5 -- Module      :  GHC.Show
   6 -- Copyright   :  (c) The University of Glasgow, 1992-2002
   7 -- License     :  see libraries/base/LICENSE
   8 --
   9 -- Maintainer  :  cvs-ghc@haskell.org
  10 -- Stability   :  internal
  11 -- Portability :  non-portable (GHC Extensions)
  12 --
  13 -- The 'Show' class, and related operations.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module GHC.Show
  18         (
  19         Show(..), ShowS,
  20
  21         -- Instances for Show: (), [], Bool, Ordering, Int, Char
  22
  23         -- Show support code
  24         shows, showChar, showString, showParen, showList__, showSpace,
  25         showLitChar, protectEsc,
  26         intToDigit, digitToInt, showSignedInt,
  27         appPrec, appPrec1,
  28
  29         -- Character operations
  30         isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
  31         isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
  32         toUpper, toLower,
  33         asciiTab,
  34
  35         -- String operations
  36         lines, unlines, words, unwords
  37   )
  38         where
  39
  40 import {-# SOURCE #-} GHC.Err ( error )
  41 import GHC.Base
  42 import GHC.Enum
  43 import Data.Maybe
  44 import Data.Either
  45 import GHC.List ( (!!), break, dropWhile
  46 #ifdef USE_REPORT_PRELUDE
  47                 , concatMap, foldr1
  48 #endif
  49                 )
  50 \end{code}
  51
  52
  53
  54 %*********************************************************
  55 %*                                                      *
  56 \subsection{The @Show@ class}
  57 %*                                                      *
  58 %*********************************************************
  59
  60 \begin{code}
  61 type ShowS = String -> String
  62
  63 class  Show a  where
  64     showsPrec :: Int -> a -> ShowS
  65     show      :: a   -> String
  66     showList  :: [a] -> ShowS
  67
  68     showsPrec _ x s = show x ++ s
  69     show x          = shows x ""
  70     showList ls   s = showList__ shows ls s
  71
  72 showList__ :: (a -> ShowS) ->  [a] -> ShowS
  73 showList__ _     []     s = "[]" ++ s
  74 showList__ showx (x:xs) s = '[' : showx x (showl xs)
  75   where
  76     showl []     = ']' : s
  77     showl (y:ys) = ',' : showx y (showl ys)
  78
  79 appPrec, appPrec1 :: Int
  80         -- Use unboxed stuff because we don't have overloaded numerics yet
  81 appPrec = I# 10#        -- Precedence of application:
  82                         --   one more than the maximum operator precedence of 9
  83 appPrec1 = I# 11#       -- appPrec + 1
  84 \end{code}
  85
  86 %*********************************************************
  87 %*                                                      *
  88 \subsection{Simple Instances}
  89 %*                                                      *
  90 %*********************************************************
  91
  92 \begin{code}
  93
  94 instance  Show ()  where
  95     showsPrec _ () = showString "()"
  96
  97 instance Show a => Show [a]  where
  98     showsPrec _         = showList
  99
 100 instance Show Bool where
 101   showsPrec _ True  = showString "True"
 102   showsPrec _ False = showString "False"
 103
 104 instance Show Ordering where
 105   showsPrec _ LT = showString "LT"
 106   showsPrec _ EQ = showString "EQ"
 107   showsPrec _ GT = showString "GT"
 108
 109 instance  Show Char  where
 110     showsPrec _ '\'' = showString "'\\''"
 111     showsPrec _ c    = showChar '\'' . showLitChar c . showChar '\''
 112
 113     showList cs = showChar '"' . showl cs
 114                  where showl ""       s = showChar '"' s
 115                        showl ('"':xs) s = showString "\\\"" (showl xs s)
 116                        showl (x:xs)   s = showLitChar x (showl xs s)
 117                 -- Making 's' an explicit parameter makes it clear to GHC
 118                 -- that showl has arity 2, which avoids it allocating an extra lambda
 119                 -- The sticking point is the recursive call to (showl xs), which
 120                 -- it can't figure out would be ok with arity 2.
 121
 122 instance Show Int where
 123     showsPrec = showSignedInt
 124
 125 instance Show a => Show (Maybe a) where
 126     showsPrec _p Nothing s = showString "Nothing" s
 127     showsPrec p (Just x) s
 128                           = (showParen (p > appPrec) $
 129                              showString "Just " .
 130                              showsPrec appPrec1 x) s
 131
 132 instance (Show a, Show b) => Show (Either a b) where
 133     showsPrec p e s =
 134        (showParen (p > appPrec) $
 135         case e of
 136          Left  a -> showString "Left "  . showsPrec appPrec1 a
 137          Right b -> showString "Right " . showsPrec appPrec1 b)
 138        s
 139 \end{code}
 140
 141
 142 %*********************************************************
 143 %*                                                      *
 144 \subsection{Show instances for the first few tuples
 145 %*                                                      *
 146 %*********************************************************
 147
 148 \begin{code}
 149 -- The explicit 's' parameters are important
 150 -- Otherwise GHC thinks that "shows x" might take a lot of work to compute
 151 -- and generates defns like
 152 --      showsPrec _ (x,y) = let sx = shows x; sy = shows y in
 153 --                          \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s))))
 154
 155 instance  (Show a, Show b) => Show (a,b)  where
 156     showsPrec _ (x,y) s = (showChar '(' . shows x . showChar ',' .
 157                                           shows y . showChar ')')
 158                           s
 159
 160 instance (Show a, Show b, Show c) => Show (a, b, c) where
 161     showsPrec _ (x,y,z) s = (showChar '(' . shows x . showChar ',' .
 162                                             shows y . showChar ',' .
 163                                             shows z . showChar ')')
 164                             s
 165
 166 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
 167     showsPrec _ (w,x,y,z) s = (showChar '(' . shows w . showChar ',' .
 168                                               shows x . showChar ',' .
 169                                               shows y . showChar ',' .
 170                                               shows z . showChar ')')
 171                               s
 172
 173 instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
 174     showsPrec _ (v,w,x,y,z) s = (showChar '(' . shows v . showChar ',' .
 175                                                 shows w . showChar ',' .
 176                                                 shows x . showChar ',' .
 177                                                 shows y . showChar ',' .
 178                                                 shows z . showChar ')')
 179                                 s
 180 \end{code}
 181
 182
 183 %*********************************************************
 184 %*                                                      *
 185 \subsection{Support code for @Show@}
 186 %*                                                      *
 187 %*********************************************************
 188
 189 \begin{code}
 190 shows           :: (Show a) => a -> ShowS
 191 shows           =  showsPrec zeroInt
 192
 193 showChar        :: Char -> ShowS
 194 showChar        =  (:)
 195
 196 showString      :: String -> ShowS
 197 showString      =  (++)
 198
 199 showParen       :: Bool -> ShowS -> ShowS
 200 showParen b p   =  if b then showChar '(' . p . showChar ')' else p
 201
 202 showSpace :: ShowS
 203 showSpace = {-showChar ' '-} \ xs -> ' ' : xs
 204 \end{code}
 205
 206 Code specific for characters
 207
 208 \begin{code}
 209 showLitChar                :: Char -> ShowS
 210 showLitChar c s | c > '\DEL' =  showChar '\\' (protectEsc isDigit (shows (ord c)) s)
 211 showLitChar '\DEL'         s =  showString "\\DEL" s
 212 showLitChar '\\'           s =  showString "\\\\" s
 213 showLitChar c s | c >= ' '   =  showChar c s
 214 showLitChar '\a'           s =  showString "\\a" s
 215 showLitChar '\b'           s =  showString "\\b" s
 216 showLitChar '\f'           s =  showString "\\f" s
 217 showLitChar '\n'           s =  showString "\\n" s
 218 showLitChar '\r'           s =  showString "\\r" s
 219 showLitChar '\t'           s =  showString "\\t" s
 220 showLitChar '\v'           s =  showString "\\v" s
 221 showLitChar '\SO'          s =  protectEsc (== 'H') (showString "\\SO") s
 222 showLitChar c              s =  showString ('\\' : asciiTab!!ord c) s
 223         -- I've done manual eta-expansion here, becuase otherwise it's
 224         -- impossible to stop (asciiTab!!ord) getting floated out as an MFE
 225
 226 protectEsc :: (Char -> Bool) -> ShowS -> ShowS
 227 protectEsc p f             = f . cont
 228                              where cont s@(c:_) | p c = "\\&" ++ s
 229                                    cont s             = s
 230 \end{code}
 231
 232 Code specific for Ints.
 233
 234 \begin{code}
 235 intToDigit :: Int -> Char
 236 intToDigit (I# i)
 237     | i >=# 0#  && i <=#  9# =  unsafeChr (ord '0' `plusInt` I# i)
 238     | i >=# 10# && i <=# 15# =  unsafeChr (ord 'a' `minusInt` ten `plusInt` I# i)
 239     | otherwise           =  error ("Char.intToDigit: not a digit " ++ show (I# i))
 240
 241 digitToInt :: Char -> Int
 242 digitToInt c
 243  | isDigit c            =  ord c `minusInt` ord '0'
 244  | c >= 'a' && c <= 'f' =  ord c `minusInt` ord 'a' `plusInt` ten
 245  | c >= 'A' && c <= 'F' =  ord c `minusInt` ord 'A' `plusInt` ten
 246  | otherwise            =  error ("Char.digitToInt: not a digit " ++ show c) -- sigh
 247
 248 ten = I# 10#
 249
 250 showSignedInt :: Int -> Int -> ShowS
 251 showSignedInt (I# p) (I# n) r
 252     | n <# 0# && p ># 6# = '(' : itos n (')' : r)
 253     | otherwise          = itos n r
 254
 255 itos :: Int# -> String -> String
 256 itos n# cs
 257     | n# <# 0# = let
 258         n'# = negateInt# n#
 259         in if n'# <# 0# -- minInt?
 260             then '-' : itos' (negateInt# (n'# `quotInt#` 10#))
 261                              (itos' (negateInt# (n'# `remInt#` 10#)) cs)
 262             else '-' : itos' n'# cs
 263     | otherwise = itos' n# cs
 264     where
 265     itos' :: Int# -> String -> String
 266     itos' n# cs
 267         | n# <# 10#  = C# (chr# (ord# '0'# +# n#)) : cs
 268         | otherwise = case chr# (ord# '0'# +# (n# `remInt#` 10#)) of { c# ->
 269                       itos' (n# `quotInt#` 10#) (C# c# : cs) }
 270 \end{code}
 271
 272
 273 %*********************************************************
 274 %*                                                      *
 275 \subsection{Character stuff}
 276 %*                                                      *
 277 %*********************************************************
 278
 279 \begin{code}
 280 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
 281  isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
 282  isAsciiUpper, isAsciiLower :: Char -> Bool
 283 isAscii c               =  c <  '\x80'
 284 isLatin1 c              =  c <= '\xff'
 285 isControl c             =  c < ' ' || c >= '\DEL' && c <= '\x9f'
 286 isPrint c               =  not (isControl c)
 287
 288 -- isSpace includes non-breaking space
 289 -- Done with explicit equalities both for efficiency, and to avoid a tiresome
 290 -- recursion with GHC.List elem
 291 isSpace c               =  c == ' '     ||
 292                            c == '\t'    ||
 293                            c == '\n'    ||
 294                            c == '\r'    ||
 295                            c == '\f'    ||
 296                            c == '\v'    ||
 297                            c == '\xa0'
 298
 299 -- The upper case ISO characters have the multiplication sign dumped
 300 -- randomly in the middle of the range.  Go figure.
 301 isUpper c               =  c >= 'A' && c <= 'Z' ||
 302                            c >= '\xC0' && c <= '\xD6' ||
 303                            c >= '\xD8' && c <= '\xDE'
 304 -- The lower case ISO characters have the division sign dumped
 305 -- randomly in the middle of the range.  Go figure.
 306 isLower c               =  c >= 'a' && c <= 'z' ||
 307                            c >= '\xDF' && c <= '\xF6' ||
 308                            c >= '\xF8' && c <= '\xFF'
 309 isAsciiLower c          =  c >= 'a' && c <= 'z'
 310 isAsciiUpper c          =  c >= 'A' && c <= 'Z'
 311
 312 isAlpha c               =  isLower c || isUpper c
 313 isDigit c               =  c >= '0' && c <= '9'
 314 isOctDigit c            =  c >= '0' && c <= '7'
 315 isHexDigit c            =  isDigit c || c >= 'A' && c <= 'F' ||
 316                                         c >= 'a' && c <= 'f'
 317 isAlphaNum c            =  isAlpha c || isDigit c
 318
 319 -- Case-changing operations
 320
 321 toUpper, toLower        :: Char -> Char
 322 toUpper c@(C# c#)
 323   | isAsciiLower c    = C# (chr# (ord# c# -# 32#))
 324   | isAscii c         = c
 325     -- fall-through to the slower stuff.
 326   | isLower c   && c /= '\xDF' && c /= '\xFF'
 327   = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A')
 328   | otherwise
 329   = c
 330
 331
 332 toLower c@(C# c#)
 333   | isAsciiUpper c = C# (chr# (ord# c# +# 32#))
 334   | isAscii c      = c
 335   | isUpper c      = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a')
 336   | otherwise      =  c
 337
 338 asciiTab :: [String]
 339 asciiTab = -- Using an array drags in the array module.  listArray ('\NUL', ' ')
 340            ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
 341             "BS",  "HT",  "LF",  "VT",  "FF",  "CR",  "SO",  "SI",
 342             "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
 343             "CAN", "EM",  "SUB", "ESC", "FS",  "GS",  "RS",  "US",
 344             "SP"]
 345 \end{code}
 346
 347 %*********************************************************
 348 %*                                                      *
 349 \subsection{Functions on strings}
 350 %*                                                      *
 351 %*********************************************************
 352
 353 lines breaks a string up into a list of strings at newline characters.
 354 The resulting strings do not contain newlines.  Similary, words
 355 breaks a string up into a list of words, which were delimited by
 356 white space.  unlines and unwords are the inverse operations.
 357 unlines joins lines with terminating newlines, and unwords joins
 358 words with separating spaces.
 359
 360 \begin{code}
 361 lines                   :: String -> [String]
 362 lines ""                =  []
 363 lines s                 =  let (l, s') = break (== '\n') s
 364                            in  l : case s' of
 365                                         []      -> []
 366                                         (_:s'') -> lines s''
 367
 368 words                   :: String -> [String]
 369 words s                 =  case dropWhile {-partain:Char.-}isSpace s of
 370                                 "" -> []
 371                                 s' -> w : words s''
 372                                       where (w, s'') =
 373                                              break {-partain:Char.-}isSpace s'
 374
 375 unlines                 :: [String] -> String
 376 #ifdef USE_REPORT_PRELUDE
 377 unlines                 =  concatMap (++ "\n")
 378 #else
 379 -- HBC version (stolen)
 380 -- here's a more efficient version
 381 unlines [] = []
 382 unlines (l:ls) = l ++ '\n' : unlines ls
 383 #endif
 384
 385 unwords                 :: [String] -> String
 386 #ifdef USE_REPORT_PRELUDE
 387 unwords []              =  ""
 388 unwords ws              =  foldr1 (\w s -> w ++ ' ':s) ws
 389 #else
 390 -- HBC version (stolen)
 391 -- here's a more efficient version
 392 unwords []              =  ""
 393 unwords [w]             = w
 394 unwords (w:ws)          = w ++ ' ' : unwords ws
 395 #endif
 396
 397 \end{code}