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 PrelBase
  13 import Ix
  14 import {-# SOURCE #-} PrelErr
  15
  16 infixr 8  ^, ^^, **
  17 infixl 7  %, /, `quot`, `rem`, `div`, `mod`
  18 \end{code}
  19
  20 %*********************************************************
  21 %*                                                      *
  22 \subsection{Standard numeric classes}
  23 %*                                                      *
  24 %*********************************************************
  25
  26 \begin{code}
  27 class  (Num a, Ord a) => Real a  where
  28     toRational          ::  a -> Rational
  29
  30 class  (Real a, Enum a) => Integral a  where
  31     quot, rem, div, mod :: a -> a -> a
  32     quotRem, divMod     :: a -> a -> (a,a)
  33     toInteger           :: a -> Integer
  34     toInt               :: a -> Int -- partain: Glasgow extension
  35
  36     n `quot` d          =  q  where (q,_) = quotRem n d
  37     n `rem` d           =  r  where (_,r) = quotRem n d
  38     n `div` d           =  q  where (q,_) = divMod n d
  39     n `mod` d           =  r  where (_,r) = divMod n d
  40     divMod n d          =  if signum r == negate (signum d) then (q-1, r+d) else qr
  41                            where qr@(q,r) = quotRem n d
  42
  43 class  (Num a) => Fractional a  where
  44     (/)                 :: a -> a -> a
  45     recip               :: a -> a
  46     fromRational        :: Rational -> a
  47
  48     recip x             =  1 / x
  49     x / y               = x * recip y
  50
  51 class  (Fractional a) => Floating a  where
  52     pi                  :: a
  53     exp, log, sqrt      :: a -> a
  54     (**), logBase       :: a -> a -> a
  55     sin, cos, tan       :: a -> a
  56     asin, acos, atan    :: a -> a
  57     sinh, cosh, tanh    :: a -> a
  58     asinh, acosh, atanh :: a -> a
  59
  60     x ** y              =  exp (log x * y)
  61     logBase x y         =  log y / log x
  62     sqrt x              =  x ** 0.5
  63     tan  x              =  sin  x / cos  x
  64     tanh x              =  sinh x / cosh x
  65
  66 class  (Real a, Fractional a) => RealFrac a  where
  67     properFraction      :: (Integral b) => a -> (b,a)
  68     truncate, round     :: (Integral b) => a -> b
  69     ceiling, floor      :: (Integral b) => a -> b
  70
  71     truncate x          =  m  where (m,_) = properFraction x
  72
  73     round x             =  let (n,r) = properFraction x
  74                                m     = if r < 0 then n - 1 else n + 1
  75                            in case signum (abs r - 0.5) of
  76                                 -1 -> n
  77                                 0  -> if even n then n else m
  78                                 1  -> m
  79
  80     ceiling x           =  if r > 0 then n + 1 else n
  81                            where (n,r) = properFraction x
  82
  83     floor x             =  if r < 0 then n - 1 else n
  84                            where (n,r) = properFraction x
  85
  86 class  (RealFrac a, Floating a) => RealFloat a  where
  87     floatRadix          :: a -> Integer
  88     floatDigits         :: a -> Int
  89     floatRange          :: a -> (Int,Int)
  90     decodeFloat         :: a -> (Integer,Int)
  91     encodeFloat         :: Integer -> Int -> a
  92     exponent            :: a -> Int
  93     significand         :: a -> a
  94     scaleFloat          :: Int -> a -> a
  95     isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE
  96                         :: a -> Bool
  97     atan2               :: a -> a -> a
  98
  99
 100     exponent x          =  if m == 0 then 0 else n + floatDigits x
 101                            where (m,n) = decodeFloat x
 102
 103     significand x       =  encodeFloat m (negate (floatDigits x))
 104                            where (m,_) = decodeFloat x
 105
 106     scaleFloat k x      =  encodeFloat m (n+k)
 107                            where (m,n) = decodeFloat x
 108
 109     atan2 y x
 110       | x > 0            =  atan (y/x)
 111       | x == 0 && y > 0  =  pi/2
 112       | x <  0 && y > 0  =  pi + atan (y/x)
 113       |(x <= 0 && y < 0)            ||
 114        (x <  0 && isNegativeZero y) ||
 115        (isNegativeZero x && isNegativeZero y)
 116                          = -atan2 (-y) x
 117       | y == 0 && (x < 0 || isNegativeZero x)
 118                           =  pi    -- must be after the previous test on zero y
 119       | x==0 && y==0      =  y     -- must be after the other double zero tests
 120       | otherwise         =  x + y -- x or y is a NaN, return a NaN (via +)
 121
 122 \end{code}
 123
 124 %*********************************************************
 125 %*                                                      *
 126 \subsection{Instances for @Int@}
 127 %*                                                      *
 128 %*********************************************************
 129
 130 \begin{code}
 131 instance  Real Int  where
 132     toRational x        =  toInteger x % 1
 133
 134 instance  Integral Int  where
 135     a@(I# _) `quotRem` b@(I# _) = (a `quotInt` b, a `remInt` b)
 136     -- OK, so I made it a little stricter.  Shoot me.  (WDP 94/10)
 137
 138     -- Following chks for zero divisor are non-standard (WDP)
 139     a `quot` b  =  if b /= 0
 140                    then a `quotInt` b
 141                    else error "Prelude.Integral.quot{Int}: divide by 0"
 142     a `rem` b   =  if b /= 0
 143                    then a `remInt` b
 144                    else error "Prelude.Integral.rem{Int}: divide by 0"
 145
 146     x `div` y = if x > 0 && y < 0       then quotInt (x-y-1) y
 147                 else if x < 0 && y > 0  then quotInt (x-y+1) y
 148                 else quotInt x y
 149     x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then
 150                     if r/=0 then r+y else 0
 151                 else
 152                     r
 153               where r = remInt x y
 154
 155     divMod x@(I# _) y@(I# _) = (x `div` y, x `mod` y)
 156     -- Stricter.  Sorry if you don't like it.  (WDP 94/10)
 157
 158 --OLD:   even x = eqInt (x `mod` 2) 0
 159 --OLD:   odd x  = neInt (x `mod` 2) 0
 160
 161     toInteger (I# i)  = int2Integer i  -- give back a full-blown Integer
 162     toInt x           = x
 163
 164 \end{code}
 165
 166 %*********************************************************
 167 %*                                                      *
 168 \subsection{Instances for @Integer@}
 169 %*                                                      *
 170 %*********************************************************
 171
 172 \begin{code}
 173 instance  Ord Integer  where
 174     (S# i)     <=  (S# j)     = i <=# j
 175     (J# s d)   <=  (S# i)     = cmpIntegerInt# s d i <=# 0#
 176     (S# i)     <=  (J# s d)   = cmpIntegerInt# s d i >=# 0#
 177     (J# s1 d1) <=  (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <=# 0#
 178
 179     (S# i)     >   (S# j)     = i ># j
 180     (J# s d)   >   (S# i)     = cmpIntegerInt# s d i ># 0#
 181     (S# i)     >   (J# s d)   = cmpIntegerInt# s d i <# 0#
 182     (J# s1 d1) >   (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ># 0#
 183
 184     (S# i)     <   (S# j)     = i <# j
 185     (J# s d)   <   (S# i)     = cmpIntegerInt# s d i <# 0#
 186     (S# i)     <   (J# s d)   = cmpIntegerInt# s d i ># 0#
 187     (J# s1 d1) <   (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <# 0#
 188
 189     (S# i)     >=  (S# j)     = i >=# j
 190     (J# s d)   >=  (S# i)     = cmpIntegerInt# s d i >=# 0#
 191     (S# i)     >=  (J# s d)   = cmpIntegerInt# s d i <=# 0#
 192     (J# s1 d1) >=  (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0#
 193
 194     compare (S# i)  (S# j)
 195        | i ==# j = EQ
 196        | i <=# j = LT
 197        | otherwise = GT
 198     compare (J# s d) (S# i)
 199        = case cmpIntegerInt# s d i of { res# ->
 200          if res# <# 0# then LT else
 201          if res# ># 0# then GT else EQ
 202          }
 203     compare (S# i) (J# s d)
 204        = case cmpIntegerInt# s d i of { res# ->
 205          if res# ># 0# then LT else
 206          if res# <# 0# then GT else EQ
 207          }
 208     compare (J# s1 d1) (J# s2 d2)
 209        = case cmpInteger# s1 d1 s2 d2 of { res# ->
 210          if res# <# 0# then LT else
 211          if res# ># 0# then GT else EQ
 212          }
 213
 214 toBig (S# i) = case int2Integer# i of { (# s, d #) -> J# s d }
 215 toBig i@(J# s d) = i
 216
 217 instance  Num Integer  where
 218     (+) i1@(S# i) i2@(S# j)
 219         = case addIntC# i j of { (# r, c #) ->
 220           if c ==# 0# then S# r
 221           else toBig i1 + toBig i2 }
 222     (+) i1@(J# s d) i2@(S# i)   = i1 + toBig i2
 223     (+) i1@(S# i) i2@(J# s d)   = toBig i1 + i2
 224     (+) (J# s1 d1) (J# s2 d2)
 225       = case plusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
 226
 227     (-) i1@(S# i) i2@(S# j)
 228         = case subIntC# i j of { (# r, c #) ->
 229           if c ==# 0# then S# r
 230           else toBig i1 - toBig i2 }
 231     (-) i1@(J# s d) i2@(S# i)   = i1 - toBig i2
 232     (-) i1@(S# i) i2@(J# s d)   = toBig i1 - i2
 233     (-) (J# s1 d1) (J# s2 d2)
 234       = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
 235
 236     (*) i1@(S# i) i2@(S# j)
 237         = case mulIntC# i j of { (# r, c #) ->
 238           if c ==# 0# then S# r
 239           else toBig i1 * toBig i2 }
 240     (*) i1@(J# s d) i2@(S# i)   = i1 * toBig i2
 241     (*) i1@(S# i) i2@(J# s d)   = toBig i1 * i2
 242     (*) (J# s1 d1) (J# s2 d2)
 243       = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
 244
 245     negate i@(S# (-2147483648#)) = 2147483648
 246     negate (S# i) = S# (negateInt# i)
 247     negate (J# s d) = J# (negateInt# s) d
 248
 249     -- ORIG: abs n = if n >= 0 then n else -n
 250
 251     abs (S# i) = case abs (I# i) of I# j -> S# j
 252     abs n@(J# s d)
 253       = if (cmpIntegerInt# s d 0#) >=# 0#
 254         then n
 255         else J# (negateInt# s) d
 256
 257     signum (S# i) = case signum (I# i) of I# j -> S# j
 258     signum (J# s d)
 259       = let
 260             cmp = cmpIntegerInt# s d 0#
 261         in
 262         if      cmp >#  0# then S# 1#
 263         else if cmp ==# 0# then S# 0#
 264         else                    S# (negateInt# 1#)
 265
 266     fromInteger x       =  x
 267
 268     fromInt (I# i)      =  S# i
 269
 270 instance  Real Integer  where
 271     toRational x        =  x % 1
 272
 273 instance  Integral Integer where
 274         -- ToDo:  a `rem`  b returns a small integer if b is small,
 275         --        a `quot` b returns a small integer if a is small.
 276     quotRem (S# i) (S# j)
 277       = case quotRem (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j)
 278     quotRem i1@(J# s d) i2@(S# i) = quotRem i1 (toBig i2)
 279     quotRem i1@(S# i) i2@(J# s d) = quotRem (toBig i1) i2
 280     quotRem (J# s1 d1) (J# s2 d2)
 281       = case (quotRemInteger# s1 d1 s2 d2) of
 282           (# s3, d3, s4, d4 #)
 283             -> (J# s3 d3, J# s4 d4)
 284
 285 {- USING THE UNDERLYING "GMP" CODE IS DUBIOUS FOR NOW:
 286
 287     divMod (J# a1 s1 d1) (J# a2 s2 d2)
 288       = case (divModInteger# a1 s1 d1 a2 s2 d2) of
 289           Return2GMPs a3 s3 d3 a4 s4 d4
 290             -> (J# a3 s3 d3, J# a4 s4 d4)
 291 -}
 292     toInteger n      = n
 293     toInt (S# i)     = I# i
 294     toInt (J# s d)   = case (integer2Int# s d) of { n# -> I# n# }
 295
 296     -- the rest are identical to the report default methods;
 297     -- you get slightly better code if you let the compiler
 298     -- see them right here:
 299     (S# n) `quot` (S# d) = S# (n `quotInt#` d)
 300     n `quot` d  =  if d /= 0 then q else
 301                      error "Prelude.Integral.quot{Integer}: divide by 0"
 302                    where (q,_) = quotRem n d
 303
 304     (S# n) `rem` (S# d) = S# (n `remInt#` d)
 305     n `rem` d   =  if d /= 0 then r else
 306                      error "Prelude.Integral.rem{Integer}: divide by 0"
 307                    where (_,r) = quotRem n d
 308
 309     n `div` d   =  q  where (q,_) = divMod n d
 310     n `mod` d   =  r  where (_,r) = divMod n d
 311
 312     divMod n d  =  case (quotRem n d) of { qr@(q,r) ->
 313                    if signum r == negate (signum d) then (q - 1, r+d) else qr }
 314                    -- Case-ified by WDP 94/10
 315
 316 instance  Enum Integer  where
 317     succ x               = x + 1
 318     pred x               = x - 1
 319     toEnum n             =  toInteger n
 320     fromEnum n           =  toInt n
 321     enumFrom n           =  n : enumFrom (n + 1)
 322     enumFromThen e1 e2   =  en' e1 (e2 - e1)
 323                             where en' a b = a : en' (a + b) b
 324     enumFromTo n m
 325       | n <= m           =  takeWhile (<= m) (enumFrom n)
 326       | otherwise        =  []
 327     enumFromThenTo n m p =  takeWhile pred   (enumFromThen n m)
 328             where
 329              pred | m >= n    = (<= p)
 330                   | otherwise = (>= p)
 331
 332 instance  Show Integer  where
 333     showsPrec   x = showSignedInteger x
 334     showList = showList__ (showsPrec 0)
 335
 336
 337 instance  Ix Integer  where
 338     range (m,n)
 339       | m <= n          =  [m..n]
 340       | otherwise       =  []
 341
 342     index b@(m,_) i
 343         | inRange b i   =  fromInteger (i - m)
 344         | otherwise     =  indexIntegerError i b
 345     inRange (m,n) i     =  m <= i && i <= n
 346
 347 -- Sigh, really want to use helper function in Ix, but
 348 -- module deps. are too painful.
 349 {-# NOINLINE indexIntegerError #-}
 350 indexIntegerError :: Integer -> (Integer,Integer) -> a
 351 indexIntegerError i rng
 352   = error (showString "Ix{Integer}.index: Index " .
 353            showParen True (showsPrec 0 i) .
 354            showString " out of range " $
 355            showParen True (showsPrec 0 rng) "")
 356
 357 showSignedInteger :: Int -> Integer -> ShowS
 358 showSignedInteger p n r
 359   | n < 0 && p > 6 = '(':jtos n (')':r)
 360   | otherwise      = jtos n r
 361
 362 jtos :: Integer -> String -> String
 363 jtos i rs
 364  | i < 0     = '-' : jtos' (-i) rs
 365  | otherwise = jtos' i rs
 366  where
 367   jtos' :: Integer -> String -> String
 368   jtos' n cs
 369    | n < 10    = chr (fromInteger n + (ord_0::Int)) : cs
 370    | otherwise = jtos' q (chr (toInt r + (ord_0::Int)) : cs)
 371     where
 372      (q,r) = n `quotRem` 10
 373 \end{code}
 374
 375 %*********************************************************
 376 %*                                                      *
 377 \subsection{The @Ratio@ and @Rational@ types}
 378 %*                                                      *
 379 %*********************************************************
 380
 381 \begin{code}
 382 data  (Integral a)      => Ratio a = !a :% !a  deriving (Eq)
 383 type  Rational          =  Ratio Integer
 384
 385 {-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}
 386 (%)                     :: (Integral a) => a -> a -> Ratio a
 387 numerator, denominator  :: (Integral a) => Ratio a -> a
 388 \end{code}
 389
 390 \tr{reduce} is a subsidiary function used only in this module .
 391 It normalises a ratio by dividing both numerator and denominator by
 392 their greatest common divisor.
 393
 394 \begin{code}
 395 reduce ::  (Integral a) => a -> a -> Ratio a
 396 reduce _ 0              =  error "Ratio.%: zero denominator"
 397 reduce x y              =  (x `quot` d) :% (y `quot` d)
 398                            where d = gcd x y
 399 \end{code}
 400
 401 \begin{code}
 402 x % y                   =  reduce (x * signum y) (abs y)
 403
 404 numerator   (x :% _)    =  x
 405 denominator (_ :% y)    =  y
 406
 407 \end{code}
 408
 409 %*********************************************************
 410 %*                                                      *
 411 \subsection{Overloaded numeric functions}
 412 %*                                                      *
 413 %*********************************************************
 414
 415 \begin{code}
 416 even, odd       :: (Integral a) => a -> Bool
 417 even n          =  n `rem` 2 == 0
 418 odd             =  not . even
 419
 420 {-# SPECIALISE gcd ::
 421         Int -> Int -> Int,
 422         Integer -> Integer -> Integer #-}
 423 gcd             :: (Integral a) => a -> a -> a
 424 gcd 0 0         =  error "Prelude.gcd: gcd 0 0 is undefined"
 425 gcd x y         =  gcd' (abs x) (abs y)
 426                    where gcd' a 0  =  a
 427                          gcd' a b  =  gcd' b (a `rem` b)
 428
 429 {-# SPECIALISE lcm ::
 430         Int -> Int -> Int,
 431         Integer -> Integer -> Integer #-}
 432 lcm             :: (Integral a) => a -> a -> a
 433 lcm _ 0         =  0
 434 lcm 0 _         =  0
 435 lcm x y         =  abs ((x `quot` (gcd x y)) * y)
 436
 437 {-# SPECIALISE (^) ::
 438         Integer -> Integer -> Integer,
 439         Integer -> Int -> Integer,
 440         Int -> Int -> Int #-}
 441 (^)             :: (Num a, Integral b) => a -> b -> a
 442 _ ^ 0           =  1
 443 x ^ n | n > 0   =  f x (n-1) x
 444                    where f _ 0 y = y
 445                          f a d y = g a d  where
 446                                    g b i | even i  = g (b*b) (i `quot` 2)
 447                                          | otherwise = f b (i-1) (b*y)
 448 _ ^ _           = error "Prelude.^: negative exponent"
 449
 450 {- SPECIALISE (^^) ::
 451         Double -> Int -> Double,
 452         Rational -> Int -> Rational #-}
 453 (^^)            :: (Fractional a, Integral b) => a -> b -> a
 454 x ^^ n          =  if n >= 0 then x^n else recip (x^(negate n))
 455
 456 \end{code}
 457