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     (J# a1 s1 d1) <= (J# a2 s2 d2)
 175       = (cmpInteger# a1 s1 d1 a2 s2 d2) <=# 0#
 176
 177     (J# a1 s1 d1) <  (J# a2 s2 d2)
 178       = (cmpInteger# a1 s1 d1 a2 s2 d2) <# 0#
 179
 180     (J# a1 s1 d1) >= (J# a2 s2 d2)
 181       = (cmpInteger# a1 s1 d1 a2 s2 d2) >=# 0#
 182
 183     (J# a1 s1 d1) >  (J# a2 s2 d2)
 184       = (cmpInteger# a1 s1 d1 a2 s2 d2) ># 0#
 185
 186     x@(J# a1 s1 d1) `max` y@(J# a2 s2 d2)
 187       = if ((cmpInteger# a1 s1 d1 a2 s2 d2) ># 0#) then x else y
 188
 189     x@(J# a1 s1 d1) `min` y@(J# a2 s2 d2)
 190       = if ((cmpInteger# a1 s1 d1 a2 s2 d2) <# 0#) then x else y
 191
 192     compare (J# a1 s1 d1) (J# a2 s2 d2)
 193        = case cmpInteger# a1 s1 d1 a2 s2 d2 of { res# ->
 194          if res# <# 0# then LT else
 195          if res# ># 0# then GT else EQ
 196          }
 197
 198 instance  Num Integer  where
 199     (+) (J# a1 s1 d1) (J# a2 s2 d2)
 200       = case plusInteger# a1 s1 d1 a2 s2 d2 of (# a, s, d #) -> J# a s d
 201
 202     (-) (J# a1 s1 d1) (J# a2 s2 d2)
 203       = case minusInteger# a1 s1 d1 a2 s2 d2 of (# a, s, d #) -> J# a s d
 204
 205     negate (J# a s d)
 206       = case negateInteger# a s d of (# a1, s1, d1 #) -> J# a1 s1 d1
 207
 208     (*) (J# a1 s1 d1) (J# a2 s2 d2)
 209       = case timesInteger# a1 s1 d1 a2 s2 d2 of (# a, s, d #) -> J# a s d
 210
 211     -- ORIG: abs n = if n >= 0 then n else -n
 212
 213     abs n@(J# a1 s1 d1)
 214       = case 0 of { J# a2 s2 d2 ->
 215         if (cmpInteger# a1 s1 d1 a2 s2 d2) >=# 0#
 216         then n
 217         else case negateInteger# a1 s1 d1 of (# a, s, d #) -> J# a s d
 218         }
 219
 220     signum (J# a1 s1 d1)
 221       = case 0 of { J# a2 s2 d2 ->
 222         let
 223             cmp = cmpInteger# a1 s1 d1 a2 s2 d2
 224         in
 225         if      cmp >#  0# then 1
 226         else if cmp ==# 0# then 0
 227         else                    (negate 1)
 228         }
 229
 230     fromInteger x       =  x
 231
 232     fromInt (I# i)      =  int2Integer i
 233
 234 instance  Real Integer  where
 235     toRational x        =  x % 1
 236
 237 instance  Integral Integer where
 238     quotRem (J# a1 s1 d1) (J# a2 s2 d2)
 239       = case (quotRemInteger# a1 s1 d1 a2 s2 d2) of
 240           (# a3, s3, d3, a4, s4, d4 #)
 241             -> (J# a3 s3 d3, J# a4 s4 d4)
 242
 243 {- USING THE UNDERLYING "GMP" CODE IS DUBIOUS FOR NOW:
 244
 245     divMod (J# a1 s1 d1) (J# a2 s2 d2)
 246       = case (divModInteger# a1 s1 d1 a2 s2 d2) of
 247           Return2GMPs a3 s3 d3 a4 s4 d4
 248             -> (J# a3 s3 d3, J# a4 s4 d4)
 249 -}
 250     toInteger n      = n
 251     toInt (J# a s d) = case (integer2Int# a s d) of { n# -> I# n# }
 252
 253     -- the rest are identical to the report default methods;
 254     -- you get slightly better code if you let the compiler
 255     -- see them right here:
 256     n `quot` d  =  if d /= 0 then q else
 257                      error "Prelude.Integral.quot{Integer}: divide by 0"
 258                    where (q,_) = quotRem n d
 259     n `rem` d   =  if d /= 0 then r else
 260                      error "Prelude.Integral.rem{Integer}: divide by 0"
 261                    where (_,r) = quotRem n d
 262     n `div` d   =  q  where (q,_) = divMod n d
 263     n `mod` d   =  r  where (_,r) = divMod n d
 264
 265     divMod n d  =  case (quotRem n d) of { qr@(q,r) ->
 266                    if signum r == negate (signum d) then (q - 1, r+d) else qr }
 267                    -- Case-ified by WDP 94/10
 268
 269 instance  Enum Integer  where
 270     succ x               = x + 1
 271     pred x               = x - 1
 272     toEnum n             =  toInteger n
 273     fromEnum n           =  toInt n
 274     enumFrom n           =  n : enumFrom (n + 1)
 275     enumFromThen e1 e2   =  en' e1 (e2 - e1)
 276                             where en' a b = a : en' (a + b) b
 277     enumFromTo n m
 278       | n <= m           =  takeWhile (<= m) (enumFrom n)
 279       | otherwise        =  takeWhile (>= m) (enumFromThen n (n-1))
 280     enumFromThenTo n m p =  takeWhile pred   (enumFromThen n m)
 281             where
 282              pred | m >= n    = (<= p)
 283                   | otherwise = (>= p)
 284
 285 instance  Show Integer  where
 286     showsPrec   x = showSignedInteger x
 287     showList = showList__ (showsPrec 0)
 288
 289
 290 instance  Ix Integer  where
 291     range (m,n)
 292       | m <= n          =  [m..n]
 293       | otherwise       =  []
 294
 295     index b@(m,_) i
 296         | inRange b i   =  fromInteger (i - m)
 297         | otherwise     =  indexIntegerError i b
 298     inRange (m,n) i     =  m <= i && i <= n
 299
 300 -- Sigh, really want to use helper function in Ix, but
 301 -- module deps. are too painful.
 302 {-# NOINLINE indexIntegerError #-}
 303 indexIntegerError :: Integer -> (Integer,Integer) -> a
 304 indexIntegerError i rng
 305   = error (showString "Ix{Integer}.index: Index " .
 306            showParen True (showsPrec 0 i) .
 307            showString " out of range " $
 308            showParen True (showsPrec 0 rng) "")
 309
 310 showSignedInteger :: Int -> Integer -> ShowS
 311 showSignedInteger p n r
 312   | n < 0 && p > 6 = '(':jtos n (')':r)
 313   | otherwise      = jtos n r
 314
 315 jtos :: Integer -> String -> String
 316 jtos i rs
 317  | i < 0     = '-' : jtos' (-i) rs
 318  | otherwise = jtos' i rs
 319  where
 320   jtos' :: Integer -> String -> String
 321   jtos' n cs
 322    | n < 10    = chr (fromInteger n + (ord_0::Int)) : cs
 323    | otherwise = jtos' q (chr (toInt r + (ord_0::Int)) : cs)
 324     where
 325      (q,r) = n `quotRem` 10
 326 \end{code}
 327
 328 %*********************************************************
 329 %*                                                      *
 330 \subsection{The @Ratio@ and @Rational@ types}
 331 %*                                                      *
 332 %*********************************************************
 333
 334 \begin{code}
 335 data  (Integral a)      => Ratio a = !a :% !a  deriving (Eq)
 336 type  Rational          =  Ratio Integer
 337
 338 {-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}
 339 (%)                     :: (Integral a) => a -> a -> Ratio a
 340 numerator, denominator  :: (Integral a) => Ratio a -> a
 341 \end{code}
 342
 343 \tr{reduce} is a subsidiary function used only in this module .
 344 It normalises a ratio by dividing both numerator and denominator by
 345 their greatest common divisor.
 346
 347 \begin{code}
 348 reduce ::  (Integral a) => a -> a -> Ratio a
 349 reduce _ 0              =  error "Ratio.%: zero denominator"
 350 reduce x y              =  (x `quot` d) :% (y `quot` d)
 351                            where d = gcd x y
 352 \end{code}
 353
 354 \begin{code}
 355 x % y                   =  reduce (x * signum y) (abs y)
 356
 357 numerator   (x :% _)    =  x
 358 denominator (_ :% y)    =  y
 359
 360 \end{code}
 361
 362 %*********************************************************
 363 %*                                                      *
 364 \subsection{Overloaded numeric functions}
 365 %*                                                      *
 366 %*********************************************************
 367
 368 \begin{code}
 369 even, odd       :: (Integral a) => a -> Bool
 370 even n          =  n `rem` 2 == 0
 371 odd             =  not . even
 372
 373 {-# SPECIALISE gcd ::
 374         Int -> Int -> Int,
 375         Integer -> Integer -> Integer #-}
 376 gcd             :: (Integral a) => a -> a -> a
 377 gcd 0 0         =  error "Prelude.gcd: gcd 0 0 is undefined"
 378 gcd x y         =  gcd' (abs x) (abs y)
 379                    where gcd' a 0  =  a
 380                          gcd' a b  =  gcd' b (a `rem` b)
 381
 382 {-# SPECIALISE lcm ::
 383         Int -> Int -> Int,
 384         Integer -> Integer -> Integer #-}
 385 lcm             :: (Integral a) => a -> a -> a
 386 lcm _ 0         =  0
 387 lcm 0 _         =  0
 388 lcm x y         =  abs ((x `quot` (gcd x y)) * y)
 389
 390 {-# SPECIALISE (^) ::
 391         Integer -> Integer -> Integer,
 392         Integer -> Int -> Integer,
 393         Int -> Int -> Int #-}
 394 (^)             :: (Num a, Integral b) => a -> b -> a
 395 _ ^ 0           =  1
 396 x ^ n | n > 0   =  f x (n-1) x
 397                    where f _ 0 y = y
 398                          f a d y = g a d  where
 399                                    g b i | even i  = g (b*b) (i `quot` 2)
 400                                          | otherwise = f b (i-1) (b*y)
 401 _ ^ _           = error "Prelude.^: negative exponent"
 402
 403 {- SPECIALISE (^^) ::
 404         Double -> Int -> Double,
 405         Rational -> Int -> Rational #-}
 406 (^^)            :: (Fractional a, Integral b) => a -> b -> a
 407 x ^^ n          =  if n >= 0 then x^n else recip (x^(negate n))
 408
 409 \end{code}
 410