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