ghc/lib/prelude/IFloat.hs

   1 module PreludeCore ( Float(..) ) where
   2
   3 #include "../includes/ieee-flpt.h"
   4
   5 import Cls
   6 import Core
   7 import IInt
   8 import IInteger
   9 import IRatio
  10 import List             ( (++) )
  11 import Prel             ( (^), (^^), otherwise )
  12 import PS               ( _PackedString, _unpackPS )
  13 import Text
  14 import TyComplex    -- for pragmas only
  15
  16 -- definitions of the boxed PrimOps; these will be
  17 -- used in the case of partial applications, etc.
  18
  19 plusFloat   (F# x) (F# y) = F# (plusFloat# x y)
  20 minusFloat  (F# x) (F# y) = F# (minusFloat# x y)
  21 timesFloat  (F# x) (F# y) = F# (timesFloat# x y)
  22 divideFloat (F# x) (F# y) = F# (divideFloat# x y)
  23 negateFloat (F# x)        = F# (negateFloat# x)
  24
  25 gtFloat     (F# x) (F# y) = gtFloat# x y
  26 geFloat     (F# x) (F# y) = geFloat# x y
  27 eqFloat     (F# x) (F# y) = eqFloat# x y
  28 neFloat     (F# x) (F# y) = neFloat# x y
  29 ltFloat     (F# x) (F# y) = ltFloat# x y
  30 leFloat     (F# x) (F# y) = leFloat# x y
  31
  32 float2Int   (F# x) = I# (float2Int# x)
  33 int2Float   (I# x) = F# (int2Float# x)
  34
  35 expFloat    (F# x) = F# (expFloat# x)
  36 logFloat    (F# x) = F# (logFloat# x)
  37 sqrtFloat   (F# x) = F# (sqrtFloat# x)
  38 sinFloat    (F# x) = F# (sinFloat# x)
  39 cosFloat    (F# x) = F# (cosFloat# x)
  40 tanFloat    (F# x) = F# (tanFloat# x)
  41 asinFloat   (F# x) = F# (asinFloat# x)
  42 acosFloat   (F# x) = F# (acosFloat# x)
  43 atanFloat   (F# x) = F# (atanFloat# x)
  44 sinhFloat   (F# x) = F# (sinhFloat# x)
  45 coshFloat   (F# x) = F# (coshFloat# x)
  46 tanhFloat   (F# x) = F# (tanhFloat# x)
  47
  48 powerFloat  (F# x) (F# y) = F# (powerFloat# x y)
  49
  50 ---------------------------------------------------------------
  51
  52 instance  Eq Float  where
  53     (==) x y = eqFloat x y
  54     (/=) x y = neFloat x y
  55
  56 instance  Ord Float  where
  57     (<=) x y = leFloat x y
  58     (<)  x y = ltFloat x y
  59     (>=) x y = geFloat x y
  60     (>)  x y = gtFloat x y
  61
  62     max a b = case _tagCmp a b of { _LT -> b; _EQ -> a;  _GT -> a }
  63     min a b = case _tagCmp a b of { _LT -> a; _EQ -> a;  _GT -> b }
  64
  65     _tagCmp (F# a#) (F# b#)
  66       = if      (eqFloat# a# b#) then _EQ
  67         else if (ltFloat# a# b#) then _LT else _GT
  68
  69 instance  Num Float  where
  70     (+) x y             = plusFloat x y
  71     (-) x y             = minusFloat x y
  72     negate x            = negateFloat x
  73     (*) x y             = timesFloat x y
  74     abs x | x >= 0      =  x
  75           | otherwise   =  negateFloat x
  76     signum x | x == 0    =  0
  77              | x > 0     =  1
  78              | otherwise = -1
  79
  80     fromInteger n       = encodeFloat n 0
  81     fromInt i           = int2Float i
  82
  83 instance  Real Float  where
  84     toRational x        =  (m%1)*(b%1)^^n -- i.e., realFloatToRational x
  85                            where (m,n) = decodeFloat x
  86                                  b     = floatRadix  x
  87
  88 instance  Fractional Float  where
  89     (/) x y             =  divideFloat x y
  90     fromRational x      =  fromRationalX x -- ORIG: rationalToRealFloat x
  91
  92 instance  Floating Float  where
  93     pi                  =  3.141592653589793238
  94     exp x               =  expFloat x
  95     log x               =  logFloat x
  96     sqrt x              =  sqrtFloat x
  97     sin x               =  sinFloat x
  98     cos x               =  cosFloat x
  99     tan x               =  tanFloat x
 100     asin x              =  asinFloat x
 101     acos x              =  acosFloat x
 102     atan x              =  atanFloat x
 103     sinh x              =  sinhFloat x
 104     cosh x              =  coshFloat x
 105     tanh x              =  tanhFloat x
 106     (**) x y            =  powerFloat x y
 107
 108 {- WAS: but not all machines have these in their math library:
 109     asinh               =  asinhFloat
 110     acosh               =  acoshFloat
 111     atanh               =  atanhFloat
 112 -}
 113     asinh x = log (x + sqrt (1+x*x))
 114     acosh x = log (x + (x+1) * sqrt ((x-1)/(x+1)))
 115     atanh x = log ((x+1) / sqrt (1 - x*x))
 116
 117 instance  RealFrac Float  where
 118     properFraction x = _properFraction x
 119
 120     -- just call the versions in Core.hs
 121     truncate x  =  _truncate x
 122     round x     =  _round x
 123     ceiling x   =  _ceiling x
 124     floor x     =  _floor x
 125
 126 instance  RealFloat Float  where
 127     floatRadix _        =  FLT_RADIX        -- from float.h
 128     floatDigits _       =  FLT_MANT_DIG     -- ditto
 129     floatRange _        =  (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto
 130
 131     decodeFloat (F# f#)
 132       = case decodeFloat# f#    of
 133           _ReturnIntAndGMP exp# a# s# d# ->
 134             (J# a# s# d#, I# exp#)
 135
 136     encodeFloat (J# a# s# d#) (I# e#)
 137       = case encodeFloat# a# s# d# e# of { flt# -> F# flt# }
 138
 139 instance  Enum Float  where
 140 {- *** RAW PRELUDE ***
 141     enumFrom            =  numericEnumFrom
 142     enumFromThen        =  numericEnumFromThen
 143 -}
 144     enumFrom x = x : enumFrom (x `plusFloat` 1.0)
 145     enumFromThen m n = en' m (n `minusFloat` m)
 146             where en' m n = m : en' (m `plusFloat` n) n
 147
 148 instance  Text Float  where
 149     readsPrec p x = readSigned readFloat x
 150     showsPrec   x = showSigned showFloat x
 151
 152 ---------------------------------------------------------------
 153 instance _CCallable   Float
 154 instance _CReturnable Float