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# i) = case abs (I# i) of I# j -> S# j
 246     abs n@(J# s d)
 247       = if (cmpIntegerInt# s d 0#) >=# 0#
 248         then n
 249         else J# (negateInt# s) d
 250
 251     signum (S# i) = case signum (I# i) of I# j -> S# j
 252     signum (J# s d)
 253       = let
 254             cmp = cmpIntegerInt# s d 0#
 255         in
 256         if      cmp >#  0# then S# 1#
 257         else if cmp ==# 0# then S# 0#
 258         else                    S# (negateInt# 1#)
 259
 260     fromInteger x       =  x
 261
 262     fromInt (I# i)      =  S# i
 263
 264 instance  Real Integer  where
 265     toRational x        =  x % 1
 266
 267 instance  Integral Integer where
 268         -- ToDo:  a `rem`  b returns a small integer if b is small,
 269         --        a `quot` b returns a small integer if a is small.
 270     quotRem (S# i) (S# j)
 271       = case quotRem (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j)
 272     quotRem i1@(J# _ _) i2@(S# _) = quotRem i1 (toBig i2)
 273     quotRem i1@(S# _) i2@(J# _ _) = quotRem (toBig i1) i2
 274     quotRem (J# s1 d1) (J# s2 d2)
 275       = case (quotRemInteger# s1 d1 s2 d2) of
 276           (# s3, d3, s4, d4 #)
 277             -> (J# s3 d3, J# s4 d4)
 278
 279     toInteger n      = n
 280     toInt (S# i)     = I# i
 281     toInt (J# s d)   = case (integer2Int# s d) of { n# -> I# n# }
 282
 283         -- we've got specialised quot/rem methods for Integer (see below)
 284     n `quot` d = n `quotInteger` d
 285     n `rem`  d = n `remInteger`  d
 286
 287     n `div` d   =  q  where (q,_) = divMod n d
 288     n `mod` d   =  r  where (_,r) = divMod n d
 289
 290     divMod (S# i) (S# j)
 291       = case divMod (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j)
 292     divMod i1@(J# _ _) i2@(S# _) = divMod i1 (toBig i2)
 293     divMod i1@(S# _) i2@(J# _ _) = divMod (toBig i1) i2
 294     divMod (J# s1 d1) (J# s2 d2)
 295       = case (divModInteger# s1 d1 s2 d2) of
 296           (# s3, d3, s4, d4 #)
 297             -> (J# s3 d3, J# s4 d4)
 298
 299 remInteger :: Integer -> Integer -> Integer
 300 remInteger ia 0
 301   = error "Prelude.Integral.rem{Integer}: divide by 0"
 302 remInteger (S# a) (S# b) = S# (remInt# a b)
 303 remInteger ia@(S# a) (J# sb b)
 304   = if sb ==# 1#
 305     then
 306       S# (remInt# a (word2Int# (integer2Word# sb b)))
 307     else if sb ==# -1# then
 308       S# (remInt# a (0# -# (word2Int# (integer2Word# sb b))))
 309     else if 0# <# sb then
 310       ia
 311     else
 312       S# (0# -# a)
 313 remInteger (J# sa a) (S# b)
 314   = case int2Integer# b of { (# sb, b #) ->
 315     case remInteger# sa a sb b of { (# sr, r #) ->
 316     S# (sr *# (word2Int# (integer2Word# sr r))) }}
 317 remInteger (J# sa a) (J# sb b)
 318   = case remInteger# sa a sb b of (# sr, r #) -> J# sr r
 319
 320 quotInteger :: Integer -> Integer -> Integer
 321 quotInteger ia 0
 322   = error "Prelude.Integral.quot{Integer}: divide by 0"
 323 quotInteger (S# a) (S# b) = S# (quotInt# a b)
 324 quotInteger (S# a) (J# sb b)
 325   = if sb ==# 1#
 326     then
 327       S# (quotInt# a (word2Int# (integer2Word# sb b)))
 328     else if sb ==# -1# then
 329       S# (quotInt# a (0# -# (word2Int# (integer2Word# sb b))))
 330     else
 331       zeroInteger
 332 quotInteger (J# sa a) (S# b)
 333   = case int2Integer# b of { (# sb, b #) ->
 334     case quotInteger# sa a sb b of (# sq, q #) -> J# sq q }
 335 quotInteger (J# sa a) (J# sb b)
 336   = case quotInteger# sa a sb b of (# sg, g #) -> J# sg g
 337
 338 zeroInteger :: Integer
 339 zeroInteger = S# 0#
 340
 341 ------------------------------------------------------------------------
 342 instance  Enum Integer  where
 343     succ x               = x + 1
 344     pred x               = x - 1
 345     toEnum n             =  toInteger n
 346     fromEnum n           =  toInt n
 347
 348     {-# INLINE enumFrom #-}
 349     {-# INLINE enumFromThen #-}
 350     {-# INLINE enumFromTo #-}
 351     {-# INLINE enumFromThenTo #-}
 352     enumFrom x             = build (\c _ -> enumDeltaIntegerFB   c   x 1)
 353     enumFromThen x y       = build (\c _ -> enumDeltaIntegerFB   c   x (y-x))
 354     enumFromTo x lim       = build (\c n -> enumDeltaToIntegerFB c n x 1     lim)
 355     enumFromThenTo x y lim = build (\c n -> enumDeltaToIntegerFB c n x (y-x) lim)
 356
 357 enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b
 358 enumDeltaIntegerFB c x d = x `c` enumDeltaIntegerFB c (x+d) d
 359
 360 enumDeltaIntegerList :: Integer -> Integer -> [Integer]
 361 enumDeltaIntegerList x d = x : enumDeltaIntegerList (x+d) d
 362
 363 enumDeltaToIntegerFB c n x delta lim
 364   | delta >= 0 = up_fb c n x delta lim
 365   | otherwise  = dn_fb c n x delta lim
 366
 367 enumDeltaToIntegerList x delta lim
 368   | delta >= 0 = up_list x delta lim
 369   | otherwise  = dn_list x delta lim
 370
 371 up_fb c n x delta lim = go (x::Integer)
 372                       where
 373                         go x | x > lim   = n
 374                              | otherwise = x `c` go (x+delta)
 375 dn_fb c n x delta lim = go (x::Integer)
 376                       where
 377                         go x | x < lim   = n
 378                              | otherwise = x `c` go (x+delta)
 379
 380 up_list x delta lim = go (x::Integer)
 381                     where
 382                         go x | x > lim   = []
 383                              | otherwise = x : go (x+delta)
 384 dn_list x delta lim = go (x::Integer)
 385                     where
 386                         go x | x < lim   = []
 387                              | otherwise = x : go (x+delta)
 388
 389 {-# RULES
 390 "enumDeltaInteger"      enumDeltaIntegerFB   (:)    = enumDeltaIntegerList
 391 "enumDeltaToInteger"    enumDeltaToIntegerFB (:) [] = enumDeltaToIntegerList
 392  #-}
 393 \end{code}
 394
 395 %*********************************************************
 396 %*                                                      *
 397 \subsection{Show code for Integers}
 398 %*                                                      *
 399 %*********************************************************
 400
 401 \begin{code}
 402 instance  Show Integer  where
 403     showsPrec   x = showSignedInteger x
 404     showList = showList__ (showsPrec 0)
 405
 406 showSignedInteger :: Int -> Integer -> ShowS
 407 showSignedInteger p n r
 408   | n < 0 && p > 6 = '(':jtos n (')':r)
 409   | otherwise      = jtos n r
 410
 411 jtos :: Integer -> String -> String
 412 jtos i rs
 413  | i < 0     = '-' : jtos' (-i) rs
 414  | otherwise = jtos' i rs
 415  where
 416   jtos' :: Integer -> String -> String
 417   jtos' n cs
 418    | n < 10    = chr (fromInteger n + (ord_0::Int)) : cs
 419    | otherwise = jtos' q (chr (toInt r + (ord_0::Int)) : cs)
 420     where
 421      (q,r) = n `quotRem` 10
 422
 423 ord_0 :: Num a => a
 424 ord_0 = fromInt (ord '0')
 425 \end{code}
 426
 427 %*********************************************************
 428 %*                                                      *
 429 \subsection{The @Ratio@ and @Rational@ types}
 430 %*                                                      *
 431 %*********************************************************
 432
 433 \begin{code}
 434 data  (Integral a)      => Ratio a = !a :% !a  deriving (Eq)
 435 type  Rational          =  Ratio Integer
 436
 437 {-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}
 438 (%)                     :: (Integral a) => a -> a -> Ratio a
 439 numerator, denominator  :: (Integral a) => Ratio a -> a
 440 \end{code}
 441
 442 \tr{reduce} is a subsidiary function used only in this module .
 443 It normalises a ratio by dividing both numerator and denominator by
 444 their greatest common divisor.
 445
 446 \begin{code}
 447 reduce ::  (Integral a) => a -> a -> Ratio a
 448 reduce _ 0              =  error "Ratio.%: zero denominator"
 449 reduce x y              =  (x `quot` d) :% (y `quot` d)
 450                            where d = gcd x y
 451 \end{code}
 452
 453 \begin{code}
 454 x % y                   =  reduce (x * signum y) (abs y)
 455
 456 numerator   (x :% _)    =  x
 457 denominator (_ :% y)    =  y
 458
 459 \end{code}
 460
 461 %*********************************************************
 462 %*                                                      *
 463 \subsection{Overloaded numeric functions}
 464 %*                                                      *
 465 %*********************************************************
 466
 467 \begin{code}
 468
 469 {-# SPECIALISE subtract :: Int -> Int -> Int #-}
 470 subtract        :: (Num a) => a -> a -> a
 471 subtract x y    =  y - x
 472
 473 even, odd       :: (Integral a) => a -> Bool
 474 even n          =  n `rem` 2 == 0
 475 odd             =  not . even
 476
 477 gcd             :: (Integral a) => a -> a -> a
 478 gcd 0 0         =  error "Prelude.gcd: gcd 0 0 is undefined"
 479 gcd x y         =  gcd' (abs x) (abs y)
 480                    where gcd' a 0  =  a
 481                          gcd' a b  =  gcd' b (a `rem` b)
 482
 483 {-# SPECIALISE lcm ::
 484         Int -> Int -> Int,
 485         Integer -> Integer -> Integer #-}
 486 lcm             :: (Integral a) => a -> a -> a
 487 lcm _ 0         =  0
 488 lcm 0 _         =  0
 489 lcm x y         =  abs ((x `quot` (gcd x y)) * y)
 490
 491 {-# SPECIALISE (^) ::
 492         Integer -> Integer -> Integer,
 493         Integer -> Int -> Integer,
 494         Int -> Int -> Int #-}
 495 (^)             :: (Num a, Integral b) => a -> b -> a
 496 _ ^ 0           =  1
 497 x ^ n | n > 0   =  f x (n-1) x
 498                    where f _ 0 y = y
 499                          f a d y = g a d  where
 500                                    g b i | even i  = g (b*b) (i `quot` 2)
 501                                          | otherwise = f b (i-1) (b*y)
 502 _ ^ _           = error "Prelude.^: negative exponent"
 503
 504 {- SPECIALISE (^^) ::
 505         Double -> Int -> Double,
 506         Rational -> Int -> Rational #-}
 507 (^^)            :: (Fractional a, Integral b) => a -> b -> a
 508 x ^^ n          =  if n >= 0 then x^n else recip (x^(negate n))
 509 \end{code}
 510
 511 %*********************************************************
 512 %*                                                      *
 513 \subsection{Specialized versions of gcd/lcm for Int/Integer}
 514 %*                                                      *
 515 %*********************************************************
 516
 517 \begin{code}
 518 {-# RULES
 519 "Int.gcd"      forall a b . gcd  a b = gcdInt a b
 520 "Integer.gcd"  forall a b . gcd  a b = gcdInteger  a b
 521 "Integer.lcm"  forall a b . lcm  a b = lcmInteger  a b
 522  #-}
 523
 524 gcdInt :: Int -> Int -> Int
 525 gcdInt (I# a)  (I# b)
 526   = I# (gcdInt# a b)
 527
 528 gcdInteger :: Integer -> Integer -> Integer
 529 gcdInteger (S# a) (S# b)
 530   = case gcdInt# a b of g -> S# g
 531 gcdInteger ia@(S# a) ib@(J# sb b)
 532   | a  ==# 0#  = abs ib
 533   | sb ==# 0#  = abs ia
 534   | otherwise  = case gcdIntegerInt# sb b a of g -> S# g
 535 gcdInteger ia@(J# sa a) ib@(S# b)
 536   | sa ==# 0#  = abs ib
 537   | b ==# 0#   = abs ia
 538   | otherwise  = case gcdIntegerInt# sa a b of g -> S# g
 539 gcdInteger (J# sa a) (J# sb b)
 540   = case gcdInteger# sa a sb b of (# sg, g #) -> J# sg g
 541
 542 lcmInteger :: Integer -> Integer -> Integer
 543 lcmInteger a 0
 544   = zeroInteger
 545 lcmInteger 0 b
 546   = zeroInteger
 547 lcmInteger a b
 548   = (divExact aa (gcdInteger aa ab)) * ab
 549   where aa = abs a
 550         ab = abs b
 551
 552 divExact :: Integer -> Integer -> Integer
 553 divExact (S# a) (S# b)
 554   = S# (quotInt# a b)
 555 divExact (S# a) (J# sb b)
 556   = S# (quotInt# a (sb *# (word2Int# (integer2Word# sb b))))
 557 divExact (J# sa a) (S# b)
 558   = case int2Integer# b of
 559      (# sb, b #) -> case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d
 560 divExact (J# sa a) (J# sb b)
 561   = case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d
 562 \end{code}