ghc/lib/std/PrelShow.lhs

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