ghc/lib/ghc/PrelBase.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[PrelBase]{Module @PrelBase@}
   5
   6
   7 \begin{code}
   8 {-# OPTIONS -fno-implicit-prelude #-}
   9
  10 module PrelBase(
  11         module PrelBase,
  12         module GHC              -- Re-export GHC, to avoid lots of people having
  13                                 -- to import it explicitly
  14   ) where
  15
  16 import {-# SOURCE #-} Error ( error )
  17 import GHC
  18
  19 infixr 9  .
  20 infixl 9  !!
  21 infixl 7  *
  22 infixl 6  +, -
  23 infixr 5  ++, :
  24 infix  4  ==, /=, <, <=, >=, >
  25 infixr 3  &&
  26 infixr 2  ||
  27 infixl 1  >>, >>=
  28 infixr 0  $
  29 \end{code}
  30
  31 %*********************************************************
  32 %*                                                      *
  33 \subsection{Standard classes @Eq@, @Ord@, @Bounded@, @Eval@}
  34 %*                                                      *
  35 %*********************************************************
  36
  37 \begin{code}
  38 class  Eq a  where
  39     (==), (/=)          :: a -> a -> Bool
  40
  41     x /= y              =  not (x == y)
  42
  43 class  (Eq a) => Ord a  where
  44     compare             :: a -> a -> Ordering
  45     (<), (<=), (>=), (>):: a -> a -> Bool
  46     max, min            :: a -> a -> a
  47
  48 -- An instance of Ord should define either compare or <=
  49 -- Using compare can be more efficient for complex types.
  50     compare x y
  51             | x == y    = EQ
  52             | x <= y    = LT
  53             | otherwise = GT
  54
  55     x <= y  = compare x y /= GT
  56     x <  y  = compare x y == LT
  57     x >= y  = compare x y /= LT
  58     x >  y  = compare x y == GT
  59     max x y = case (compare x y) of { LT -> y ; EQ -> x ; GT -> x }
  60     min x y = case (compare x y) of { LT -> x ; EQ -> x ; GT -> y }
  61
  62 class  Bounded a  where
  63     minBound, maxBound :: a
  64
  65 class Eval a
  66 \end{code}
  67
  68 %*********************************************************
  69 %*                                                      *
  70 \subsection{Monadic classes @Functor@, @Monad@, @MonadZero@, @MonadPlus@}
  71 %*                                                      *
  72 %*********************************************************
  73
  74 \begin{code}
  75 class  Functor f  where
  76     map         :: (a -> b) -> f a -> f b
  77
  78 class  Monad m  where
  79     (>>=)       :: m a -> (a -> m b) -> m b
  80     (>>)        :: m a -> m b -> m b
  81     return      :: a -> m a
  82
  83     m >> k      =  m >>= \_ -> k
  84
  85 class  (Monad m) => MonadZero m  where
  86     zero        :: m a
  87
  88 class  (MonadZero m) => MonadPlus m where
  89    (++)         :: m a -> m a -> m a
  90 \end{code}
  91
  92
  93 %*********************************************************
  94 %*                                                      *
  95 \subsection{Classes @Num@ and @Enum@}
  96 %*                                                      *
  97 %*********************************************************
  98
  99 \begin{code}
 100 class  Enum a   where
 101     toEnum              :: Int -> a
 102     fromEnum            :: a -> Int
 103     enumFrom            :: a -> [a]             -- [n..]
 104     enumFromThen        :: a -> a -> [a]        -- [n,n'..]
 105     enumFromTo          :: a -> a -> [a]        -- [n..m]
 106     enumFromThenTo      :: a -> a -> a -> [a]   -- [n,n'..m]
 107
 108     enumFromTo n m      =  map toEnum [fromEnum n .. fromEnum m]
 109     enumFromThenTo n n' m
 110                         =  map toEnum [fromEnum n, fromEnum n' .. fromEnum m]
 111
 112 class  (Eq a, Show a, Eval a) => Num a  where
 113     (+), (-), (*)       :: a -> a -> a
 114     negate              :: a -> a
 115     abs, signum         :: a -> a
 116     fromInteger         :: Integer -> a
 117     fromInt             :: Int -> a -- partain: Glasgow extension
 118
 119     x - y               =  x + negate y
 120     fromInt (I# i#)     = fromInteger (int2Integer# i#)
 121                                         -- Go via the standard class-op if the
 122                                         -- non-standard one ain't provided
 123 \end{code}
 124
 125 \begin{code}
 126 succ, pred              :: Enum a => a -> a
 127 succ                    =  toEnum . (+1) . fromEnum
 128 pred                    =  toEnum . (subtract 1) . fromEnum
 129
 130 chr = (toEnum   :: Int  -> Char)
 131 ord = (fromEnum :: Char -> Int)
 132
 133 ord_0 :: Num a => a
 134 ord_0 = fromInt (ord '0')
 135
 136 {-# GENERATE_SPECS subtract a{Int#,Double#,Int,Double,Complex(Double#),Complex(Double)} #-}
 137 subtract        :: (Num a) => a -> a -> a
 138 subtract x y    =  y - x
 139 \end{code}
 140
 141
 142 %*********************************************************
 143 %*                                                      *
 144 \subsection{The @Show@ class}
 145 %*                                                      *
 146 %*********************************************************
 147
 148 \begin{code}
 149 type  ShowS     = String -> String
 150
 151 class  Show a  where
 152     showsPrec :: Int -> a -> ShowS
 153     showList  :: [a] -> ShowS
 154
 155     showList ls = showList__ (showsPrec 0) ls
 156 \end{code}
 157
 158 %*********************************************************
 159 %*                                                      *
 160 \subsection{The list type}
 161 %*                                                      *
 162 %*********************************************************
 163
 164 \begin{code}
 165 data [] a = [] | a : [a]  -- do explicitly: deriving (Eq, Ord)
 166                           -- to avoid weird names like con2tag_[]#
 167
 168 instance (Eq a) => Eq [a]  where
 169     []     == []     = True
 170     (x:xs) == (y:ys) = x == y && xs == ys
 171     xs     == ys     = False
 172     xs     /= ys     = if (xs == ys) then False else True
 173
 174 instance (Ord a) => Ord [a] where
 175     a <  b  = case compare a b of { LT -> True;  EQ -> False; GT -> False }
 176     a <= b  = case compare a b of { LT -> True;  EQ -> True;  GT -> False }
 177     a >= b  = case compare a b of { LT -> False; EQ -> True;  GT -> True  }
 178     a >  b  = case compare a b of { LT -> False; EQ -> False; GT -> True  }
 179
 180     max a b = case compare a b of { LT -> b; EQ -> a;  GT -> a }
 181     min a b = case compare a b of { LT -> a; EQ -> a;  GT -> b }
 182
 183     compare []     []     = EQ
 184     compare (x:xs) []     = GT
 185     compare []     (y:ys) = LT
 186     compare (x:xs) (y:ys) = case compare x y of
 187                                  LT -> LT
 188                                  GT -> GT
 189                                  EQ -> compare xs ys
 190
 191 instance Functor [] where
 192     map f []             =  []
 193     map f (x:xs)         =  f x : map f xs
 194
 195 instance  Monad []  where
 196     m >>= k             = foldr ((++) . k) [] m
 197     m >> k              = foldr ((++) . (\ _ -> k)) [] m
 198     return x            = [x]
 199
 200 instance  MonadZero []  where
 201     zero                = []
 202
 203 instance  MonadPlus []  where
 204 #ifdef USE_REPORT_PRELUDE
 205     xs ++ ys            =  foldr (:) ys xs
 206 #else
 207     [] ++ ys            =  ys
 208     (x:xs) ++ ys        =  x : (xs ++ ys)
 209 #endif
 210
 211 instance  (Show a) => Show [a]  where
 212     showsPrec p         = showList
 213     showList  ls        = showList__ (showsPrec 0) ls
 214 \end{code}
 215
 216 \end{code}
 217
 218 A few list functions that appear here because they are used here.
 219 The rest of the prelude list functions are in PrelList.
 220
 221 \begin{code}
 222 foldr                   :: (a -> b -> b) -> b -> [a] -> b
 223 foldr f z []            =  z
 224 foldr f z (x:xs)        =  f x (foldr f z xs)
 225
 226 -- takeWhile, applied to a predicate p and a list xs, returns the longest
 227 -- prefix (possibly empty) of xs of elements that satisfy p.  dropWhile p xs
 228 -- returns the remaining suffix.  Span p xs is equivalent to
 229 -- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p.
 230
 231 takeWhile               :: (a -> Bool) -> [a] -> [a]
 232 takeWhile p []          =  []
 233 takeWhile p (x:xs)
 234             | p x       =  x : takeWhile p xs
 235             | otherwise =  []
 236
 237 dropWhile               :: (a -> Bool) -> [a] -> [a]
 238 dropWhile p []          =  []
 239 dropWhile p xs@(x:xs')
 240             | p x       =  dropWhile p xs'
 241             | otherwise =  xs
 242
 243 -- List index (subscript) operator, 0-origin
 244 (!!)                    :: [a] -> Int -> a
 245 #ifdef USE_REPORT_PRELUDE
 246 (x:_)  !! 0             =  x
 247 (_:xs) !! n | n > 0     =  xs !! (n-1)
 248 (_:_)  !! _             =  error "PreludeList.!!: negative index"
 249 []     !! _             =  error "PreludeList.!!: index too large"
 250 #else
 251 -- HBC version (stolen), then unboxified
 252 -- The semantics is not quite the same for error conditions
 253 -- in the more efficient version.
 254 --
 255 _      !! n | n < 0  =  error "(!!){PreludeList}: negative index\n"
 256 xs     !! n          =  sub xs (case n of { I# n# -> n# })
 257                            where sub :: [a] -> Int# -> a
 258                                  sub []      _ = error "(!!){PreludeList}: index too large\n"
 259                                  sub (x:xs) n# = if n# ==# 0#
 260                                                  then x
 261                                                  else sub xs (n# -# 1#)
 262 #endif
 263 \end{code}
 264
 265
 266 %*********************************************************
 267 %*                                                      *
 268 \subsection{Type @Void@}
 269 %*                                                      *
 270 %*********************************************************
 271
 272 The type @Void@ is built in, but it needs a @Show@ instance.
 273
 274 \begin{code}
 275 void :: Void
 276 void = error "You tried to evaluate void"
 277
 278 instance  Show Void  where
 279     showsPrec p f  =  showString "<<void>>"
 280     showList ls    = showList__ (showsPrec 0) ls
 281 \end{code}
 282
 283
 284 %*********************************************************
 285 %*                                                      *
 286 \subsection{Type @Bool@}
 287 %*                                                      *
 288 %*********************************************************
 289
 290 \begin{code}
 291 data  Bool  =  False | True     deriving (Eq, Ord, Enum, Bounded, Show {- Read -})
 292
 293 -- Boolean functions
 294
 295 (&&), (||)              :: Bool -> Bool -> Bool
 296 True  && x              =  x
 297 False && x              =  False
 298 True  || x              =  True
 299 False || x              =  x
 300
 301 not                     :: Bool -> Bool
 302 not True                =  False
 303 not False               =  True
 304
 305 otherwise               :: Bool
 306 otherwise               =  True
 307 \end{code}
 308
 309
 310 %*********************************************************
 311 %*                                                      *
 312 \subsection{The @()@ type}
 313 %*                                                      *
 314 %*********************************************************
 315
 316 The Unit type is here because virtually any program needs it (whereas
 317 some programs may get away without consulting PrelTup).  Furthermore,
 318 the renamer currently *always* asks for () to be in scope, so that
 319 ccalls can use () as their default type; so when compiling PrelBase we
 320 need ().  (We could arrange suck in () only if -fglasgow-exts, but putting
 321 it here seems more direct.
 322
 323 \begin{code}
 324 data  ()  =  ()  --easier to do explicitly: deriving (Eq, Ord, Enum, Show, Bounded)
 325                  -- (avoids weird-named functions, e.g., con2tag_()#
 326 instance Eq () where
 327     () == () = True
 328     () /= () = False
 329
 330 instance Ord () where
 331     () <= () = True
 332     () <  () = False
 333     () >= () = True
 334     () >  () = False
 335     max () () = ()
 336     min () () = ()
 337     compare () () = EQ
 338
 339 instance Enum () where
 340     toEnum 0    = ()
 341     toEnum _    = error "Prelude.Enum.().toEnum: argument not 0"
 342     fromEnum () = 0
 343     enumFrom ()         = [()]
 344     enumFromThen () ()  = [()]
 345     enumFromTo () ()    = [()]
 346     enumFromThenTo () () () = [()]
 347
 348 instance Bounded () where
 349     minBound = ()
 350     maxBound = ()
 351
 352 instance  Show ()  where
 353     showsPrec p () = showString "()"
 354     showList ls    = showList__ (showsPrec 0) ls
 355 \end{code}
 356
 357 %*********************************************************
 358 %*                                                      *
 359 \subsection{Type @Ordering@}
 360 %*                                                      *
 361 %*********************************************************
 362
 363 \begin{code}
 364 data Ordering = LT | EQ | GT    deriving (Eq, Ord, Enum, Bounded, Show {- Read -})
 365 \end{code}
 366
 367
 368 %*********************************************************
 369 %*                                                      *
 370 \subsection{Type @Char@ and @String@}
 371 %*                                                      *
 372 %*********************************************************
 373
 374 \begin{code}
 375 type  String = [Char]
 376
 377 data Char = C# Char#    deriving (Eq, Ord)
 378
 379 instance  Enum Char  where
 380     toEnum   (I# i) | i >=# 0# && i <=# 255# =  C# (chr# i)
 381                     | otherwise = error ("Prelude.Enum.Char.toEnum:out of range: " ++ show (I# i))
 382     fromEnum (C# c)              =  I# (ord# c)
 383
 384     enumFrom   (C# c)          =  efttCh (ord# c)  1#   (># 255#)
 385     enumFromTo (C# c1) (C# c2) = efttCh (ord# c1) 1#  (># (ord# c2))
 386
 387     enumFromThen (C# c1) (C# c2)
 388         | c1 `leChar#` c2 = efttCh (ord# c1) (ord# c2 -# ord# c1) (># 255#)
 389         | otherwise       = efttCh (ord# c1) (ord# c2 -# ord# c1) (<# 0#)
 390
 391     enumFromThenTo (C# c1) (C# c2) (C# c3)
 392         | c1 `leChar#` c2 = efttCh (ord# c1) (ord# c2 -# ord# c1) (># (ord# c3))
 393         | otherwise       = efttCh (ord# c1) (ord# c2 -# ord# c1) (<# (ord# c3))
 394
 395 efttCh :: Int# -> Int# -> (Int# -> Bool) -> [Char]
 396 efttCh now step done
 397   = go now
 398   where
 399     go now | done now  = []
 400            | otherwise = C# (chr# now) : go (now +# step)
 401
 402 instance  Bounded Char  where
 403     minBound            =  '\0'
 404     maxBound            =  '\255'
 405
 406 instance  Show Char  where
 407     showsPrec p '\'' = showString "'\\''"
 408     showsPrec p c    = showChar '\'' . showLitChar c . showChar '\''
 409
 410     showList cs = showChar '"' . showl cs
 411                  where showl ""       = showChar '"'
 412                        showl ('"':cs) = showString "\\\"" . showl cs
 413                        showl (c:cs)   = showLitChar c . showl cs
 414 \end{code}
 415
 416
 417 \begin{code}
 418 isAscii, isLatin1, isControl, isPrint, isSpace, isUpper,
 419  isLower, isAlpha, isDigit, isOctDigit, isHexDigit, isAlphanum :: Char -> Bool
 420 isAscii c               =  fromEnum c < 128
 421 isLatin1 c              =  c <= '\xff'
 422 isControl c             =  c < ' ' || c >= '\DEL' && c <= '\x9f'
 423 isPrint c               =  not (isControl c)
 424
 425 -- isSpace includes non-breaking space
 426 -- Done with explicit equalities both for efficiency, and to avoid a tiresome
 427 -- recursion with PrelList elem
 428 isSpace c               =  c == ' '     ||
 429                            c == '\t'    ||
 430                            c == '\n'    ||
 431                            c == '\r'    ||
 432                            c == '\f'    ||
 433                            c == '\v'    ||
 434                            c == '\xa0'
 435
 436 -- The upper case ISO characters have the multiplication sign dumped
 437 -- randomly in the middle of the range.  Go figure.
 438 isUpper c               =  c >= 'A' && c <= 'Z' ||
 439                            c >= '\xC0' && c <= '\xD6' ||
 440                            c >= '\xD8' && c <= '\xDE'
 441 -- The lower case ISO characters have the division sign dumped
 442 -- randomly in the middle of the range.  Go figure.
 443 isLower c               =  c >= 'a' && c <= 'z' ||
 444                            c >= '\xDF' && c <= '\xF6' ||
 445                            c >= '\xF8' && c <= '\xFF'
 446 isAlpha c               =  isLower c || isUpper c
 447 isDigit c               =  c >= '0' && c <= '9'
 448 isOctDigit c            =  c >= '0' && c <= '7'
 449 isHexDigit c            =  isDigit c || c >= 'A' && c <= 'F' ||
 450                                         c >= 'a' && c <= 'f'
 451 isAlphanum c            =  isAlpha c || isDigit c
 452
 453 -- Case-changing operations
 454
 455 toUpper, toLower        :: Char -> Char
 456 toUpper c | isLower c   && c /= '\xDF' && c /= '\xFF'
 457  =  toEnum (fromEnum c - fromEnum 'a' + fromEnum 'A')
 458   | otherwise   =  c
 459
 460 toLower c | isUpper c   =  toEnum (fromEnum c - fromEnum 'A'
 461                                               + fromEnum 'a')
 462           | otherwise   =  c
 463
 464 asciiTab = -- Using an array drags in the array module.  listArray ('\NUL', ' ')
 465            ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",
 466             "BS",  "HT",  "LF",  "VT",  "FF",  "CR",  "SO",  "SI",
 467             "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",
 468             "CAN", "EM",  "SUB", "ESC", "FS",  "GS",  "RS",  "US",
 469             "SP"]
 470 \end{code}
 471
 472 %*********************************************************
 473 %*                                                      *
 474 \subsection{Type @Int@}
 475 %*                                                      *
 476 %*********************************************************
 477
 478 \begin{code}
 479 data Int = I# Int#
 480
 481 instance Eq Int where
 482     (==) x y = x `eqInt` y
 483     (/=) x y = x `neInt` y
 484
 485 instance Ord Int where
 486     compare x y = compareInt x y
 487
 488     (<)  x y = ltInt x y
 489     (<=) x y = leInt x y
 490     (>=) x y = geInt x y
 491     (>)  x y = gtInt x y
 492     max x y = case (compareInt x y) of { LT -> y ; EQ -> x ; GT -> x }
 493     min x y = case (compareInt x y) of { LT -> x ; EQ -> x ; GT -> y }
 494
 495 (I# x) `compareInt` (I# y) | x <# y    = LT
 496                            | x ==# y   = EQ
 497                            | otherwise = GT
 498
 499 instance  Enum Int  where
 500     toEnum   x = x
 501     fromEnum x = x
 502
 503 #ifndef USE_FOLDR_BUILD
 504     enumFrom     (I# c)          = eftInt c  1#
 505     enumFromTo   (I# c1) (I# c2) = efttInt c1 1#  (># c2)
 506     enumFromThen (I# c1) (I# c2) = eftInt c1 (c2 -# c1)
 507
 508     enumFromThenTo (I# c1) (I# c2) (I# c3)
 509         | c1 <=# c2 = efttInt c1 (c2 -# c1) (># c3)
 510         | otherwise = efttInt c1 (c2 -# c1) (<# c3)
 511
 512 #else
 513     {-# INLINE enumFrom #-}
 514     {-# INLINE enumFromTo #-}
 515     enumFrom x           = build (\ c _ ->
 516         let g x = x `c` g (x `plusInt` 1) in g x)
 517     enumFromTo x y       = build (\ c n ->
 518         let g x = if x <= y then x `c` g (x `plusInt` 1) else n in g x)
 519 #endif
 520
 521 efttInt :: Int# -> Int# -> (Int# -> Bool) -> [Int]
 522 efttInt now step done
 523   = go now
 524   where
 525     go now | done now  = []
 526            | otherwise = I# now : go (now +# step)
 527
 528 eftInt :: Int# -> Int# -> [Int]
 529 eftInt now step
 530   = go now
 531   where
 532     go now = I# now : go (now +# step)
 533
 534
 535 instance  Bounded Int where
 536     minBound =  -2147483647            -- **********************
 537     maxBound =  2147483647             -- **********************
 538
 539 instance  Num Int  where
 540     (+)    x y =  plusInt x y
 541     (-)    x y =  minusInt x y
 542     negate x   =  negateInt x
 543     (*)    x y =  timesInt x y
 544     abs    n   = if n `geInt` 0 then n else (negateInt n)
 545
 546     signum n | n `ltInt` 0 = negateInt 1
 547              | n `eqInt` 0 = 0
 548              | otherwise   = 1
 549
 550     fromInteger (J# a# s# d#)
 551       = case (integer2Int# a# s# d#) of { i# -> I# i# }
 552
 553     fromInt n           = n
 554
 555 instance  Show Int  where
 556     showsPrec p n = showSignedInt p n
 557     showList ls   = showList__ (showsPrec 0)  ls
 558 \end{code}
 559
 560
 561 %*********************************************************
 562 %*                                                      *
 563 \subsection{Type @Integer@, @Float@, @Double@}
 564 %*                                                      *
 565 %*********************************************************
 566
 567 Just the type declarations.  If we don't actually use any @Integers@ we'd
 568 rather not link the @Integer@ module at all; and the default-decl stuff
 569 in the renamer tends to slurp in @Double@ regardless.
 570
 571 \begin{code}
 572 data Float      = F# Float#
 573 data Double     = D# Double#
 574 data Integer    = J# Int# Int# ByteArray#
 575 \end{code}
 576
 577
 578 %*********************************************************
 579 %*                                                      *
 580 \subsection{The function type}
 581 %*                                                      *
 582 %*********************************************************
 583
 584 \begin{code}
 585 instance Eval (a -> b)
 586
 587 instance  Show (a -> b)  where
 588     showsPrec p f  =  showString "<<function>>"
 589     showList ls    = showList__ (showsPrec 0) ls
 590
 591
 592 -- identity function
 593 id                      :: a -> a
 594 id x                    =  x
 595
 596 -- constant function
 597 const                   :: a -> b -> a
 598 const x _               =  x
 599
 600 -- function composition
 601 {-# INLINE (.) #-}
 602 {-# GENERATE_SPECS (.) a b c #-}
 603 (.)       :: (b -> c) -> (a -> b) -> a -> c
 604 (.) f g x = f (g x)
 605
 606 -- flip f  takes its (first) two arguments in the reverse order of f.
 607 flip                    :: (a -> b -> c) -> b -> a -> c
 608 flip f x y              =  f y x
 609
 610 -- right-associating infix application operator (useful in continuation-
 611 -- passing style)
 612 ($)                     :: (a -> b) -> a -> b
 613 f $ x                   =  f x
 614
 615 -- until p f  yields the result of applying f until p holds.
 616 until                   :: (a -> Bool) -> (a -> a) -> a -> a
 617 until p f x | p x       =  x
 618             | otherwise =  until p f (f x)
 619
 620 -- asTypeOf is a type-restricted version of const.  It is usually used
 621 -- as an infix operator, and its typing forces its first argument
 622 -- (which is usually overloaded) to have the same type as the second.
 623 asTypeOf                :: a -> a -> a
 624 asTypeOf                =  const
 625 \end{code}
 626
 627
 628 %*********************************************************
 629 %*                                                      *
 630 \subsection{Miscellaneous}
 631 %*                                                      *
 632 %*********************************************************
 633
 634
 635 \begin{code}
 636 data Lift a = Lift a
 637 {-# GENERATE_SPECS data a :: Lift a #-}
 638 \end{code}
 639
 640
 641
 642
 643 %*********************************************************
 644 %*                                                      *
 645 \subsection{Support code for @Show@}
 646 %*                                                      *
 647 %*********************************************************
 648
 649 \begin{code}
 650 shows           :: (Show a) => a -> ShowS
 651 shows           =  showsPrec 0
 652
 653 show            :: (Show a) => a -> String
 654 show x          =  shows x ""
 655
 656 showChar        :: Char -> ShowS
 657 showChar        =  (:)
 658
 659 showString      :: String -> ShowS
 660 showString      =  (++)
 661
 662 showParen       :: Bool -> ShowS -> ShowS
 663 showParen b p   =  if b then showChar '(' . p . showChar ')' else p
 664
 665 {-# GENERATE_SPECS showList__ a #-}
 666 showList__ :: (a -> ShowS) ->  [a] -> ShowS
 667
 668 showList__ showx []     = showString "[]"
 669 showList__ showx (x:xs) = showChar '[' . showx x . showl xs
 670   where
 671     showl []     = showChar ']'
 672     showl (x:xs) = showString ", " . showx x . showl xs
 673
 674 showSpace :: ShowS
 675 showSpace = {-showChar ' '-} \ xs -> ' ' : xs
 676 \end{code}
 677
 678 Code specific for characters
 679
 680 \begin{code}
 681 showLitChar                :: Char -> ShowS
 682 showLitChar c | c > '\DEL' =  showChar '\\' . protectEsc isDigit (shows (ord c))
 683 showLitChar '\DEL'         =  showString "\\DEL"
 684 showLitChar '\\'           =  showString "\\\\"
 685 showLitChar c | c >= ' '   =  showChar c
 686 showLitChar '\a'           =  showString "\\a"
 687 showLitChar '\b'           =  showString "\\b"
 688 showLitChar '\f'           =  showString "\\f"
 689 showLitChar '\n'           =  showString "\\n"
 690 showLitChar '\r'           =  showString "\\r"
 691 showLitChar '\t'           =  showString "\\t"
 692 showLitChar '\v'           =  showString "\\v"
 693 showLitChar '\SO'          =  protectEsc (== 'H') (showString "\\SO")
 694 showLitChar c              =  showString ('\\' : asciiTab!!ord c)
 695
 696 protectEsc p f             = f . cont
 697                              where cont s@(c:_) | p c = "\\&" ++ s
 698                                    cont s             = s
 699
 700 intToDigit :: Int -> Char
 701 intToDigit i
 702  | i >= 0  && i <=  9   =  toEnum (fromEnum '0' + i)
 703  | i >= 10 && i <= 15   =  toEnum (fromEnum 'a' + i -10)
 704  | otherwise            =  error "Char.intToDigit: not a digit" -- ....
 705
 706 \end{code}
 707
 708 Code specific for Ints.
 709
 710 \begin{code}
 711 showSignedInt :: Int -> Int -> ShowS
 712 showSignedInt p (I# n) r
 713   = -- from HBC version; support code follows
 714     if n <# 0# && p > 6 then '(':itos n++(')':r) else itos n ++ r
 715
 716 itos :: Int# -> String
 717 itos n =
 718     if n <# 0# then
 719         if negateInt# n <# 0# then
 720             -- n is minInt, a difficult number
 721             itos (n `quotInt#` 10#) ++ itos' (negateInt# (n `remInt#` 10#)) []
 722         else
 723             '-':itos' (negateInt# n) []
 724     else
 725         itos' n []
 726   where
 727     itos' :: Int# -> String -> String
 728     itos' n cs =
 729         if n <# 10# then
 730             C# (chr# (n +# ord# '0'#)) : cs
 731         else
 732             itos' (n `quotInt#` 10#) (C# (chr# (n `remInt#` 10# +# ord# '0'#)) : cs)
 733 \end{code}
 734
 735 %*********************************************************
 736 %*                                                      *
 737 \subsection{Numeric primops}
 738 %*                                                      *
 739 %*********************************************************
 740
 741 Definitions of the boxed PrimOps; these will be
 742 used in the case of partial applications, etc.
 743
 744 \begin{code}
 745 {-# INLINE eqInt #-}
 746 {-# INLINE neInt #-}
 747
 748 plusInt (I# x) (I# y) = I# (x +# y)
 749 minusInt(I# x) (I# y) = I# (x -# y)
 750 timesInt(I# x) (I# y) = I# (x *# y)
 751 quotInt (I# x) (I# y) = I# (quotInt# x y)
 752 remInt  (I# x) (I# y) = I# (remInt# x y)
 753 negateInt (I# x)      = I# (negateInt# x)
 754 gtInt   (I# x) (I# y) = x ># y
 755 geInt   (I# x) (I# y) = x >=# y
 756 eqInt   (I# x) (I# y) = x ==# y
 757 neInt   (I# x) (I# y) = x /=# y
 758 ltInt   (I# x) (I# y) = x <# y
 759 leInt   (I# x) (I# y) = x <=# y
 760 \end{code}