1 module PreludeCore ( Float(..) ) where
3 #include "../includes/ieee-flpt.h"
10 import List ( (++), takeWhile )
11 import Prel ( (^), (^^), otherwise )
12 import PS ( _PackedString, _unpackPS )
17 -- definitions of the boxed PrimOps; these will be
18 -- used in the case of partial applications, etc.
20 plusFloat (F# x) (F# y) = F# (plusFloat# x y)
21 minusFloat (F# x) (F# y) = F# (minusFloat# x y)
22 timesFloat (F# x) (F# y) = F# (timesFloat# x y)
23 divideFloat (F# x) (F# y) = F# (divideFloat# x y)
24 negateFloat (F# x) = F# (negateFloat# x)
26 gtFloat (F# x) (F# y) = gtFloat# x y
27 geFloat (F# x) (F# y) = geFloat# x y
28 eqFloat (F# x) (F# y) = eqFloat# x y
29 neFloat (F# x) (F# y) = neFloat# x y
30 ltFloat (F# x) (F# y) = ltFloat# x y
31 leFloat (F# x) (F# y) = leFloat# x y
33 float2Int (F# x) = I# (float2Int# x)
34 int2Float (I# x) = F# (int2Float# x)
36 expFloat (F# x) = F# (expFloat# x)
37 logFloat (F# x) = F# (logFloat# x)
38 sqrtFloat (F# x) = F# (sqrtFloat# x)
39 sinFloat (F# x) = F# (sinFloat# x)
40 cosFloat (F# x) = F# (cosFloat# x)
41 tanFloat (F# x) = F# (tanFloat# x)
42 asinFloat (F# x) = F# (asinFloat# x)
43 acosFloat (F# x) = F# (acosFloat# x)
44 atanFloat (F# x) = F# (atanFloat# x)
45 sinhFloat (F# x) = F# (sinhFloat# x)
46 coshFloat (F# x) = F# (coshFloat# x)
47 tanhFloat (F# x) = F# (tanhFloat# x)
49 powerFloat (F# x) (F# y) = F# (powerFloat# x y)
51 ---------------------------------------------------------------
53 instance Eq Float where
54 (==) x y = eqFloat x y
55 (/=) x y = neFloat x y
57 instance Ord Float where
58 (<=) x y = leFloat x y
60 (>=) x y = geFloat x y
63 max a b = case _tagCmp a b of { _LT -> b; _EQ -> a; _GT -> a }
64 min a b = case _tagCmp a b of { _LT -> a; _EQ -> a; _GT -> b }
66 _tagCmp (F# a#) (F# b#)
67 = if (eqFloat# a# b#) then _EQ
68 else if (ltFloat# a# b#) then _LT else _GT
70 instance Num Float where
71 (+) x y = plusFloat x y
72 (-) x y = minusFloat x y
73 negate x = negateFloat x
74 (*) x y = timesFloat x y
76 | otherwise = negateFloat x
77 signum x | x == 0.0 = 0
80 fromInteger n = encodeFloat n 0
81 fromInt i = int2Float i
83 instance Real Float where
84 toRational x = (m%__i1)*(b%__i1)^^n
85 where (m,n) = decodeFloat x
88 instance Fractional Float where
89 (/) x y = divideFloat x y
90 fromRational x = _fromRational x
93 instance Floating Float where
94 pi = 3.141592653589793238
107 (**) x y = powerFloat x y
108 logBase x y = log y / log x
110 asinh x = log (x + sqrt (1.0+x*x))
111 acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0)))
112 atanh x = log ((x+1.0) / sqrt (1.0-x*x))
114 instance RealFrac Float where
116 {-# SPECIALIZE properFraction :: Float -> (Int, Float) #-}
117 {-# SPECIALIZE truncate :: Float -> Int #-}
118 {-# SPECIALIZE round :: Float -> Int #-}
119 {-# SPECIALIZE ceiling :: Float -> Int #-}
120 {-# SPECIALIZE floor :: Float -> Int #-}
122 {-# SPECIALIZE properFraction :: Float -> (Integer, Float) #-}
123 {-# SPECIALIZE truncate :: Float -> Integer #-}
124 {-# SPECIALIZE round :: Float -> Integer #-}
125 {-# SPECIALIZE ceiling :: Float -> Integer #-}
126 {-# SPECIALIZE floor :: Float -> Integer #-}
129 = case (decodeFloat x) of { (m,n) ->
130 let b = floatRadix x in
132 (fromInteger m * fromInteger b ^ n, 0.0)
134 case (quotRem m (b^(-n))) of { (w,r) ->
135 (fromInteger w, encodeFloat r n)
139 truncate x = case properFraction x of
142 round x = case properFraction x of
144 m = if r < 0.0 then n - __i1 else n + __i1
145 half_down = abs r - 0.5
147 case (_tagCmp half_down 0.0) of
149 _EQ -> if even n then n else m
152 ceiling x = case properFraction x of
153 (n,r) -> if r > 0.0 then n + __i1 else n
155 floor x = case properFraction x of
156 (n,r) -> if r < 0.0 then n - __i1 else n
158 instance RealFloat Float where
159 floatRadix _ = FLT_RADIX -- from float.h
160 floatDigits _ = FLT_MANT_DIG -- ditto
161 floatRange _ = (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto
164 = case decodeFloat# f# of
165 _ReturnIntAndGMP exp# a# s# d# ->
166 (J# a# s# d#, I# exp#)
168 encodeFloat (J# a# s# d#) (I# e#)
169 = case encodeFloat# a# s# d# e# of { flt# -> F# flt# }
171 exponent x = case decodeFloat x of
172 (m,n) -> if m == __i0 then 0 else n + floatDigits x
174 significand x = case decodeFloat x of
175 (m,_) -> encodeFloat m (- (floatDigits x))
177 scaleFloat k x = case decodeFloat x of
178 (m,n) -> encodeFloat m (n+k)
180 instance Enum Float where
181 enumFrom x = x : enumFrom (x `plusFloat` 1.0)
182 enumFromThen m n = en' m (n `minusFloat` m)
183 where en' m n = m : en' (m `plusFloat` n) n
184 enumFromTo n m = takeWhile (<= m) (enumFrom n)
185 enumFromThenTo n m p = takeWhile (if m >= n then (<= p) else (>= p))
188 instance Text Float where
189 readsPrec p x = readSigned readFloat x
190 showsPrec x = showSigned showFloat x
191 readList = _readList (readsPrec 0)
192 showList = _showList (showsPrec 0)
194 ---------------------------------------------------------------
195 instance _CCallable Float
196 instance _CReturnable Float