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