ghc/lib/std/PrelBase.lhs

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