ghc/lib/std/PrelShow.lhs

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