GHC/Show.lhs

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