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