ghc/lib/std/PrelNum.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[PrelNum]{Module @PrelNum@}
   6
   7 \begin{code}
   8 {-# OPTIONS -fno-implicit-prelude #-}
   9
  10 module PrelNum where
  11
  12 import {-# SOURCE #-} PrelErr
  13 import PrelBase
  14 import PrelList
  15 import PrelEnum
  16 import PrelShow
  17
  18 infixr 8  ^, ^^, **
  19 infixl 7  %, /, `quot`, `rem`, `div`, `mod`
  20 infixl 7  *
  21 infixl 6  +, -
  22
  23 \end{code}
  24
  25 %*********************************************************
  26 %*                                                      *
  27 \subsection{Standard numeric classes}
  28 %*                                                      *
  29 %*********************************************************
  30
  31 \begin{code}
  32 class  (Eq a, Show a) => Num a  where
  33     (+), (-), (*)       :: a -> a -> a
  34     negate              :: a -> a
  35     abs, signum         :: a -> a
  36     fromInteger         :: Integer -> a
  37     fromInt             :: Int -> a -- partain: Glasgow extension
  38
  39     x - y               = x + negate y
  40     negate x            = 0 - x
  41     fromInt (I# i#)     = fromInteger (S# i#)
  42                                         -- Go via the standard class-op if the
  43                                         -- non-standard one ain't provided
  44
  45 class  (Num a, Ord a) => Real a  where
  46     toRational          ::  a -> Rational
  47
  48 class  (Real a, Enum a) => Integral a  where
  49     quot, rem, div, mod :: a -> a -> a
  50     quotRem, divMod     :: a -> a -> (a,a)
  51     toInteger           :: a -> Integer
  52     toInt               :: a -> Int -- partain: Glasgow extension
  53
  54     n `quot` d          =  q  where (q,_) = quotRem n d
  55     n `rem` d           =  r  where (_,r) = quotRem n d
  56     n `div` d           =  q  where (q,_) = divMod n d
  57     n `mod` d           =  r  where (_,r) = divMod n d
  58     divMod n d          =  if signum r == negate (signum d) then (q-1, r+d) else qr
  59                            where qr@(q,r) = quotRem n d
  60
  61 class  (Num a) => Fractional a  where
  62     (/)                 :: a -> a -> a
  63     recip               :: a -> a
  64     fromRational        :: Rational -> a
  65
  66     recip x             =  1 / x
  67     x / y               = x * recip y
  68
  69 class  (Fractional a) => Floating a  where
  70     pi                  :: a
  71     exp, log, sqrt      :: a -> a
  72     (**), logBase       :: a -> a -> a
  73     sin, cos, tan       :: a -> a
  74     asin, acos, atan    :: a -> a
  75     sinh, cosh, tanh    :: a -> a
  76     asinh, acosh, atanh :: a -> a
  77
  78     x ** y              =  exp (log x * y)
  79     logBase x y         =  log y / log x
  80     sqrt x              =  x ** 0.5
  81     tan  x              =  sin  x / cos  x
  82     tanh x              =  sinh x / cosh x
  83
  84 class  (Real a, Fractional a) => RealFrac a  where
  85     properFraction      :: (Integral b) => a -> (b,a)
  86     truncate, round     :: (Integral b) => a -> b
  87     ceiling, floor      :: (Integral b) => a -> b
  88
  89     truncate x          =  m  where (m,_) = properFraction x
  90
  91     round x             =  let (n,r) = properFraction x
  92                                m     = if r < 0 then n - 1 else n + 1
  93                            in case signum (abs r - 0.5) of
  94                                 -1 -> n
  95                                 0  -> if even n then n else m
  96                                 1  -> m
  97
  98     ceiling x           =  if r > 0 then n + 1 else n
  99                            where (n,r) = properFraction x
 100
 101     floor x             =  if r < 0 then n - 1 else n
 102                            where (n,r) = properFraction x
 103
 104 class  (RealFrac a, Floating a) => RealFloat a  where
 105     floatRadix          :: a -> Integer
 106     floatDigits         :: a -> Int
 107     floatRange          :: a -> (Int,Int)
 108     decodeFloat         :: a -> (Integer,Int)
 109     encodeFloat         :: Integer -> Int -> a
 110     exponent            :: a -> Int
 111     significand         :: a -> a
 112     scaleFloat          :: Int -> a -> a
 113     isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE
 114                         :: a -> Bool
 115     atan2               :: a -> a -> a
 116
 117
 118     exponent x          =  if m == 0 then 0 else n + floatDigits x
 119                            where (m,n) = decodeFloat x
 120
 121     significand x       =  encodeFloat m (negate (floatDigits x))
 122                            where (m,_) = decodeFloat x
 123
 124     scaleFloat k x      =  encodeFloat m (n+k)
 125                            where (m,n) = decodeFloat x
 126
 127     atan2 y x
 128       | x > 0            =  atan (y/x)
 129       | x == 0 && y > 0  =  pi/2
 130       | x <  0 && y > 0  =  pi + atan (y/x)
 131       |(x <= 0 && y < 0)            ||
 132        (x <  0 && isNegativeZero y) ||
 133        (isNegativeZero x && isNegativeZero y)
 134                          = -atan2 (-y) x
 135       | y == 0 && (x < 0 || isNegativeZero x)
 136                           =  pi    -- must be after the previous test on zero y
 137       | x==0 && y==0      =  y     -- must be after the other double zero tests
 138       | otherwise         =  x + y -- x or y is a NaN, return a NaN (via +)
 139
 140 \end{code}
 141
 142 %*********************************************************
 143 %*                                                      *
 144 \subsection{Instances for @Int@}
 145 %*                                                      *
 146 %*********************************************************
 147
 148 \begin{code}
 149 instance  Num Int  where
 150     (+)    x y =  plusInt x y
 151     (-)    x y =  minusInt x y
 152     negate x   =  negateInt x
 153     (*)    x y =  timesInt x y
 154     abs    n   = if n `geInt` 0 then n else (negateInt n)
 155
 156     signum n | n `ltInt` 0 = negateInt 1
 157              | n `eqInt` 0 = 0
 158              | otherwise   = 1
 159
 160     fromInteger (S# i#) = I# i#
 161     fromInteger (J# s# d#)
 162       = case (integer2Int# s# d#) of { i# -> I# i# }
 163
 164     fromInt n           = n
 165
 166 instance  Real Int  where
 167     toRational x        =  toInteger x % 1
 168
 169 instance  Integral Int  where
 170     a@(I# _) `quotRem` b@(I# _) = (a `quotInt` b, a `remInt` b)
 171     -- OK, so I made it a little stricter.  Shoot me.  (WDP 94/10)
 172
 173     -- Following chks for zero divisor are non-standard (WDP)
 174     a `quot` b  =  if b /= 0
 175                    then a `quotInt` b
 176                    else error "Prelude.Integral.quot{Int}: divide by 0"
 177     a `rem` b   =  if b /= 0
 178                    then a `remInt` b
 179                    else error "Prelude.Integral.rem{Int}: divide by 0"
 180
 181     x `div` y = if x > 0 && y < 0       then quotInt (x-y-1) y
 182                 else if x < 0 && y > 0  then quotInt (x-y+1) y
 183                 else quotInt x y
 184     x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then
 185                     if r/=0 then r+y else 0
 186                 else
 187                     r
 188               where r = remInt x y
 189
 190     divMod x@(I# _) y@(I# _) = (x `div` y, x `mod` y)
 191     -- Stricter.  Sorry if you don't like it.  (WDP 94/10)
 192
 193 --OLD:   even x = eqInt (x `mod` 2) 0
 194 --OLD:   odd x  = neInt (x `mod` 2) 0
 195
 196     toInteger (I# i)  = int2Integer i  -- give back a full-blown Integer
 197     toInt x           = x
 198
 199 \end{code}
 200
 201 %*********************************************************
 202 %*                                                      *
 203 \subsection{Instances for @Integer@}
 204 %*                                                      *
 205 %*********************************************************
 206
 207 \begin{code}
 208 toBig (S# i) = case int2Integer# i of { (# s, d #) -> J# s d }
 209 toBig i@(J# _ _) = i
 210
 211 instance  Num Integer  where
 212     (+) i1@(S# i) i2@(S# j)
 213         = case addIntC# i j of { (# r, c #) ->
 214           if c ==# 0# then S# r
 215           else toBig i1 + toBig i2 }
 216     (+) i1@(J# _ _) i2@(S# _)   = i1 + toBig i2
 217     (+) i1@(S# _) i2@(J# _ _)   = toBig i1 + i2
 218     (+) (J# s1 d1) (J# s2 d2)
 219       = case plusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
 220
 221     (-) i1@(S# i) i2@(S# j)
 222         = case subIntC# i j of { (# r, c #) ->
 223           if c ==# 0# then S# r
 224           else toBig i1 - toBig i2 }
 225     (-) i1@(J# _ _) i2@(S# _)   = i1 - toBig i2
 226     (-) i1@(S# _) i2@(J# _ _)   = toBig i1 - i2
 227     (-) (J# s1 d1) (J# s2 d2)
 228       = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
 229
 230     (*) i1@(S# i) i2@(S# j)
 231         = case mulIntC# i j of { (# r, c #) ->
 232           if c ==# 0# then S# r
 233           else toBig i1 * toBig i2 }
 234     (*) i1@(J# _ _) i2@(S# _)   = i1 * toBig i2
 235     (*) i1@(S# _) i2@(J# _ _)   = toBig i1 * i2
 236     (*) (J# s1 d1) (J# s2 d2)
 237       = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
 238
 239     negate (S# (-2147483648#)) = 2147483648
 240     negate (S# i) = S# (negateInt# i)
 241     negate (J# s d) = J# (negateInt# s) d
 242
 243     -- ORIG: abs n = if n >= 0 then n else -n
 244
 245     abs (S# (-2147483648#)) = 2147483648
 246     abs (S# i) = case abs (I# i) of I# j -> S# j
 247     abs n@(J# s d) = if (s >=# 0#) then n else J# (negateInt# s) d
 248
 249     signum (S# i) = case signum (I# i) of I# j -> S# j
 250     signum (J# s d)
 251       = let
 252             cmp = cmpIntegerInt# s d 0#
 253         in
 254         if      cmp >#  0# then S# 1#
 255         else if cmp ==# 0# then S# 0#
 256         else                    S# (negateInt# 1#)
 257
 258     fromInteger x       =  x
 259
 260     fromInt (I# i)      =  S# i
 261
 262 instance  Real Integer  where
 263     toRational x        =  x % 1
 264
 265 instance  Integral Integer where
 266         -- ToDo:  a `rem`  b returns a small integer if b is small,
 267         --        a `quot` b returns a small integer if a is small.
 268     quotRem (S# i) (S# j)
 269       = case quotRem (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j)
 270     quotRem i1@(J# _ _) i2@(S# _) = quotRem i1 (toBig i2)
 271     quotRem i1@(S# _) i2@(J# _ _) = quotRem (toBig i1) i2
 272     quotRem (J# s1 d1) (J# s2 d2)
 273       = case (quotRemInteger# s1 d1 s2 d2) of
 274           (# s3, d3, s4, d4 #)
 275             -> (J# s3 d3, J# s4 d4)
 276
 277     toInteger n      = n
 278     toInt (S# i)     = I# i
 279     toInt (J# s d)   = case (integer2Int# s d) of { n# -> I# n# }
 280
 281         -- we've got specialised quot/rem methods for Integer (see below)
 282     n `quot` d = n `quotInteger` d
 283     n `rem`  d = n `remInteger`  d
 284
 285     n `div` d   =  q  where (q,_) = divMod n d
 286     n `mod` d   =  r  where (_,r) = divMod n d
 287
 288     divMod (S# i) (S# j)
 289       = case divMod (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j)
 290     divMod i1@(J# _ _) i2@(S# _) = divMod i1 (toBig i2)
 291     divMod i1@(S# _) i2@(J# _ _) = divMod (toBig i1) i2
 292     divMod (J# s1 d1) (J# s2 d2)
 293       = case (divModInteger# s1 d1 s2 d2) of
 294           (# s3, d3, s4, d4 #)
 295             -> (J# s3 d3, J# s4 d4)
 296
 297 remInteger :: Integer -> Integer -> Integer
 298 remInteger ia 0
 299   = error "Prelude.Integral.rem{Integer}: divide by 0"
 300 remInteger (S# a) (S# b) = S# (remInt# a b)
 301 remInteger ia@(S# a) (J# sb b)
 302   = if sb ==# 1#
 303     then
 304       S# (remInt# a (word2Int# (integer2Word# sb b)))
 305     else if sb ==# -1# then
 306       S# (remInt# a (0# -# (word2Int# (integer2Word# sb b))))
 307     else if 0# <# sb then
 308       ia
 309     else
 310       S# (0# -# a)
 311 remInteger (J# sa a) (S# b)
 312   = case int2Integer# b of { (# sb, b #) ->
 313     case remInteger# sa a sb b of { (# sr, r #) ->
 314     S# (sr *# (word2Int# (integer2Word# sr r))) }}
 315 remInteger (J# sa a) (J# sb b)
 316   = case remInteger# sa a sb b of (# sr, r #) -> J# sr r
 317
 318 quotInteger :: Integer -> Integer -> Integer
 319 quotInteger ia 0
 320   = error "Prelude.Integral.quot{Integer}: divide by 0"
 321 quotInteger (S# a) (S# b) = S# (quotInt# a b)
 322 quotInteger (S# a) (J# sb b)
 323   = if sb ==# 1#
 324     then
 325       S# (quotInt# a (word2Int# (integer2Word# sb b)))
 326     else if sb ==# -1# then
 327       S# (quotInt# a (0# -# (word2Int# (integer2Word# sb b))))
 328     else
 329       zeroInteger
 330 quotInteger (J# sa a) (S# b)
 331   = case int2Integer# b of { (# sb, b #) ->
 332     case quotInteger# sa a sb b of (# sq, q #) -> J# sq q }
 333 quotInteger (J# sa a) (J# sb b)
 334   = case quotInteger# sa a sb b of (# sg, g #) -> J# sg g
 335
 336 zeroInteger :: Integer
 337 zeroInteger = S# 0#
 338
 339 ------------------------------------------------------------------------
 340 instance  Enum Integer  where
 341     succ x               = x + 1
 342     pred x               = x - 1
 343     toEnum n             =  toInteger n
 344     fromEnum n           =  toInt n
 345
 346     {-# INLINE enumFrom #-}
 347     {-# INLINE enumFromThen #-}
 348     {-# INLINE enumFromTo #-}
 349     {-# INLINE enumFromThenTo #-}
 350     enumFrom x             = build (\c _ -> enumDeltaIntegerFB   c   x 1)
 351     enumFromThen x y       = build (\c _ -> enumDeltaIntegerFB   c   x (y-x))
 352     enumFromTo x lim       = build (\c n -> enumDeltaToIntegerFB c n x 1     lim)
 353     enumFromThenTo x y lim = build (\c n -> enumDeltaToIntegerFB c n x (y-x) lim)
 354
 355 enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b
 356 enumDeltaIntegerFB c x d = x `c` enumDeltaIntegerFB c (x+d) d
 357
 358 enumDeltaIntegerList :: Integer -> Integer -> [Integer]
 359 enumDeltaIntegerList x d = x : enumDeltaIntegerList (x+d) d
 360
 361 enumDeltaToIntegerFB c n x delta lim
 362   | delta >= 0 = up_fb c n x delta lim
 363   | otherwise  = dn_fb c n x delta lim
 364
 365 enumDeltaToIntegerList x delta lim
 366   | delta >= 0 = up_list x delta lim
 367   | otherwise  = dn_list x delta lim
 368
 369 up_fb c n x delta lim = go (x::Integer)
 370                       where
 371                         go x | x > lim   = n
 372                              | otherwise = x `c` go (x+delta)
 373 dn_fb c n x delta lim = go (x::Integer)
 374                       where
 375                         go x | x < lim   = n
 376                              | otherwise = x `c` go (x+delta)
 377
 378 up_list x delta lim = go (x::Integer)
 379                     where
 380                         go x | x > lim   = []
 381                              | otherwise = x : go (x+delta)
 382 dn_list x delta lim = go (x::Integer)
 383                     where
 384                         go x | x < lim   = []
 385                              | otherwise = x : go (x+delta)
 386
 387 {-# RULES
 388 "enumDeltaInteger"      enumDeltaIntegerFB   (:)    = enumDeltaIntegerList
 389 "enumDeltaToInteger"    enumDeltaToIntegerFB (:) [] = enumDeltaToIntegerList
 390  #-}
 391 \end{code}
 392
 393 %*********************************************************
 394 %*                                                      *
 395 \subsection{Show code for Integers}
 396 %*                                                      *
 397 %*********************************************************
 398
 399 \begin{code}
 400 instance  Show Integer  where
 401     showsPrec   x = showSignedInteger x
 402     showList = showList__ (showsPrec 0)
 403
 404 showSignedInteger :: Int -> Integer -> ShowS
 405 showSignedInteger p n r
 406   | n < 0 && p > 6 = '(':jtos n (')':r)
 407   | otherwise      = jtos n r
 408
 409 jtos :: Integer -> String -> String
 410 jtos i rs
 411  | i < 0     = '-' : jtos' (-i) rs
 412  | otherwise = jtos' i rs
 413  where
 414   jtos' :: Integer -> String -> String
 415   jtos' n cs
 416    | n < 10    = chr (fromInteger n + (ord_0::Int)) : cs
 417    | otherwise = jtos' q (chr (toInt r + (ord_0::Int)) : cs)
 418     where
 419      (q,r) = n `quotRem` 10
 420
 421 ord_0 :: Num a => a
 422 ord_0 = fromInt (ord '0')
 423 \end{code}
 424
 425 %*********************************************************
 426 %*                                                      *
 427 \subsection{The @Ratio@ and @Rational@ types}
 428 %*                                                      *
 429 %*********************************************************
 430
 431 \begin{code}
 432 data  (Integral a)      => Ratio a = !a :% !a  deriving (Eq)
 433 type  Rational          =  Ratio Integer
 434
 435 {-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}
 436 (%)                     :: (Integral a) => a -> a -> Ratio a
 437 numerator, denominator  :: (Integral a) => Ratio a -> a
 438 \end{code}
 439
 440 \tr{reduce} is a subsidiary function used only in this module .
 441 It normalises a ratio by dividing both numerator and denominator by
 442 their greatest common divisor.
 443
 444 \begin{code}
 445 reduce ::  (Integral a) => a -> a -> Ratio a
 446 reduce _ 0              =  error "Ratio.%: zero denominator"
 447 reduce x y              =  (x `quot` d) :% (y `quot` d)
 448                            where d = gcd x y
 449 \end{code}
 450
 451 \begin{code}
 452 x % y                   =  reduce (x * signum y) (abs y)
 453
 454 numerator   (x :% _)    =  x
 455 denominator (_ :% y)    =  y
 456
 457 \end{code}
 458
 459 %*********************************************************
 460 %*                                                      *
 461 \subsection{Overloaded numeric functions}
 462 %*                                                      *
 463 %*********************************************************
 464
 465 \begin{code}
 466
 467 {-# SPECIALISE subtract :: Int -> Int -> Int #-}
 468 subtract        :: (Num a) => a -> a -> a
 469 subtract x y    =  y - x
 470
 471 even, odd       :: (Integral a) => a -> Bool
 472 even n          =  n `rem` 2 == 0
 473 odd             =  not . even
 474
 475 gcd             :: (Integral a) => a -> a -> a
 476 gcd 0 0         =  error "Prelude.gcd: gcd 0 0 is undefined"
 477 gcd x y         =  gcd' (abs x) (abs y)
 478                    where gcd' a 0  =  a
 479                          gcd' a b  =  gcd' b (a `rem` b)
 480
 481 {-# SPECIALISE lcm ::
 482         Int -> Int -> Int,
 483         Integer -> Integer -> Integer #-}
 484 lcm             :: (Integral a) => a -> a -> a
 485 lcm _ 0         =  0
 486 lcm 0 _         =  0
 487 lcm x y         =  abs ((x `quot` (gcd x y)) * y)
 488
 489 {-# SPECIALISE (^) ::
 490         Integer -> Integer -> Integer,
 491         Integer -> Int -> Integer,
 492         Int -> Int -> Int #-}
 493 (^)             :: (Num a, Integral b) => a -> b -> a
 494 _ ^ 0           =  1
 495 x ^ n | n > 0   =  f x (n-1) x
 496                    where f _ 0 y = y
 497                          f a d y = g a d  where
 498                                    g b i | even i  = g (b*b) (i `quot` 2)
 499                                          | otherwise = f b (i-1) (b*y)
 500 _ ^ _           = error "Prelude.^: negative exponent"
 501
 502 {- SPECIALISE (^^) ::
 503         Double -> Int -> Double,
 504         Rational -> Int -> Rational #-}
 505 (^^)            :: (Fractional a, Integral b) => a -> b -> a
 506 x ^^ n          =  if n >= 0 then x^n else recip (x^(negate n))
 507 \end{code}
 508
 509 %*********************************************************
 510 %*                                                      *
 511 \subsection{Specialized versions of gcd/lcm for Int/Integer}
 512 %*                                                      *
 513 %*********************************************************
 514
 515 \begin{code}
 516 {-# RULES
 517 "Int.gcd"      forall a b . gcd  a b = gcdInt a b
 518 "Integer.gcd"  forall a b . gcd  a b = gcdInteger  a b
 519 "Integer.lcm"  forall a b . lcm  a b = lcmInteger  a b
 520  #-}
 521
 522 gcdInt :: Int -> Int -> Int
 523 gcdInt (I# a)  (I# b)
 524   = I# (gcdInt# a b)
 525
 526 gcdInteger :: Integer -> Integer -> Integer
 527 gcdInteger (S# a) (S# b)
 528   = case gcdInt# a b of g -> S# g
 529 gcdInteger ia@(S# a) ib@(J# sb b)
 530   | a  ==# 0#  = abs ib
 531   | sb ==# 0#  = abs ia
 532   | otherwise  = case gcdIntegerInt# sb b a of g -> S# g
 533 gcdInteger ia@(J# sa a) ib@(S# b)
 534   | sa ==# 0#  = abs ib
 535   | b ==# 0#   = abs ia
 536   | otherwise  = case gcdIntegerInt# sa a b of g -> S# g
 537 gcdInteger (J# sa a) (J# sb b)
 538   = case gcdInteger# sa a sb b of (# sg, g #) -> J# sg g
 539
 540 lcmInteger :: Integer -> Integer -> Integer
 541 lcmInteger a 0
 542   = zeroInteger
 543 lcmInteger 0 b
 544   = zeroInteger
 545 lcmInteger a b
 546   = (divExact aa (gcdInteger aa ab)) * ab
 547   where aa = abs a
 548         ab = abs b
 549
 550 divExact :: Integer -> Integer -> Integer
 551 divExact (S# a) (S# b)
 552   = S# (quotInt# a b)
 553 divExact (S# a) (J# sb b)
 554   = S# (quotInt# a (sb *# (word2Int# (integer2Word# sb b))))
 555 divExact (J# sa a) (S# b)
 556   = case int2Integer# b of
 557      (# sb, b #) -> case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d
 558 divExact (J# sa a) (J# sb b)
 559   = case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d
 560 \end{code}