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{Int}.quot: divide by 0\n"
 142     a `rem` b   =  if b /= 0
 143                    then a `remInt` b
 144                    else error "Prelude.Integral{Int}.rem: divide by 0\n"
 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{Integer}.quot: divide by 0\n"
 258                    where (q,_) = quotRem n d
 259     n `rem` d   =  if d /= 0 then r else
 260                      error "Prelude.Integral{Integer}.rem: divide by 0\n"
 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 m n     =  en' m (n - m)
 276                             where en' a b = a : en' (a + b) b
 277     enumFromTo n m       =  takeWhile (<= m) (enumFrom n)
 278     enumFromThenTo n m p =  takeWhile (if m >= n then (<= p) else (>= p))
 279                                       (enumFromThen n m)
 280
 281 instance  Show Integer  where
 282     showsPrec   x = showSignedInteger x
 283     showList = showList__ (showsPrec 0)
 284
 285
 286 instance  Ix Integer  where
 287     range (m,n)         =  [m..n]
 288     index b@(m,_) i
 289         | inRange b i   =  fromInteger (i - m)
 290         | otherwise     =  indexIntegerError i b
 291     inRange (m,n) i     =  m <= i && i <= n
 292
 293 -- Sigh, really want to use helper function in Ix, but
 294 -- module deps. are too painful.
 295 {-# NOINLINE indexIntegerError #-}
 296 indexIntegerError :: Integer -> (Integer,Integer) -> a
 297 indexIntegerError i rng
 298   = error (showString "Ix{Integer}.index: Index " .
 299            showParen True (showsPrec 0 i) .
 300            showString " out of range " $
 301            showParen True (showsPrec 0 rng) "")
 302
 303 showSignedInteger :: Int -> Integer -> ShowS
 304 showSignedInteger p n r
 305   | n < 0 && p > 6 = '(':jtos n (')':r)
 306   | otherwise      = jtos n r
 307
 308 jtos :: Integer -> String -> String
 309 jtos i rs
 310  | i < 0     = '-' : jtos' (-i) rs
 311  | otherwise = jtos' i rs
 312  where
 313   jtos' :: Integer -> String -> String
 314   jtos' n cs
 315    | n < 10    = chr (fromInteger n + (ord_0::Int)) : cs
 316    | otherwise = jtos' q (chr (toInt r + (ord_0::Int)) : cs)
 317     where
 318      (q,r) = n `quotRem` 10
 319 \end{code}
 320
 321 %*********************************************************
 322 %*                                                      *
 323 \subsection{The @Ratio@ and @Rational@ types}
 324 %*                                                      *
 325 %*********************************************************
 326
 327 \begin{code}
 328 data  (Integral a)      => Ratio a = !a :% !a  deriving (Eq)
 329 type  Rational          =  Ratio Integer
 330
 331 {-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}
 332 (%)                     :: (Integral a) => a -> a -> Ratio a
 333 numerator, denominator  :: (Integral a) => Ratio a -> a
 334 \end{code}
 335
 336 \tr{reduce} is a subsidiary function used only in this module .
 337 It normalises a ratio by dividing both numerator and denominator by
 338 their greatest common divisor.
 339
 340 \begin{code}
 341 reduce ::  (Integral a) => a -> a -> Ratio a
 342 reduce _ 0              =  error "{Ratio.%}: zero denominator"
 343 reduce x y              =  (x `quot` d) :% (y `quot` d)
 344                            where d = gcd x y
 345 \end{code}
 346
 347 \begin{code}
 348 x % y                   =  reduce (x * signum y) (abs y)
 349
 350 numerator   (x :% _)    =  x
 351 denominator (_ :% y)    =  y
 352
 353 \end{code}
 354
 355 %*********************************************************
 356 %*                                                      *
 357 \subsection{Overloaded numeric functions}
 358 %*                                                      *
 359 %*********************************************************
 360
 361 \begin{code}
 362 even, odd       :: (Integral a) => a -> Bool
 363 even n          =  n `rem` 2 == 0
 364 odd             =  not . even
 365
 366 {-# SPECIALISE gcd ::
 367         Int -> Int -> Int,
 368         Integer -> Integer -> Integer #-}
 369 gcd             :: (Integral a) => a -> a -> a
 370 gcd 0 0         =  error "Prelude.gcd: gcd 0 0 is undefined"
 371 gcd x y         =  gcd' (abs x) (abs y)
 372                    where gcd' a 0  =  a
 373                          gcd' a b  =  gcd' b (a `rem` b)
 374
 375 {-# SPECIALISE lcm ::
 376         Int -> Int -> Int,
 377         Integer -> Integer -> Integer #-}
 378 lcm             :: (Integral a) => a -> a -> a
 379 lcm _ 0         =  0
 380 lcm 0 _         =  0
 381 lcm x y         =  abs ((x `quot` (gcd x y)) * y)
 382
 383 {-# SPECIALISE (^) ::
 384         Integer -> Integer -> Integer,
 385         Integer -> Int -> Integer,
 386         Int -> Int -> Int #-}
 387 (^)             :: (Num a, Integral b) => a -> b -> a
 388 _ ^ 0           =  1
 389 x ^ n | n > 0   =  f x (n-1) x
 390                    where f _ 0 y = y
 391                          f a d y = g a d  where
 392                                    g b i | even i  = g (b*b) (i `quot` 2)
 393                                          | otherwise = f b (i-1) (b*y)
 394 _ ^ _           = error "Prelude.^: negative exponent"
 395
 396 {- SPECIALISE (^^) ::
 397         Double -> Int -> Double,
 398         Rational -> Int -> Rational #-}
 399 (^^)            :: (Fractional a, Integral b) => a -> b -> a
 400 x ^^ n          =  if n >= 0 then x^n else recip (x^(negate n))
 401
 402 \end{code}
 403