GHC/Show.lhs

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