ghc/lib/std/PrelShow.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: PrelShow.lhs,v 1.12 2000/09/14 13:46:42 simonpj 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 p n = showSignedInt p n
 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' `plusInt` I# i `minusInt` I# 10#)
 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 r
 238   | n >=# 0#            = itos' n r
 239   | negateInt# n <# 0#  = -- n is minInt, a difficult number
 240             itos (n `quotInt#` 10#) (itos' (negateInt# (n `remInt#` 10#)) r)
 241   | otherwise = '-':itos' (negateInt# n) r
 242  where
 243    itos' :: Int# -> String -> String
 244         -- x >= 0
 245    itos' x cs
 246      | x <# 10#  = C# (chr# (x +# ord# '0'#)) : cs
 247      | otherwise = itos' (x `quotInt#` 10#)
 248                          (C# (chr# (x `remInt#` 10# +# ord# '0'#)) : cs)
 249 \end{code}
 250
 251 %*********************************************************
 252 %*                                                      *
 253 \subsection{Character stuff}
 254 %*                                                      *
 255 %*********************************************************
 256
 257 \begin{code}
 258 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
 259  isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum,
 260  isAsciiUpper, isAsciiLower :: Char -> Bool
 261 isAscii c               =  c <  '\x80'
 262 isLatin1 c              =  c <= '\xff'
 263 isControl c             =  c < ' ' || c >= '\DEL' && c <= '\x9f'
 264 isPrint c               =  not (isControl c)
 265
 266 -- isSpace includes non-breaking space
 267 -- Done with explicit equalities both for efficiency, and to avoid a tiresome
 268 -- recursion with PrelList elem
 269 isSpace c               =  c == ' '     ||
 270                            c == '\t'    ||
 271                            c == '\n'    ||
 272                            c == '\r'    ||
 273                            c == '\f'    ||
 274                            c == '\v'    ||
 275                            c == '\xa0'
 276
 277 -- The upper case ISO characters have the multiplication sign dumped
 278 -- randomly in the middle of the range.  Go figure.
 279 isUpper c               =  c >= 'A' && c <= 'Z' ||
 280                            c >= '\xC0' && c <= '\xD6' ||
 281                            c >= '\xD8' && c <= '\xDE'
 282 -- The lower case ISO characters have the division sign dumped
 283 -- randomly in the middle of the range.  Go figure.
 284 isLower c               =  c >= 'a' && c <= 'z' ||
 285                            c >= '\xDF' && c <= '\xF6' ||
 286                            c >= '\xF8' && c <= '\xFF'
 287 isAsciiLower c          =  c >= 'a' && c <= 'z'
 288 isAsciiUpper c          =  c >= 'A' && c <= 'Z'
 289
 290 isAlpha c               =  isLower c || isUpper c
 291 isDigit c               =  c >= '0' && c <= '9'
 292 isOctDigit c            =  c >= '0' && c <= '7'
 293 isHexDigit c            =  isDigit c || c >= 'A' && c <= 'F' ||
 294                                         c >= 'a' && c <= 'f'
 295 isAlphaNum c            =  isAlpha c || isDigit c
 296
 297 -- Case-changing operations
 298
 299 toUpper, toLower        :: Char -> Char
 300 toUpper c@(C# c#)
 301   | isAsciiLower c    = C# (chr# (ord# c# -# 32#))
 302   | isAscii c         = c
 303     -- fall-through to the slower stuff.
 304   | isLower c   && c /= '\xDF' && c /= '\xFF'
 305   = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A')
 306   | otherwise
 307   = c
 308
 309
 310
 311 toLower c@(C# c#)
 312   | isAsciiUpper c = C# (chr# (ord# c# +# 32#))
 313   | isAscii c      = c
 314   | isUpper c      = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a')
 315   | otherwise      =  c
 316
 317 asciiTab :: [String]
 318 asciiTab = -- Using an array drags in the array module.  listArray ('\NUL', ' ')
 319            ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
 320             "BS",  "HT",  "LF",  "VT",  "FF",  "CR",  "SO",  "SI",
 321             "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
 322             "CAN", "EM",  "SUB", "ESC", "FS",  "GS",  "RS",  "US",
 323             "SP"]
 324 \end{code}
 325
 326 %*********************************************************
 327 %*                                                      *
 328 \subsection{Functions on strings}
 329 %*                                                      *
 330 %*********************************************************
 331
 332 lines breaks a string up into a list of strings at newline characters.
 333 The resulting strings do not contain newlines.  Similary, words
 334 breaks a string up into a list of words, which were delimited by
 335 white space.  unlines and unwords are the inverse operations.
 336 unlines joins lines with terminating newlines, and unwords joins
 337 words with separating spaces.
 338
 339 \begin{code}
 340 lines                   :: String -> [String]
 341 lines ""                =  []
 342 lines s                 =  let (l, s') = break (== '\n') s
 343                            in  l : case s' of
 344                                         []      -> []
 345                                         (_:s'') -> lines s''
 346
 347 words                   :: String -> [String]
 348 words s                 =  case dropWhile {-partain:Char.-}isSpace s of
 349                                 "" -> []
 350                                 s' -> w : words s''
 351                                       where (w, s'') =
 352                                              break {-partain:Char.-}isSpace s'
 353
 354 unlines                 :: [String] -> String
 355 #ifdef USE_REPORT_PRELUDE
 356 unlines                 =  concatMap (++ "\n")
 357 #else
 358 -- HBC version (stolen)
 359 -- here's a more efficient version
 360 unlines [] = []
 361 unlines (l:ls) = l ++ '\n' : unlines ls
 362 #endif
 363
 364 unwords                 :: [String] -> String
 365 #ifdef USE_REPORT_PRELUDE
 366 unwords []              =  ""
 367 unwords ws              =  foldr1 (\w s -> w ++ ' ':s) ws
 368 #else
 369 -- HBC version (stolen)
 370 -- here's a more efficient version
 371 unwords []              =  ""
 372 unwords [w]             = w
 373 unwords (w:ws)          = w ++ ' ' : unwords ws
 374 #endif
 375
 376 \end{code}