ghc/lib/hbc/Number.hs

   1 module Number(Number, isInteger) where
   2 data Number = I Integer | F Double
   3
   4 toF (I i) = fromInteger i
   5 toF (F f) = f
   6
   7 toI (I i) = i
   8 toI (F f) = round f
   9
  10 -- slow!!
  11 toN x | fromInteger i == x = I i where i = truncate x
  12 toN x = F x
  13
  14 isInteger (I i) = True
  15 isInteger (F x) = fromInteger (truncate x) == x
  16
  17 instance Eq Number where
  18     I x == I y = x == y
  19     x   == y   = toF x == toF y
  20
  21 instance Ord Number where
  22     I x <= I y = x <= y
  23     x   <= y   = toF x <= toF y
  24
  25 instance Text Number where
  26     showsPrec p (I i) = showsPrec p i
  27 --    showsPrec p (F f) | fromInteger i == f = showsPrec p i where i = truncate f
  28     showsPrec p (F f) =
  29         let s = reverse (show f)
  30             s' = if 'e' `notElem` s then dropWhile (=='0') (tail s) else s
  31             s'' = if head s' == '.' then tail s' else s'
  32         in  showString (reverse s'')
  33     readsPrec p s = [(I i, s) | (i, s)<-readsPrec p s] ++
  34                     [(F i, s) | (i, s)<-readsPrec p s]
  35
  36 #if defined(__HBC__)
  37     showsType _ = showString "Number"
  38 #endif
  39
  40 instance Num Number where
  41     I x + I y  = I (x+y)
  42     x   + y    = toN (toF x + toF y)
  43     I x - I y  = I (x-y)
  44     x   - y    = toN (toF x - toF y)
  45     I x * I y  = I (x*y)
  46     x   * y    = toN (toF x * toF y)
  47     negate (I x) = I (-x)
  48     negate (F x) = F (-x)
  49     abs x = if x <= 0 then -x else x
  50     signum x = if x <= 0 then if x==0 then 0 else -1 else 1
  51     fromInteger i = I i
  52
  53 instance Ix Number where
  54     range (x, y) = [I i | i<-[toI x .. toI y]]
  55     index (x, y) i = fromInteger (toI i - toI x)
  56     inRange (x, y) i = toI x <= toI i && toI i <= toI y
  57
  58 instance Integral Number where
  59     quotRem (I x) (I y) = case quotRem x y of (q,r) -> (I q, I r)
  60     quotRem x y = let q = truncate (x' / y')
  61                       x' = toF x
  62                       y' = toF y
  63                   in  (I q, toN (x' - fromInteger q * y'))
  64     toInteger (I i) = i
  65     toInteger (F f) = round f
  66
  67 instance Enum Number where
  68     enumFrom (I i) = [I x | x<-[i..]]
  69     enumFrom (F i) = [F x | x<-[i..]]
  70     enumFromThen (I i) (I j) = [I x | x<-[i,j..]]
  71     enumFromThen i j = [F x | x<-[toF i,toF j..]]
  72
  73 instance Real Number where
  74     toRational (I i) = i % 1
  75     toRational (F f) = toRational f
  76
  77 instance Fractional Number where
  78     I x / I y | r == 0 = I q where (q,r) = quotRem x y
  79     x / y = toN (toF x / toF y)
  80     fromRational r | denominator r == 0 = I (numerator r)
  81     fromRational r = toN (fromRational r)
  82
  83 instance RealFrac Number where
  84     properFraction (I i) = (fromInteger i, I 0)
  85     properFraction (F f) = let (i,x) = properFraction f in (i, toN x)
  86     truncate (I i) = fromInteger i
  87     truncate (F f) = truncate f
  88     round (I i) = fromInteger i
  89     round (F f) = round f
  90     ceiling (I i) = fromInteger i
  91     ceiling (F f) = ceiling f
  92     floor (I i) = fromInteger i
  93     floor (F f) = floor f
  94
  95 instance RealFloat Number where
  96     floatRadix x = floatRadix (toF x)
  97     floatDigits x = floatDigits (toF x)
  98     floatRange x = floatRange (toF x)
  99     decodeFloat x = decodeFloat (toF x)
 100     encodeFloat m e = toN (encodeFloat m e)
 101     exponent x = exponent (toF x)
 102     significand x = toN (significand (toF x))
 103     scaleFloat n x = toN (scaleFloat n (toF x))
 104
 105 instance Floating Number where
 106     pi = F pi
 107     exp = toN . exp . toF
 108     log = toN . log . toF
 109     sqrt = toN . sqrt . toF
 110     x ** y = toN (toF x ** toF y)
 111     logBase x y = toN (logBase (toF x) (toF y))
 112     sin = toN . sin . toF
 113     cos = toN . cos . toF
 114     tan = toN . tan . toF
 115     asin = toN . asin . toF
 116     acos = toN . acos . toF
 117     atan = toN . atan . toF
 118     sinh = toN . sinh . toF
 119     cosh = toN . cosh . toF
 120     tanh = toN . tanh . toF
 121     asinh = toN . asinh . toF
 122     acosh = toN . acosh . toF
 123     atanh = toN . atanh . toF
 124