module Data.Floating.Types.Float (
Float
) where
import Prelude hiding (Float, Double, Floating(..), RealFloat(..), Ord(..))
import Control.Applicative
import Control.Monad
import Data.Maybe
import Data.Ratio
import Data.Poset
import GHC.Exts hiding (Double(..), Float(..))
import GHC.Prim
import Foreign
import Foreign.C
import System.IO.Unsafe
import Data.Floating.Types
import Data.Floating.Types.Double
import Data.Floating.Classes
import Data.Floating.CMath
foreign import ccall unsafe "float_signum"
float_signum :: CFloat -> CFloat
foreign import ccall unsafe "float_classify"
float_classify :: CFloat -> CInt
foreign import ccall unsafe "float_compare"
float_compare :: CFloat -> CFloat -> CInt
foreign import ccall unsafe "strtof"
c_strtof :: CString -> Ptr CString -> IO CFloat
instance Show Float where
show x = show (toFloating x :: Double)
instance Read Float where
readsPrec _ s = unsafePerformIO . withCString s $ \str -> do
alloca $ \endbuf -> do
val <- toFloating <$> c_strtof str endbuf
end <- peek endbuf
if end == str
then return []
else peekCString end >>= \rem -> return [(val, rem)]
instance Eq Float where
F# x == F# y = x `eqFloat#` y
F# x /= F# y = x `neFloat#` y
instance Num Float where
F# x + F# y = F# (x `plusFloat#` y)
F# x F# y = F# (x `minusFloat#` y)
F# x * F# y = F# (x `timesFloat#` y)
negate (F# x) = F# (negateFloat# x)
fromInteger = toFloating
signum = libmFloat float_signum
abs = libmFloat c_fabsf
instance Enum Float where
pred x = nextafter x (infinity)
succ x = nextafter x infinity
toEnum = toFloating
fromEnum = fromJust . toIntegral
instance Poset Float where
compare a b = toEnum . fromIntegral $ float_compare a' b' where
a' = toFloating a
b' = toFloating b
F# x < F# y = x `ltFloat#` y
F# x <= F# y = x `leFloat#` y
F# x >= F# y = x `geFloat#` y
F# x > F# y = x `gtFloat#` y
instance Sortable Float where
isOrdered = not . ((== FPNaN) . classify)
max = libmFloat2 c_fmaxf
min = libmFloat2 c_fminf
instance Fractional Float where
(F# x) / (F# y) = F# (x `divideFloat#` y)
fromRational = liftM2 (/)
(fromInteger . numerator)
(fromInteger . denominator)
dropFrac :: Float -> Integer
dropFrac (F# x)
| e >= 0 = s * 2^e
| otherwise = quot s (2^(negate e))
where
!(# s#, e# #) = decodeFloat_Int# x
s = toInteger (I# s#)
e = I# e#
instance Roundable Float where
toIntegral x = case classify x of
FPInfinite -> Nothing
FPNaN -> Nothing
otherwise -> Just . fromInteger . dropFrac $ x
floor = libmFloat c_floorf
ceiling = libmFloat c_ceilf
truncate = libmFloat c_truncf
round = libmFloat c_roundf
instance Floating Float where
(F# x) ** (F# y) = F# (x `powerFloat#` y)
sqrt (F# x) = F# (sqrtFloat# x)
acos (F# x) = F# (acosFloat# x)
asin (F# x) = F# (asinFloat# x)
atan (F# x) = F# (atanFloat# x)
cos (F# x) = F# (cosFloat# x)
sin (F# x) = F# (sinFloat# x)
tan (F# x) = F# (tanFloat# x)
cosh (F# x) = F# (coshFloat# x)
sinh (F# x) = F# (sinhFloat# x)
tanh (F# x) = F# (tanhFloat# x)
exp (F# x) = F# (expFloat# x)
log (F# x) = F# (logFloat# x)
acosh = libmFloat c_acoshf
asinh = libmFloat c_asinhf
atanh = libmFloat c_atanhf
instance RealFloat Float where
fma = libmFloat3 c_fmaf
copysign = libmFloat2 c_copysignf
nextafter = libmFloat2 c_nextafterf
fmod = libmFloat2 c_fmodf
frem = libmFloat2 c_remainderf
atan2 = libmFloat2 c_atan2f
hypot = libmFloat2 c_hypotf
cbrt = libmFloat c_cbrtf
exp2 = libmFloat c_exp2f
expm1 = libmFloat c_expm1f
log10 = libmFloat c_log10f
log1p = libmFloat c_log1pf
log2 = libmFloat c_log2f
logb = libmFloat c_logbf
erf = libmFloat c_erff
erfc = libmFloat c_erfcf
gamma = libmFloat c_tgammaf
lgamma = libmFloat c_lgammaf
nearbyint = libmFloat c_nearbyintf
rint = libmFloat c_rintf
instance PrimFloat Float where
classify = toEnum . fromIntegral . float_classify . toFloating