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 instance  Ord Integer  where
 209     (S# i)     <=  (S# j)     = i <=# j
 210     (J# s d)   <=  (S# i)     = cmpIntegerInt# s d i <=# 0#
 211     (S# i)     <=  (J# s d)   = cmpIntegerInt# s d i >=# 0#
 212     (J# s1 d1) <=  (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <=# 0#
 213
 214     (S# i)     >   (S# j)     = i ># j
 215     (J# s d)   >   (S# i)     = cmpIntegerInt# s d i ># 0#
 216     (S# i)     >   (J# s d)   = cmpIntegerInt# s d i <# 0#
 217     (J# s1 d1) >   (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ># 0#
 218
 219     (S# i)     <   (S# j)     = i <# j
 220     (J# s d)   <   (S# i)     = cmpIntegerInt# s d i <# 0#
 221     (S# i)     <   (J# s d)   = cmpIntegerInt# s d i ># 0#
 222     (J# s1 d1) <   (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <# 0#
 223
 224     (S# i)     >=  (S# j)     = i >=# j
 225     (J# s d)   >=  (S# i)     = cmpIntegerInt# s d i >=# 0#
 226     (S# i)     >=  (J# s d)   = cmpIntegerInt# s d i <=# 0#
 227     (J# s1 d1) >=  (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0#
 228
 229     compare (S# i)  (S# j)
 230        | i ==# j = EQ
 231        | i <=# j = LT
 232        | otherwise = GT
 233     compare (J# s d) (S# i)
 234        = case cmpIntegerInt# s d i of { res# ->
 235          if res# <# 0# then LT else
 236          if res# ># 0# then GT else EQ
 237          }
 238     compare (S# i) (J# s d)
 239        = case cmpIntegerInt# s d i of { res# ->
 240          if res# ># 0# then LT else
 241          if res# <# 0# then GT else EQ
 242          }
 243     compare (J# s1 d1) (J# s2 d2)
 244        = case cmpInteger# s1 d1 s2 d2 of { res# ->
 245          if res# <# 0# then LT else
 246          if res# ># 0# then GT else EQ
 247          }
 248
 249 toBig (S# i) = case int2Integer# i of { (# s, d #) -> J# s d }
 250 toBig i@(J# _ _) = i
 251
 252 instance  Num Integer  where
 253     (+) i1@(S# i) i2@(S# j)
 254         = case addIntC# i j of { (# r, c #) ->
 255           if c ==# 0# then S# r
 256           else toBig i1 + toBig i2 }
 257     (+) i1@(J# _ _) i2@(S# _)   = i1 + toBig i2
 258     (+) i1@(S# _) i2@(J# _ _)   = toBig i1 + i2
 259     (+) (J# s1 d1) (J# s2 d2)
 260       = case plusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
 261
 262     (-) i1@(S# i) i2@(S# j)
 263         = case subIntC# i j of { (# r, c #) ->
 264           if c ==# 0# then S# r
 265           else toBig i1 - toBig i2 }
 266     (-) i1@(J# _ _) i2@(S# _)   = i1 - toBig i2
 267     (-) i1@(S# _) i2@(J# _ _)   = toBig i1 - i2
 268     (-) (J# s1 d1) (J# s2 d2)
 269       = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
 270
 271     (*) i1@(S# i) i2@(S# j)
 272         = case mulIntC# i j of { (# r, c #) ->
 273           if c ==# 0# then S# r
 274           else toBig i1 * toBig i2 }
 275     (*) i1@(J# _ _) i2@(S# _)   = i1 * toBig i2
 276     (*) i1@(S# _) i2@(J# _ _)   = toBig i1 * i2
 277     (*) (J# s1 d1) (J# s2 d2)
 278       = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
 279
 280     negate (S# (-2147483648#)) = 2147483648
 281     negate (S# i) = S# (negateInt# i)
 282     negate (J# s d) = J# (negateInt# s) d
 283
 284     -- ORIG: abs n = if n >= 0 then n else -n
 285
 286     abs (S# i) = case abs (I# i) of I# j -> S# j
 287     abs n@(J# s d)
 288       = if (cmpIntegerInt# s d 0#) >=# 0#
 289         then n
 290         else J# (negateInt# s) d
 291
 292     signum (S# i) = case signum (I# i) of I# j -> S# j
 293     signum (J# s d)
 294       = let
 295             cmp = cmpIntegerInt# s d 0#
 296         in
 297         if      cmp >#  0# then S# 1#
 298         else if cmp ==# 0# then S# 0#
 299         else                    S# (negateInt# 1#)
 300
 301     fromInteger x       =  x
 302
 303     fromInt (I# i)      =  S# i
 304
 305 instance  Real Integer  where
 306     toRational x        =  x % 1
 307
 308 instance  Integral Integer where
 309         -- ToDo:  a `rem`  b returns a small integer if b is small,
 310         --        a `quot` b returns a small integer if a is small.
 311     quotRem (S# i) (S# j)
 312       = case quotRem (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j)
 313     quotRem i1@(J# _ _) i2@(S# _) = quotRem i1 (toBig i2)
 314     quotRem i1@(S# _) i2@(J# _ _) = quotRem (toBig i1) i2
 315     quotRem (J# s1 d1) (J# s2 d2)
 316       = case (quotRemInteger# s1 d1 s2 d2) of
 317           (# s3, d3, s4, d4 #)
 318             -> (J# s3 d3, J# s4 d4)
 319
 320 {- USING THE UNDERLYING "GMP" CODE IS DUBIOUS FOR NOW:
 321
 322     divMod (J# a1 s1 d1) (J# a2 s2 d2)
 323       = case (divModInteger# a1 s1 d1 a2 s2 d2) of
 324           Return2GMPs a3 s3 d3 a4 s4 d4
 325             -> (J# a3 s3 d3, J# a4 s4 d4)
 326 -}
 327     toInteger n      = n
 328     toInt (S# i)     = I# i
 329     toInt (J# s d)   = case (integer2Int# s d) of { n# -> I# n# }
 330
 331     -- the rest are identical to the report default methods;
 332     -- you get slightly better code if you let the compiler
 333     -- see them right here:
 334     (S# n) `quot` (S# d) = S# (n `quotInt#` d)
 335     n `quot` d  =  if d /= 0 then q else
 336                      error "Prelude.Integral.quot{Integer}: divide by 0"
 337                    where (q,_) = quotRem n d
 338
 339     (S# n) `rem` (S# d) = S# (n `remInt#` d)
 340     n `rem` d   =  if d /= 0 then r else
 341                      error "Prelude.Integral.rem{Integer}: divide by 0"
 342                    where (_,r) = quotRem n d
 343
 344     n `div` d   =  q  where (q,_) = divMod n d
 345     n `mod` d   =  r  where (_,r) = divMod n d
 346
 347     divMod n d  =  case (quotRem n d) of { qr@(q,r) ->
 348                    if signum r == negate (signum d) then (q - 1, r+d) else qr }
 349                    -- Case-ified by WDP 94/10
 350
 351 ------------------------------------------------------------------------
 352 instance  Enum Integer  where
 353     succ x               = x + 1
 354     pred x               = x - 1
 355     toEnum n             =  toInteger n
 356     fromEnum n           =  toInt n
 357
 358     {-# INLINE enumFrom #-}
 359     {-# INLINE enumFromThen #-}
 360     {-# INLINE enumFromTo #-}
 361     {-# INLINE enumFromThenTo #-}
 362     enumFrom x             = build (\c _ -> enumDeltaIntegerFB   c   x 1)
 363     enumFromThen x y       = build (\c _ -> enumDeltaIntegerFB   c   x (y-x))
 364     enumFromTo x lim       = build (\c n -> enumDeltaToIntegerFB c n x 1     lim)
 365     enumFromThenTo x y lim = build (\c n -> enumDeltaToIntegerFB c n x (y-x) lim)
 366
 367 enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b
 368 enumDeltaIntegerFB c x d = x `c` enumDeltaIntegerFB c (x+d) d
 369
 370 enumDeltaIntegerList :: Integer -> Integer -> [Integer]
 371 enumDeltaIntegerList x d = x : enumDeltaIntegerList (x+d) d
 372
 373 enumDeltaToIntegerFB c n x delta lim
 374   | delta >= 0 = up_fb c n x delta lim
 375   | otherwise  = dn_fb c n x delta lim
 376
 377 enumDeltaToIntegerList x delta lim
 378   | delta >= 0 = up_list x delta lim
 379   | otherwise  = dn_list x delta lim
 380
 381 up_fb c n x delta lim = go (x::Integer)
 382                       where
 383                         go x | x > lim   = n
 384                              | otherwise = x `c` go (x+delta)
 385 dn_fb c n x delta lim = go (x::Integer)
 386                       where
 387                         go x | x < lim   = n
 388                              | otherwise = x `c` go (x+delta)
 389
 390 up_list x delta lim = go (x::Integer)
 391                     where
 392                         go x | x > lim   = []
 393                              | otherwise = x : go (x+delta)
 394 dn_list x delta lim = go (x::Integer)
 395                     where
 396                         go x | x < lim   = []
 397                              | otherwise = x : go (x+delta)
 398
 399 {-# RULES
 400 "enumDeltaInteger"      enumDeltaIntegerFB   (:)    = enumDeltaIntegerList
 401 "enumDeltaToInteger"    enumDeltaToIntegerFB (:) [] = enumDeltaToIntegerList
 402  #-}
 403
 404 ------------------------------------------------------------------------
 405
 406 instance  Show Integer  where
 407     showsPrec   x = showSignedInteger x
 408     showList = showList__ (showsPrec 0)
 409
 410
 411 showSignedInteger :: Int -> Integer -> ShowS
 412 showSignedInteger p n r
 413   | n < 0 && p > 6 = '(':jtos n (')':r)
 414   | otherwise      = jtos n r
 415
 416 jtos :: Integer -> String -> String
 417 jtos i rs
 418  | i < 0     = '-' : jtos' (-i) rs
 419  | otherwise = jtos' i rs
 420  where
 421   jtos' :: Integer -> String -> String
 422   jtos' n cs
 423    | n < 10    = chr (fromInteger n + (ord_0::Int)) : cs
 424    | otherwise = jtos' q (chr (toInt r + (ord_0::Int)) : cs)
 425     where
 426      (q,r) = n `quotRem` 10
 427
 428 ord_0 :: Num a => a
 429 ord_0 = fromInt (ord '0')
 430 \end{code}
 431
 432 %*********************************************************
 433 %*                                                      *
 434 \subsection{The @Ratio@ and @Rational@ types}
 435 %*                                                      *
 436 %*********************************************************
 437
 438 \begin{code}
 439 data  (Integral a)      => Ratio a = !a :% !a  deriving (Eq)
 440 type  Rational          =  Ratio Integer
 441
 442 {-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}
 443 (%)                     :: (Integral a) => a -> a -> Ratio a
 444 numerator, denominator  :: (Integral a) => Ratio a -> a
 445 \end{code}
 446
 447 \tr{reduce} is a subsidiary function used only in this module .
 448 It normalises a ratio by dividing both numerator and denominator by
 449 their greatest common divisor.
 450
 451 \begin{code}
 452 reduce ::  (Integral a) => a -> a -> Ratio a
 453 reduce _ 0              =  error "Ratio.%: zero denominator"
 454 reduce x y              =  (x `quot` d) :% (y `quot` d)
 455                            where d = gcd x y
 456 \end{code}
 457
 458 \begin{code}
 459 x % y                   =  reduce (x * signum y) (abs y)
 460
 461 numerator   (x :% _)    =  x
 462 denominator (_ :% y)    =  y
 463
 464 \end{code}
 465
 466 %*********************************************************
 467 %*                                                      *
 468 \subsection{Overloaded numeric functions}
 469 %*                                                      *
 470 %*********************************************************
 471
 472 \begin{code}
 473
 474 {-# SPECIALISE subtract :: Int -> Int -> Int #-}
 475 subtract        :: (Num a) => a -> a -> a
 476 subtract x y    =  y - x
 477
 478 even, odd       :: (Integral a) => a -> Bool
 479 even n          =  n `rem` 2 == 0
 480 odd             =  not . even
 481
 482 {-# SPECIALISE gcd ::
 483         Int -> Int -> Int,
 484         Integer -> Integer -> Integer #-}
 485 gcd             :: (Integral a) => a -> a -> a
 486 gcd 0 0         =  error "Prelude.gcd: gcd 0 0 is undefined"
 487 gcd x y         =  gcd' (abs x) (abs y)
 488                    where gcd' a 0  =  a
 489                          gcd' a b  =  gcd' b (a `rem` b)
 490
 491 {-# SPECIALISE lcm ::
 492         Int -> Int -> Int,
 493         Integer -> Integer -> Integer #-}
 494 lcm             :: (Integral a) => a -> a -> a
 495 lcm _ 0         =  0
 496 lcm 0 _         =  0
 497 lcm x y         =  abs ((x `quot` (gcd x y)) * y)
 498
 499 {-# SPECIALISE (^) ::
 500         Integer -> Integer -> Integer,
 501         Integer -> Int -> Integer,
 502         Int -> Int -> Int #-}
 503 (^)             :: (Num a, Integral b) => a -> b -> a
 504 _ ^ 0           =  1
 505 x ^ n | n > 0   =  f x (n-1) x
 506                    where f _ 0 y = y
 507                          f a d y = g a d  where
 508                                    g b i | even i  = g (b*b) (i `quot` 2)
 509                                          | otherwise = f b (i-1) (b*y)
 510 _ ^ _           = error "Prelude.^: negative exponent"
 511
 512 {- SPECIALISE (^^) ::
 513         Double -> Int -> Double,
 514         Rational -> Int -> Rational #-}
 515 (^^)            :: (Fractional a, Integral b) => a -> b -> a
 516 x ^^ n          =  if n >= 0 then x^n else recip (x^(negate n))
 517 \end{code}
 518