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,r) = quotRem n d
  37     n `rem` d           =  r  where (q,r) = quotRem n d
  38     n `div` d           =  q  where (q,r) = divMod n d
  39     n `mod` d           =  r  where (q,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
  50 class  (Fractional a) => Floating a  where
  51     pi                  :: a
  52     exp, log, sqrt      :: a -> a
  53     (**), logBase       :: a -> a -> a
  54     sin, cos, tan       :: a -> a
  55     asin, acos, atan    :: a -> a
  56     sinh, cosh, tanh    :: a -> a
  57     asinh, acosh, atanh :: a -> a
  58
  59     x ** y              =  exp (log x * y)
  60     logBase x y         =  log y / log x
  61     sqrt x              =  x ** 0.5
  62     tan  x              =  sin  x / cos  x
  63     tanh x              =  sinh x / cosh x
  64
  65 class  (Real a, Fractional a) => RealFrac a  where
  66     properFraction      :: (Integral b) => a -> (b,a)
  67     truncate, round     :: (Integral b) => a -> b
  68     ceiling, floor      :: (Integral b) => a -> b
  69
  70     truncate x          =  m  where (m,_) = properFraction x
  71
  72     round x             =  let (n,r) = properFraction x
  73                                m     = if r < 0 then n - 1 else n + 1
  74                            in case signum (abs r - 0.5) of
  75                                 -1 -> n
  76                                 0  -> if even n then n else m
  77                                 1  -> m
  78
  79     ceiling x           =  if r > 0 then n + 1 else n
  80                            where (n,r) = properFraction x
  81
  82     floor x             =  if r < 0 then n - 1 else n
  83                            where (n,r) = properFraction x
  84
  85 class  (RealFrac a, Floating a) => RealFloat a  where
  86     floatRadix          :: a -> Integer
  87     floatDigits         :: a -> Int
  88     floatRange          :: a -> (Int,Int)
  89     decodeFloat         :: a -> (Integer,Int)
  90     encodeFloat         :: Integer -> Int -> a
  91     exponent            :: a -> Int
  92     significand         :: a -> a
  93     scaleFloat          :: Int -> a -> a
  94     isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE
  95                         :: a -> Bool
  96
  97     exponent x          =  if m == 0 then 0 else n + floatDigits x
  98                            where (m,n) = decodeFloat x
  99
 100     significand x       =  encodeFloat m (negate (floatDigits x))
 101                            where (m,_) = decodeFloat x
 102
 103     scaleFloat k x      =  encodeFloat m (n+k)
 104                            where (m,n) = decodeFloat x
 105 \end{code}
 106
 107 %*********************************************************
 108 %*                                                      *
 109 \subsection{Instances for @Int@}
 110 %*                                                      *
 111 %*********************************************************
 112
 113 \begin{code}
 114 instance  Real Int  where
 115     toRational x        =  toInteger x % 1
 116
 117 instance  Integral Int  where
 118     a@(I# _) `quotRem` b@(I# _) = (a `quotInt` b, a `remInt` b)
 119     -- OK, so I made it a little stricter.  Shoot me.  (WDP 94/10)
 120
 121     -- Following chks for zero divisor are non-standard (WDP)
 122     a `quot` b  =  if b /= 0
 123                    then a `quotInt` b
 124                    else error "Integral.Int.quot{PreludeCore}: divide by 0\n"
 125     a `rem` b   =  if b /= 0
 126                    then a `remInt` b
 127                    else error "Integral.Int.rem{PreludeCore}: divide by 0\n"
 128
 129     x `div` y = if x > 0 && y < 0       then quotInt (x-y-1) y
 130                 else if x < 0 && y > 0  then quotInt (x-y+1) y
 131                 else quotInt x y
 132     x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then
 133                     if r/=0 then r+y else 0
 134                 else
 135                     r
 136               where r = remInt x y
 137
 138     divMod x@(I# _) y@(I# _) = (x `div` y, x `mod` y)
 139     -- Stricter.  Sorry if you don't like it.  (WDP 94/10)
 140
 141 --OLD:   even x = eqInt (x `mod` 2) 0
 142 --OLD:   odd x  = neInt (x `mod` 2) 0
 143
 144     toInteger (I# i)  = int2Integer i  -- give back a full-blown Integer
 145     toInt x           = x
 146
 147 \end{code}
 148
 149 %*********************************************************
 150 %*                                                      *
 151 \subsection{Instances for @Integer@}
 152 %*                                                      *
 153 %*********************************************************
 154
 155 \begin{code}
 156 instance  Ord Integer  where
 157     (J# a1 s1 d1) <= (J# a2 s2 d2)
 158       = (cmpInteger# a1 s1 d1 a2 s2 d2) <=# 0#
 159
 160     (J# a1 s1 d1) <  (J# a2 s2 d2)
 161       = (cmpInteger# a1 s1 d1 a2 s2 d2) <# 0#
 162
 163     (J# a1 s1 d1) >= (J# a2 s2 d2)
 164       = (cmpInteger# a1 s1 d1 a2 s2 d2) >=# 0#
 165
 166     (J# a1 s1 d1) >  (J# a2 s2 d2)
 167       = (cmpInteger# a1 s1 d1 a2 s2 d2) ># 0#
 168
 169     x@(J# a1 s1 d1) `max` y@(J# a2 s2 d2)
 170       = if ((cmpInteger# a1 s1 d1 a2 s2 d2) ># 0#) then x else y
 171
 172     x@(J# a1 s1 d1) `min` y@(J# a2 s2 d2)
 173       = if ((cmpInteger# a1 s1 d1 a2 s2 d2) <# 0#) then x else y
 174
 175     compare (J# a1 s1 d1) (J# a2 s2 d2)
 176        = case cmpInteger# a1 s1 d1 a2 s2 d2 of { res# ->
 177          if res# <# 0# then LT else
 178          if res# ># 0# then GT else EQ
 179          }
 180
 181 instance  Num Integer  where
 182     (+) (J# a1 s1 d1) (J# a2 s2 d2)
 183       = case plusInteger# a1 s1 d1 a2 s2 d2 of (# a, s, d #) -> J# a s d
 184
 185     (-) (J# a1 s1 d1) (J# a2 s2 d2)
 186       = case minusInteger# a1 s1 d1 a2 s2 d2 of (# a, s, d #) -> J# a s d
 187
 188     negate (J# a s d)
 189       = case negateInteger# a s d of (# a, s, d #) -> J# a s d
 190
 191     (*) (J# a1 s1 d1) (J# a2 s2 d2)
 192       = case timesInteger# a1 s1 d1 a2 s2 d2 of (# a, s, d #) -> J# a s d
 193
 194     -- ORIG: abs n = if n >= 0 then n else -n
 195
 196     abs n@(J# a1 s1 d1)
 197       = case 0 of { J# a2 s2 d2 ->
 198         if (cmpInteger# a1 s1 d1 a2 s2 d2) >=# 0#
 199         then n
 200         else case negateInteger# a1 s1 d1 of (# a, s, d #) -> J# a s d
 201         }
 202
 203     signum n@(J# a1 s1 d1)
 204       = case 0 of { J# a2 s2 d2 ->
 205         let
 206             cmp = cmpInteger# a1 s1 d1 a2 s2 d2
 207         in
 208         if      cmp >#  0# then 1
 209         else if cmp ==# 0# then 0
 210         else                    (negate 1)
 211         }
 212
 213     fromInteger x       =  x
 214
 215     fromInt (I# i)      =  int2Integer i
 216
 217 instance  Real Integer  where
 218     toRational x        =  x % 1
 219
 220 instance  Integral Integer where
 221     quotRem (J# a1 s1 d1) (J# a2 s2 d2)
 222       = case (quotRemInteger# a1 s1 d1 a2 s2 d2) of
 223           (# a3, s3, d3, a4, s4, d4 #)
 224             -> (J# a3 s3 d3, J# a4 s4 d4)
 225
 226 {- USING THE UNDERLYING "GMP" CODE IS DUBIOUS FOR NOW:
 227
 228     divMod (J# a1 s1 d1) (J# a2 s2 d2)
 229       = case (divModInteger# a1 s1 d1 a2 s2 d2) of
 230           Return2GMPs a3 s3 d3 a4 s4 d4
 231             -> (J# a3 s3 d3, J# a4 s4 d4)
 232 -}
 233     toInteger n      = n
 234     toInt (J# a s d) = case (integer2Int# a s d) of { n# -> I# n# }
 235
 236     -- the rest are identical to the report default methods;
 237     -- you get slightly better code if you let the compiler
 238     -- see them right here:
 239     n `quot` d  =  if d /= 0 then q else
 240                      error "Integral.Integer.quot{PreludeCore}: divide by 0\n"
 241                    where (q,r) = quotRem n d
 242     n `rem` d   =  if d /= 0 then r else
 243                      error "Integral.Integer.quot{PreludeCore}: divide by 0\n"
 244                    where (q,r) = quotRem n d
 245     n `div` d   =  q  where (q,r) = divMod n d
 246     n `mod` d   =  r  where (q,r) = divMod n d
 247
 248     divMod n d  =  case (quotRem n d) of { qr@(q,r) ->
 249                    if signum r == negate (signum d) then (q - 1, r+d) else qr }
 250                    -- Case-ified by WDP 94/10
 251
 252 instance  Enum Integer  where
 253     toEnum n             =  toInteger n
 254     fromEnum n           =  toInt n
 255     enumFrom n           =  n : enumFrom (n + 1)
 256     enumFromThen m n     =  en' m (n - m)
 257                             where en' m n = m : en' (m + n) n
 258     enumFromTo n m       =  takeWhile (<= m) (enumFrom n)
 259     enumFromThenTo n m p =  takeWhile (if m >= n then (<= p) else (>= p))
 260                                       (enumFromThen n m)
 261
 262 instance  Show Integer  where
 263     showsPrec   x = showSignedInteger x
 264     showList = showList__ (showsPrec 0)
 265
 266 instance  Ix Integer  where
 267     range (m,n)         =  [m..n]
 268     index b@(m,n) i
 269         | inRange b i   =  fromInteger (i - m)
 270         | otherwise     =  error "Integer.index: Index out of range."
 271     inRange (m,n) i     =  m <= i && i <= n
 272
 273 showSignedInteger :: Int -> Integer -> ShowS
 274 showSignedInteger p n r
 275   = -- from HBC version; support code follows
 276     if n < 0 && p > 6 then '(':jtos n++(')':r) else jtos n ++ r
 277
 278 jtos :: Integer -> String
 279 jtos n
 280   = if n < 0 then
 281         '-' : jtos' (-n) []
 282     else
 283         jtos' n []
 284
 285 jtos' :: Integer -> String -> String
 286 jtos' n cs
 287   = if n < 10 then
 288         chr (fromInteger (n + ord_0)) : cs
 289     else
 290         jtos' q (chr (toInt r + (ord_0::Int)) : cs)
 291   where
 292     (q,r) = n `quotRem` 10
 293
 294 \end{code}
 295
 296 %*********************************************************
 297 %*                                                      *
 298 \subsection{The @Ratio@ and @Rational@ types}
 299 %*                                                      *
 300 %*********************************************************
 301
 302 \begin{code}
 303 data  (Integral a)      => Ratio a = !a :% !a  deriving (Eq)
 304 type  Rational          =  Ratio Integer
 305
 306 {-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}
 307 (%)                     :: (Integral a) => a -> a -> Ratio a
 308 numerator, denominator  :: (Integral a) => Ratio a -> a
 309 \end{code}
 310
 311 \tr{reduce} is a subsidiary function used only in this module .
 312 It normalises a ratio by dividing both numerator and denominator by
 313 their greatest common divisor.
 314
 315 \begin{code}
 316 reduce x 0              =  error "{Ratio.%}: zero denominator"
 317 reduce x y              =  (x `quot` d) :% (y `quot` d)
 318                            where d = gcd x y
 319 \end{code}
 320
 321 \begin{code}
 322 x % y                   =  reduce (x * signum y) (abs y)
 323
 324 numerator (x:%y)        =  x
 325
 326 denominator (x:%y)      =  y
 327 \end{code}
 328
 329 %*********************************************************
 330 %*                                                      *
 331 \subsection{Overloaded numeric functions}
 332 %*                                                      *
 333 %*********************************************************
 334
 335 \begin{code}
 336 even, odd       :: (Integral a) => a -> Bool
 337 even n          =  n `rem` 2 == 0
 338 odd             =  not . even
 339
 340 {-# SPECIALISE gcd ::
 341         Int -> Int -> Int,
 342         Integer -> Integer -> Integer #-}
 343 gcd             :: (Integral a) => a -> a -> a
 344 gcd 0 0         =  error "Prelude.gcd: gcd 0 0 is undefined"
 345 gcd x y         =  gcd' (abs x) (abs y)
 346                    where gcd' x 0  =  x
 347                          gcd' x y  =  gcd' y (x `rem` y)
 348
 349 {-# SPECIALISE lcm ::
 350         Int -> Int -> Int,
 351         Integer -> Integer -> Integer #-}
 352 lcm             :: (Integral a) => a -> a -> a
 353 lcm _ 0         =  0
 354 lcm 0 _         =  0
 355 lcm x y         =  abs ((x `quot` (gcd x y)) * y)
 356
 357 {-# SPECIALISE (^) ::
 358         Integer -> Integer -> Integer,
 359         Integer -> Int -> Integer,
 360         Int -> Int -> Int #-}
 361 (^)             :: (Num a, Integral b) => a -> b -> a
 362 x ^ 0           =  1
 363 x ^ n | n > 0   =  f x (n-1) x
 364                    where f _ 0 y = y
 365                          f x n y = g x n  where
 366                                    g x n | even n  = g (x*x) (n `quot` 2)
 367                                          | otherwise = f x (n-1) (x*y)
 368 _ ^ _           = error "Prelude.^: negative exponent"
 369
 370 {- SPECIALISE (^^) ::
 371         Double -> Int -> Double,
 372         Rational -> Int -> Rational #-}
 373 (^^)            :: (Fractional a, Integral b) => a -> b -> a
 374 x ^^ n          =  if n >= 0 then x^n else recip (x^(negate n))
 375
 376 atan2           :: (RealFloat a) => a -> a -> a
 377 atan2 y x       =  case (signum y, signum x) of
 378                         ( 0, 1) ->  0
 379                         ( 1, 0) ->  pi/2
 380                         ( 0,-1) ->  pi
 381                         (-1, 0) ->  (negate pi)/2
 382                         ( _, 1) ->  atan (y/x)
 383                         ( _,-1) ->  atan (y/x) + pi
 384                         ( 0, 0) ->  error "Prelude.atan2: atan2 of origin"
 385 \end{code}
 386