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 {- USING THE UNDERLYING "GMP" CODE IS DUBIOUS FOR NOW:
 280
 281     divMod (J# a1 s1 d1) (J# a2 s2 d2)
 282       = case (divModInteger# a1 s1 d1 a2 s2 d2) of
 283           Return2GMPs a3 s3 d3 a4 s4 d4
 284             -> (J# a3 s3 d3, J# a4 s4 d4)
 285 -}
 286     toInteger n      = n
 287     toInt (S# i)     = I# i
 288     toInt (J# s d)   = case (integer2Int# s d) of { n# -> I# n# }
 289
 290     -- the rest are identical to the report default methods;
 291     -- you get slightly better code if you let the compiler
 292     -- see them right here:
 293     (S# n) `quot` (S# d) = S# (n `quotInt#` d)
 294     n `quot` d  =  if d /= 0 then q else
 295                      error "Prelude.Integral.quot{Integer}: divide by 0"
 296                    where (q,_) = quotRem n d
 297
 298     (S# n) `rem` (S# d) = S# (n `remInt#` d)
 299     n `rem` d   =  if d /= 0 then r else
 300                      error "Prelude.Integral.rem{Integer}: divide by 0"
 301                    where (_,r) = quotRem n d
 302
 303     n `div` d   =  q  where (q,_) = divMod n d
 304     n `mod` d   =  r  where (_,r) = divMod n d
 305
 306     divMod (S# i) (S# j)
 307       = case divMod (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j)
 308     divMod i1@(J# _ _) i2@(S# _) = divMod i1 (toBig i2)
 309     divMod i1@(S# _) i2@(J# _ _) = divMod (toBig i1) i2
 310     divMod (J# s1 d1) (J# s2 d2)
 311       = case (divModInteger# s1 d1 s2 d2) of
 312           (# s3, d3, s4, d4 #)
 313             -> (J# s3 d3, J# s4 d4)
 314
 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
 322     {-# INLINE enumFrom #-}
 323     {-# INLINE enumFromThen #-}
 324     {-# INLINE enumFromTo #-}
 325     {-# INLINE enumFromThenTo #-}
 326     enumFrom x             = build (\c _ -> enumDeltaIntegerFB   c   x 1)
 327     enumFromThen x y       = build (\c _ -> enumDeltaIntegerFB   c   x (y-x))
 328     enumFromTo x lim       = build (\c n -> enumDeltaToIntegerFB c n x 1     lim)
 329     enumFromThenTo x y lim = build (\c n -> enumDeltaToIntegerFB c n x (y-x) lim)
 330
 331 enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b
 332 enumDeltaIntegerFB c x d = x `c` enumDeltaIntegerFB c (x+d) d
 333
 334 enumDeltaIntegerList :: Integer -> Integer -> [Integer]
 335 enumDeltaIntegerList x d = x : enumDeltaIntegerList (x+d) d
 336
 337 enumDeltaToIntegerFB c n x delta lim
 338   | delta >= 0 = up_fb c n x delta lim
 339   | otherwise  = dn_fb c n x delta lim
 340
 341 enumDeltaToIntegerList x delta lim
 342   | delta >= 0 = up_list x delta lim
 343   | otherwise  = dn_list x delta lim
 344
 345 up_fb c n x delta lim = go (x::Integer)
 346                       where
 347                         go x | x > lim   = n
 348                              | otherwise = x `c` go (x+delta)
 349 dn_fb c n x delta lim = go (x::Integer)
 350                       where
 351                         go x | x < lim   = n
 352                              | otherwise = x `c` go (x+delta)
 353
 354 up_list x delta lim = go (x::Integer)
 355                     where
 356                         go x | x > lim   = []
 357                              | otherwise = x : go (x+delta)
 358 dn_list x delta lim = go (x::Integer)
 359                     where
 360                         go x | x < lim   = []
 361                              | otherwise = x : go (x+delta)
 362
 363 {-# RULES
 364 "enumDeltaInteger"      enumDeltaIntegerFB   (:)    = enumDeltaIntegerList
 365 "enumDeltaToInteger"    enumDeltaToIntegerFB (:) [] = enumDeltaToIntegerList
 366  #-}
 367 \end{code}
 368
 369 %*********************************************************
 370 %*                                                      *
 371 \subsection{Show code for Integers}
 372 %*                                                      *
 373 %*********************************************************
 374
 375 \begin{code}
 376 instance  Show Integer  where
 377     showsPrec   x = showSignedInteger x
 378     showList = showList__ (showsPrec 0)
 379
 380 showSignedInteger :: Int -> Integer -> ShowS
 381 showSignedInteger p n r
 382   | n < 0 && p > 6 = '(':jtos n (')':r)
 383   | otherwise      = jtos n r
 384
 385 jtos :: Integer -> String -> String
 386 jtos i rs
 387  | i < 0     = '-' : jtos' (-i) rs
 388  | otherwise = jtos' i rs
 389  where
 390   jtos' :: Integer -> String -> String
 391   jtos' n cs
 392    | n < 10    = chr (fromInteger n + (ord_0::Int)) : cs
 393    | otherwise = jtos' q (chr (toInt r + (ord_0::Int)) : cs)
 394     where
 395      (q,r) = n `quotRem` 10
 396
 397 ord_0 :: Num a => a
 398 ord_0 = fromInt (ord '0')
 399 \end{code}
 400
 401 %*********************************************************
 402 %*                                                      *
 403 \subsection{The @Ratio@ and @Rational@ types}
 404 %*                                                      *
 405 %*********************************************************
 406
 407 \begin{code}
 408 data  (Integral a)      => Ratio a = !a :% !a  deriving (Eq)
 409 type  Rational          =  Ratio Integer
 410
 411 {-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}
 412 (%)                     :: (Integral a) => a -> a -> Ratio a
 413 numerator, denominator  :: (Integral a) => Ratio a -> a
 414 \end{code}
 415
 416 \tr{reduce} is a subsidiary function used only in this module .
 417 It normalises a ratio by dividing both numerator and denominator by
 418 their greatest common divisor.
 419
 420 \begin{code}
 421 reduce ::  (Integral a) => a -> a -> Ratio a
 422 reduce _ 0              =  error "Ratio.%: zero denominator"
 423 reduce x y              =  (x `quot` d) :% (y `quot` d)
 424                            where d = gcd x y
 425 \end{code}
 426
 427 \begin{code}
 428 x % y                   =  reduce (x * signum y) (abs y)
 429
 430 numerator   (x :% _)    =  x
 431 denominator (_ :% y)    =  y
 432
 433 \end{code}
 434
 435 %*********************************************************
 436 %*                                                      *
 437 \subsection{Overloaded numeric functions}
 438 %*                                                      *
 439 %*********************************************************
 440
 441 \begin{code}
 442
 443 {-# SPECIALISE subtract :: Int -> Int -> Int #-}
 444 subtract        :: (Num a) => a -> a -> a
 445 subtract x y    =  y - x
 446
 447 even, odd       :: (Integral a) => a -> Bool
 448 even n          =  n `rem` 2 == 0
 449 odd             =  not . even
 450
 451 {-# SPECIALISE gcd ::
 452         Int -> Int -> Int,
 453         Integer -> Integer -> Integer #-}
 454 gcd             :: (Integral a) => a -> a -> a
 455 gcd 0 0         =  error "Prelude.gcd: gcd 0 0 is undefined"
 456 gcd x y         =  gcd' (abs x) (abs y)
 457                    where gcd' a 0  =  a
 458                          gcd' a b  =  gcd' b (a `rem` b)
 459
 460 {-# SPECIALISE lcm ::
 461         Int -> Int -> Int,
 462         Integer -> Integer -> Integer #-}
 463 lcm             :: (Integral a) => a -> a -> a
 464 lcm _ 0         =  0
 465 lcm 0 _         =  0
 466 lcm x y         =  abs ((x `quot` (gcd x y)) * y)
 467
 468 {-# SPECIALISE (^) ::
 469         Integer -> Integer -> Integer,
 470         Integer -> Int -> Integer,
 471         Int -> Int -> Int #-}
 472 (^)             :: (Num a, Integral b) => a -> b -> a
 473 _ ^ 0           =  1
 474 x ^ n | n > 0   =  f x (n-1) x
 475                    where f _ 0 y = y
 476                          f a d y = g a d  where
 477                                    g b i | even i  = g (b*b) (i `quot` 2)
 478                                          | otherwise = f b (i-1) (b*y)
 479 _ ^ _           = error "Prelude.^: negative exponent"
 480
 481 {- SPECIALISE (^^) ::
 482         Double -> Int -> Double,
 483         Rational -> Int -> Rational #-}
 484 (^^)            :: (Fractional a, Integral b) => a -> b -> a
 485 x ^^ n          =  if n >= 0 then x^n else recip (x^(negate n))
 486 \end{code}
 487