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 (S# i) = S# (negateInt# i)
 246     negate (J# s d) = J# (negateInt# s) d
 247
 248     -- ORIG: abs n = if n >= 0 then n else -n
 249
 250     abs (S# i) = case abs (I# i) of I# j -> S# j
 251     abs n@(J# s d)
 252       = if (cmpIntegerInt# s d 0#) >=# 0#
 253         then n
 254         else J# (negateInt# s) d
 255
 256     signum (S# i) = case signum (I# i) of I# j -> S# j
 257     signum (J# s d)
 258       = let
 259             cmp = cmpIntegerInt# s d 0#
 260         in
 261         if      cmp >#  0# then S# 1#
 262         else if cmp ==# 0# then S# 0#
 263         else                    S# (negateInt# 1#)
 264
 265     fromInteger x       =  x
 266
 267     fromInt (I# i)      =  S# i
 268
 269 instance  Real Integer  where
 270     toRational x        =  x % 1
 271
 272 instance  Integral Integer where
 273         -- ToDo:  a `rem`  b returns a small integer if b is small,
 274         --        a `quot` b returns a small integer if a is small.
 275     quotRem (S# i) (S# j)
 276       = case quotRem (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j)
 277     quotRem i1@(J# s d) i2@(S# i) = quotRem i1 (toBig i2)
 278     quotRem i1@(S# i) i2@(J# s d) = quotRem (toBig i1) i2
 279     quotRem (J# s1 d1) (J# s2 d2)
 280       = case (quotRemInteger# s1 d1 s2 d2) of
 281           (# s3, d3, s4, d4 #)
 282             -> (J# s3 d3, J# s4 d4)
 283
 284 {- USING THE UNDERLYING "GMP" CODE IS DUBIOUS FOR NOW:
 285
 286     divMod (J# a1 s1 d1) (J# a2 s2 d2)
 287       = case (divModInteger# a1 s1 d1 a2 s2 d2) of
 288           Return2GMPs a3 s3 d3 a4 s4 d4
 289             -> (J# a3 s3 d3, J# a4 s4 d4)
 290 -}
 291     toInteger n      = n
 292     toInt (S# i)     = I# i
 293     toInt (J# s d)   = case (integer2Int# s d) of { n# -> I# n# }
 294
 295     -- the rest are identical to the report default methods;
 296     -- you get slightly better code if you let the compiler
 297     -- see them right here:
 298     (S# n) `quot` (S# d) = S# (n `quotInt#` d)
 299     n `quot` d  =  if d /= 0 then q else
 300                      error "Prelude.Integral.quot{Integer}: divide by 0"
 301                    where (q,_) = quotRem n d
 302
 303     (S# n) `rem` (S# d) = S# (n `remInt#` d)
 304     n `rem` d   =  if d /= 0 then r else
 305                      error "Prelude.Integral.rem{Integer}: divide by 0"
 306                    where (_,r) = quotRem n d
 307
 308     n `div` d   =  q  where (q,_) = divMod n d
 309     n `mod` d   =  r  where (_,r) = divMod n d
 310
 311     divMod n d  =  case (quotRem n d) of { qr@(q,r) ->
 312                    if signum r == negate (signum d) then (q - 1, r+d) else qr }
 313                    -- Case-ified by WDP 94/10
 314
 315 instance  Enum Integer  where
 316     succ x               = x + 1
 317     pred x               = x - 1
 318     toEnum n             =  toInteger n
 319     fromEnum n           =  toInt n
 320     enumFrom n           =  n : enumFrom (n + 1)
 321     enumFromThen e1 e2   =  en' e1 (e2 - e1)
 322                             where en' a b = a : en' (a + b) b
 323     enumFromTo n m
 324       | n <= m           =  takeWhile (<= m) (enumFrom n)
 325       | otherwise        =  []
 326     enumFromThenTo n m p =  takeWhile pred   (enumFromThen n m)
 327             where
 328              pred | m >= n    = (<= p)
 329                   | otherwise = (>= p)
 330
 331 instance  Show Integer  where
 332     showsPrec   x = showSignedInteger x
 333     showList = showList__ (showsPrec 0)
 334
 335
 336 instance  Ix Integer  where
 337     range (m,n)
 338       | m <= n          =  [m..n]
 339       | otherwise       =  []
 340
 341     index b@(m,_) i
 342         | inRange b i   =  fromInteger (i - m)
 343         | otherwise     =  indexIntegerError i b
 344     inRange (m,n) i     =  m <= i && i <= n
 345
 346 -- Sigh, really want to use helper function in Ix, but
 347 -- module deps. are too painful.
 348 {-# NOINLINE indexIntegerError #-}
 349 indexIntegerError :: Integer -> (Integer,Integer) -> a
 350 indexIntegerError i rng
 351   = error (showString "Ix{Integer}.index: Index " .
 352            showParen True (showsPrec 0 i) .
 353            showString " out of range " $
 354            showParen True (showsPrec 0 rng) "")
 355
 356 showSignedInteger :: Int -> Integer -> ShowS
 357 showSignedInteger p n r
 358   | n < 0 && p > 6 = '(':jtos n (')':r)
 359   | otherwise      = jtos n r
 360
 361 jtos :: Integer -> String -> String
 362 jtos i rs
 363  | i < 0     = '-' : jtos' (-i) rs
 364  | otherwise = jtos' i rs
 365  where
 366   jtos' :: Integer -> String -> String
 367   jtos' n cs
 368    | n < 10    = chr (fromInteger n + (ord_0::Int)) : cs
 369    | otherwise = jtos' q (chr (toInt r + (ord_0::Int)) : cs)
 370     where
 371      (q,r) = n `quotRem` 10
 372 \end{code}
 373
 374 %*********************************************************
 375 %*                                                      *
 376 \subsection{The @Ratio@ and @Rational@ types}
 377 %*                                                      *
 378 %*********************************************************
 379
 380 \begin{code}
 381 data  (Integral a)      => Ratio a = !a :% !a  deriving (Eq)
 382 type  Rational          =  Ratio Integer
 383
 384 {-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}
 385 (%)                     :: (Integral a) => a -> a -> Ratio a
 386 numerator, denominator  :: (Integral a) => Ratio a -> a
 387 \end{code}
 388
 389 \tr{reduce} is a subsidiary function used only in this module .
 390 It normalises a ratio by dividing both numerator and denominator by
 391 their greatest common divisor.
 392
 393 \begin{code}
 394 reduce ::  (Integral a) => a -> a -> Ratio a
 395 reduce _ 0              =  error "Ratio.%: zero denominator"
 396 reduce x y              =  (x `quot` d) :% (y `quot` d)
 397                            where d = gcd x y
 398 \end{code}
 399
 400 \begin{code}
 401 x % y                   =  reduce (x * signum y) (abs y)
 402
 403 numerator   (x :% _)    =  x
 404 denominator (_ :% y)    =  y
 405
 406 \end{code}
 407
 408 %*********************************************************
 409 %*                                                      *
 410 \subsection{Overloaded numeric functions}
 411 %*                                                      *
 412 %*********************************************************
 413
 414 \begin{code}
 415 even, odd       :: (Integral a) => a -> Bool
 416 even n          =  n `rem` 2 == 0
 417 odd             =  not . even
 418
 419 {-# SPECIALISE gcd ::
 420         Int -> Int -> Int,
 421         Integer -> Integer -> Integer #-}
 422 gcd             :: (Integral a) => a -> a -> a
 423 gcd 0 0         =  error "Prelude.gcd: gcd 0 0 is undefined"
 424 gcd x y         =  gcd' (abs x) (abs y)
 425                    where gcd' a 0  =  a
 426                          gcd' a b  =  gcd' b (a `rem` b)
 427
 428 {-# SPECIALISE lcm ::
 429         Int -> Int -> Int,
 430         Integer -> Integer -> Integer #-}
 431 lcm             :: (Integral a) => a -> a -> a
 432 lcm _ 0         =  0
 433 lcm 0 _         =  0
 434 lcm x y         =  abs ((x `quot` (gcd x y)) * y)
 435
 436 {-# SPECIALISE (^) ::
 437         Integer -> Integer -> Integer,
 438         Integer -> Int -> Integer,
 439         Int -> Int -> Int #-}
 440 (^)             :: (Num a, Integral b) => a -> b -> a
 441 _ ^ 0           =  1
 442 x ^ n | n > 0   =  f x (n-1) x
 443                    where f _ 0 y = y
 444                          f a d y = g a d  where
 445                                    g b i | even i  = g (b*b) (i `quot` 2)
 446                                          | otherwise = f b (i-1) (b*y)
 447 _ ^ _           = error "Prelude.^: negative exponent"
 448
 449 {- SPECIALISE (^^) ::
 450         Double -> Int -> Double,
 451         Rational -> Int -> Rational #-}
 452 (^^)            :: (Fractional a, Integral b) => a -> b -> a
 453 x ^^ n          =  if n >= 0 then x^n else recip (x^(negate n))
 454
 455 \end{code}
 456