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