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     = showList__ shows ls
  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 ""       = showChar '"'
  99                        showl ('"':xs) = showString "\\\"" . showl xs
 100                        showl (x:xs)   = showLitChar x . showl xs
 101
 102 instance  Show Int  where
 103     showsPrec p n = showSignedInt p n
 104
 105 instance Show a => Show (Maybe a) where
 106     showsPrec _p Nothing  = showString "Nothing"
 107     showsPrec p@(I# p#) (Just x)
 108                           = showParen (p# >=# 10#) $
 109                             showString "Just " .
 110                             showsPrec (I# 10#) x
 111
 112 instance (Show a, Show b) => Show (Either a b) where
 113     showsPrec p@(I# p#) e =
 114        showParen (p# >=# 10#) $
 115        case e of
 116          Left  a -> showString "Left "  . showsPrec (I# 10#) a
 117          Right b -> showString "Right " . showsPrec (I# 10#) b
 118
 119 \end{code}
 120
 121
 122 %*********************************************************
 123 %*                                                      *
 124 \subsection{Show instances for the first few tuples
 125 %*                                                      *
 126 %*********************************************************
 127
 128 \begin{code}
 129 instance  (Show a, Show b) => Show (a,b)  where
 130     showsPrec _ (x,y) = showChar '(' . shows x . showChar ',' .
 131                                        shows y . showChar ')'
 132
 133 instance (Show a, Show b, Show c) => Show (a, b, c) where
 134     showsPrec _ (x,y,z) = showChar '(' . shows x . showChar ',' .
 135                                          shows y . showChar ',' .
 136                                          shows z . showChar ')'
 137
 138 instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where
 139     showsPrec _ (w,x,y,z) = showChar '(' . shows w . showChar ',' .
 140                                            shows x . showChar ',' .
 141                                            shows y . showChar ',' .
 142                                            shows z . showChar ')'
 143
 144 instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where
 145     showsPrec _ (v,w,x,y,z) = showChar '(' . shows v . showChar ',' .
 146                                              shows w . showChar ',' .
 147                                              shows x . showChar ',' .
 148                                              shows y . showChar ',' .
 149                                              shows z . showChar ')'
 150 \end{code}
 151
 152
 153 %*********************************************************
 154 %*                                                      *
 155 \subsection{Support code for @Show@}
 156 %*                                                      *
 157 %*********************************************************
 158
 159 \begin{code}
 160 shows           :: (Show a) => a -> ShowS
 161 shows           =  showsPrec zeroInt
 162
 163 showChar        :: Char -> ShowS
 164 showChar        =  (:)
 165
 166 showString      :: String -> ShowS
 167 showString      =  (++)
 168
 169 showParen       :: Bool -> ShowS -> ShowS
 170 showParen b p   =  if b then showChar '(' . p . showChar ')' else p
 171
 172 showSpace :: ShowS
 173 showSpace = {-showChar ' '-} \ xs -> ' ' : xs
 174 \end{code}
 175
 176 Code specific for characters
 177
 178 \begin{code}
 179 showLitChar                :: Char -> ShowS
 180 showLitChar c | c > '\DEL' =  showChar '\\' . protectEsc isDigit (shows (ord c))
 181 showLitChar '\DEL'         =  showString "\\DEL"
 182 showLitChar '\\'           =  showString "\\\\"
 183 showLitChar c | c >= ' '   =  showChar c
 184 showLitChar '\a'           =  showString "\\a"
 185 showLitChar '\b'           =  showString "\\b"
 186 showLitChar '\f'           =  showString "\\f"
 187 showLitChar '\n'           =  showString "\\n"
 188 showLitChar '\r'           =  showString "\\r"
 189 showLitChar '\t'           =  showString "\\t"
 190 showLitChar '\v'           =  showString "\\v"
 191 showLitChar '\SO'          =  protectEsc (== 'H') (showString "\\SO")
 192 showLitChar c              =  showString ('\\' : asciiTab!!ord c)
 193
 194 protectEsc :: (Char -> Bool) -> ShowS -> ShowS
 195 protectEsc p f             = f . cont
 196                              where cont s@(c:_) | p c = "\\&" ++ s
 197                                    cont s             = s
 198
 199 intToDigit :: Int -> Char
 200 intToDigit (I# i)
 201  | i >=# 0#  && i <=#  9# =  unsafeChr (ord '0' `plusInt` I# i)
 202  | i >=# 10# && i <=# 15# =  unsafeChr (ord 'a' `plusInt` I# i `minusInt` I# 10#)
 203  | otherwise              =  error ("Char.intToDigit: not a digit " ++ show (I# i))
 204
 205 \end{code}
 206
 207 Code specific for Ints.
 208
 209 \begin{code}
 210 showSignedInt :: Int -> Int -> ShowS
 211 showSignedInt (I# p) (I# n) r
 212   | n <# 0# && p ># 6# = '(':itos n (')':r)
 213   | otherwise          = itos n r
 214
 215 itos :: Int# -> String -> String
 216 itos n r
 217   | n >=# 0#            = itos' n r
 218   | negateInt# n <# 0#  = -- n is minInt, a difficult number
 219             itos (n `quotInt#` 10#) (itos' (negateInt# (n `remInt#` 10#)) r)
 220   | otherwise = '-':itos' (negateInt# n) r
 221  where
 222    itos' :: Int# -> String -> String
 223         -- x >= 0
 224    itos' x cs
 225      | x <# 10#  = C# (chr# (x +# ord# '0'#)) : cs
 226      | otherwise = itos' (x `quotInt#` 10#)
 227                          (C# (chr# (x `remInt#` 10# +# ord# '0'#)) : cs)
 228 \end{code}
 229
 230
 231
 232 %*********************************************************
 233 %*                                                      *
 234 \subsection{Character stuff}
 235 %*                                                      *
 236 %*********************************************************
 237
 238 \begin{code}
 239 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
 240  isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphaNum :: Char -> Bool
 241 isAscii c               =  c <  '\x80'
 242 isLatin1 c              =  c <= '\xff'
 243 isControl c             =  c < ' ' || c >= '\DEL' && c <= '\x9f'
 244 isPrint c               =  not (isControl c)
 245
 246 -- isSpace includes non-breaking space
 247 -- Done with explicit equalities both for efficiency, and to avoid a tiresome
 248 -- recursion with PrelList elem
 249 isSpace c               =  c == ' '     ||
 250                            c == '\t'    ||
 251                            c == '\n'    ||
 252                            c == '\r'    ||
 253                            c == '\f'    ||
 254                            c == '\v'    ||
 255                            c == '\xa0'
 256
 257 -- The upper case ISO characters have the multiplication sign dumped
 258 -- randomly in the middle of the range.  Go figure.
 259 isUpper c               =  c >= 'A' && c <= 'Z' ||
 260                            c >= '\xC0' && c <= '\xD6' ||
 261                            c >= '\xD8' && c <= '\xDE'
 262 -- The lower case ISO characters have the division sign dumped
 263 -- randomly in the middle of the range.  Go figure.
 264 isLower c               =  c >= 'a' && c <= 'z' ||
 265                            c >= '\xDF' && c <= '\xF6' ||
 266                            c >= '\xF8' && c <= '\xFF'
 267 isAsciiLower c          =  c >= 'a' && c <= 'z'
 268 isAsciiUpper c          =  c >= 'A' && c <= 'Z'
 269
 270 isAlpha c               =  isLower c || isUpper c
 271 isDigit c               =  c >= '0' && c <= '9'
 272 isOctDigit c            =  c >= '0' && c <= '7'
 273 isHexDigit c            =  isDigit c || c >= 'A' && c <= 'F' ||
 274                                         c >= 'a' && c <= 'f'
 275 isAlphaNum c            =  isAlpha c || isDigit c
 276
 277 -- Case-changing operations
 278
 279 toUpper, toLower        :: Char -> Char
 280 toUpper c@(C# c#)
 281   | isAsciiLower c    = C# (chr# (ord# c# -# 32#))
 282   | isAscii c         = c
 283     -- fall-through to the slower stuff.
 284   | isLower c   && c /= '\xDF' && c /= '\xFF'
 285   = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A')
 286   | otherwise
 287   = c
 288
 289
 290
 291 toLower c@(C# c#)
 292   | isAsciiUpper c = C# (chr# (ord# c# +# 32#))
 293   | isAscii c      = c
 294   | isUpper c      = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a')
 295   | otherwise      =  c
 296
 297 asciiTab :: [String]
 298 asciiTab = -- Using an array drags in the array module.  listArray ('\NUL', ' ')
 299            ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
 300             "BS",  "HT",  "LF",  "VT",  "FF",  "CR",  "SO",  "SI",
 301             "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
 302             "CAN", "EM",  "SUB", "ESC", "FS",  "GS",  "RS",  "US",
 303             "SP"]
 304 \end{code}
 305
 306 %*********************************************************
 307 %*                                                      *
 308 \subsection{Functions on strings}
 309 %*                                                      *
 310 %*********************************************************
 311
 312 lines breaks a string up into a list of strings at newline characters.
 313 The resulting strings do not contain newlines.  Similary, words
 314 breaks a string up into a list of words, which were delimited by
 315 white space.  unlines and unwords are the inverse operations.
 316 unlines joins lines with terminating newlines, and unwords joins
 317 words with separating spaces.
 318
 319 \begin{code}
 320 lines                   :: String -> [String]
 321 lines ""                =  []
 322 lines s                 =  let (l, s') = break (== '\n') s
 323                            in  l : case s' of
 324                                         []      -> []
 325                                         (_:s'') -> lines s''
 326
 327 words                   :: String -> [String]
 328 words s                 =  case dropWhile {-partain:Char.-}isSpace s of
 329                                 "" -> []
 330                                 s' -> w : words s''
 331                                       where (w, s'') =
 332                                              break {-partain:Char.-}isSpace s'
 333
 334 unlines                 :: [String] -> String
 335 #ifdef USE_REPORT_PRELUDE
 336 unlines                 =  concatMap (++ "\n")
 337 #else
 338 -- HBC version (stolen)
 339 -- here's a more efficient version
 340 unlines [] = []
 341 unlines (l:ls) = l ++ '\n' : unlines ls
 342 #endif
 343
 344 unwords                 :: [String] -> String
 345 #ifdef USE_REPORT_PRELUDE
 346 unwords []              =  ""
 347 unwords ws              =  foldr1 (\w s -> w ++ ' ':s) ws
 348 #else
 349 -- HBC version (stolen)
 350 -- here's a more efficient version
 351 unwords []              =  ""
 352 unwords [w]             = w
 353 unwords (w:ws)          = w ++ ' ' : unwords ws
 354 #endif
 355
 356 \end{code}