{-# LANGUAGE FunctionalDependencies #-}
module Data.Bits.Floating (
FloatingBits(..)
,ShowFloat(..)
,fromCFloat
,fromCDouble
) where
import Prelude (Double, Float, Floating, Integral, ShowS, String, (.), (/=), (++), id, isNaN, otherwise, shows)
import Data.Bits ((.&.))
import Data.Bits.Floating.Prim (double2WordBitwise, float2WordBitwise, word2DoubleBitwise, word2FloatBitwise)
import Data.Bits.Floating.Ulp (doubleNextUlp, doublePrevUlp, doubleUlp, floatNextUlp, floatPrevUlp, floatUlp)
import Data.Word (Word32, Word64)
import Numeric (showHex)
import Foreign.C.Types (CDouble(CDouble), CFloat(CFloat))
class (Floating f, Integral w) => FloatingBits f w | f -> w where
coerceToWord :: f -> w
coerceToFloat :: w -> f
nextUp :: f -> f
nextDown :: f -> f
ulp :: f -> f
class ShowFloat f where
{-# MINIMAL showsFloat | showFloat #-}
showsFloat :: f -> ShowS
showsFloat f
f String
s = forall f. ShowFloat f => f -> String
showFloat f
f forall a. [a] -> [a] -> [a]
++ String
s
showFloat :: f -> String
showFloat f
f = forall f. ShowFloat f => f -> ShowS
showsFloat f
f String
""
instance FloatingBits Float Word32 where
{-# INLINE coerceToWord #-}
coerceToWord :: Float -> Word32
coerceToWord = Float -> Word32
float2WordBitwise
{-# INLINE coerceToFloat #-}
coerceToFloat :: Word32 -> Float
coerceToFloat = Word32 -> Float
word2FloatBitwise
{-# INLINE nextUp #-}
nextUp :: Float -> Float
nextUp = Float -> Float
floatNextUlp
{-# INLINE nextDown #-}
nextDown :: Float -> Float
nextDown = Float -> Float
floatPrevUlp
{-# INLINE ulp #-}
ulp :: Float -> Float
ulp = Float -> Float
floatUlp
instance FloatingBits Double Word64 where
{-# INLINE coerceToWord #-}
coerceToWord :: Double -> Word64
coerceToWord = Double -> Word64
double2WordBitwise
{-# INLINE coerceToFloat #-}
coerceToFloat :: Word64 -> Double
coerceToFloat = Word64 -> Double
word2DoubleBitwise
{-# INLINE nextUp #-}
nextUp :: Double -> Double
nextUp = Double -> Double
doubleNextUlp
{-# INLINE nextDown #-}
nextDown :: Double -> Double
nextDown = Double -> Double
doublePrevUlp
{-# INLINE ulp #-}
ulp :: Double -> Double
ulp = Double -> Double
doubleUlp
instance FloatingBits CFloat Word32 where
{-# INLINE coerceToWord #-}
coerceToWord :: CFloat -> Word32
coerceToWord = forall f w. FloatingBits f w => f -> w
coerceToWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Float
fromCFloat
{-# INLINE coerceToFloat #-}
coerceToFloat :: Word32 -> CFloat
coerceToFloat = Float -> CFloat
CFloat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f w. FloatingBits f w => w -> f
coerceToFloat
{-# INLINE nextUp #-}
nextUp :: CFloat -> CFloat
nextUp = Float -> CFloat
CFloat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f w. FloatingBits f w => f -> f
nextUp forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Float
fromCFloat
{-# INLINE nextDown #-}
nextDown :: CFloat -> CFloat
nextDown = Float -> CFloat
CFloat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f w. FloatingBits f w => f -> f
nextDown forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Float
fromCFloat
{-# INLINE ulp #-}
ulp :: CFloat -> CFloat
ulp = Float -> CFloat
CFloat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f w. FloatingBits f w => f -> f
ulp forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Float
fromCFloat
instance FloatingBits CDouble Word64 where
{-# INLINE coerceToWord #-}
coerceToWord :: CDouble -> Word64
coerceToWord = forall f w. FloatingBits f w => f -> w
coerceToWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
fromCDouble
{-# INLINE coerceToFloat #-}
coerceToFloat :: Word64 -> CDouble
coerceToFloat = Double -> CDouble
CDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f w. FloatingBits f w => w -> f
coerceToFloat
{-# INLINE nextUp #-}
nextUp :: CDouble -> CDouble
nextUp = Double -> CDouble
CDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f w. FloatingBits f w => f -> f
nextUp forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
fromCDouble
{-# INLINE nextDown #-}
nextDown :: CDouble -> CDouble
nextDown = Double -> CDouble
CDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f w. FloatingBits f w => f -> f
nextDown forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
fromCDouble
{-# INLINE ulp #-}
ulp :: CDouble -> CDouble
ulp = Double -> CDouble
CDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f w. FloatingBits f w => f -> f
ulp forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
fromCDouble
{-# INLINE fromCFloat #-}
fromCFloat :: CFloat -> Float
fromCFloat :: CFloat -> Float
fromCFloat (CFloat Float
f) = Float
f
{-# INLINE fromCDouble #-}
fromCDouble :: CDouble -> Double
fromCDouble :: CDouble -> Double
fromCDouble (CDouble Double
d) = Double
d
instance ShowFloat Float where
showsFloat :: Float -> ShowS
showsFloat Float
f | forall a. RealFloat a => a -> Bool
isNaN Float
f = Float -> ShowS
showsFloatNaN Float
f
| Bool
otherwise = forall a. Show a => a -> ShowS
shows Float
f
instance ShowFloat Double where
showsFloat :: Double -> ShowS
showsFloat Double
f | forall a. RealFloat a => a -> Bool
isNaN Double
f = Double -> ShowS
showsDoubleNaN Double
f
| Bool
otherwise = forall a. Show a => a -> ShowS
shows Double
f
instance ShowFloat CFloat where
showsFloat :: CFloat -> ShowS
showsFloat = forall f. ShowFloat f => f -> ShowS
showsFloat forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFloat -> Float
fromCFloat
instance ShowFloat CDouble where
showsFloat :: CDouble -> ShowS
showsFloat = forall f. ShowFloat f => f -> ShowS
showsFloat forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
fromCDouble
showsFloatNaN :: Float -> ShowS
showsFloatNaN :: Float -> ShowS
showsFloatNaN Float
f = ShowS
sign forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nan forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ String
s -> Char
'('forall a. a -> [a] -> [a]
:Char
'0'forall a. a -> [a] -> [a]
:Char
'x'forall a. a -> [a] -> [a]
:String
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showHex (Word32
w forall a. Bits a => a -> a -> a
.&. Word32
0x3FFFFF) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
')'forall a. a -> [a] -> [a]
:)
where
w :: Word32
w = forall f w. FloatingBits f w => f -> w
coerceToWord Float
f
sign :: ShowS
sign | Word32
w forall a. Bits a => a -> a -> a
.&. Word32
0x80000000 forall a. Eq a => a -> a -> Bool
/= Word32
0 = (Char
'-'forall a. a -> [a] -> [a]
:)
| Bool
otherwise = forall a. a -> a
id
nan :: ShowS
nan String
s | Word32
w forall a. Bits a => a -> a -> a
.&. Word32
0x00400000 forall a. Eq a => a -> a -> Bool
/= Word32
0 = String
"qNaN" forall a. [a] -> [a] -> [a]
++ String
s
| Bool
otherwise = String
"sNaN" forall a. [a] -> [a] -> [a]
++ String
s
showsDoubleNaN :: Double -> ShowS
showsDoubleNaN :: Double -> ShowS
showsDoubleNaN Double
f = ShowS
sign forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nan forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ String
s -> Char
'('forall a. a -> [a] -> [a]
:Char
'0'forall a. a -> [a] -> [a]
:Char
'x'forall a. a -> [a] -> [a]
:String
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Show a) => a -> ShowS
showHex (Word64
w forall a. Bits a => a -> a -> a
.&. Word64
0x0007FFFFFFFFFFFF) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
')'forall a. a -> [a] -> [a]
:)
where
w :: Word64
w = forall f w. FloatingBits f w => f -> w
coerceToWord Double
f
sign :: ShowS
sign | Word64
w forall a. Bits a => a -> a -> a
.&. Word64
0x8000000000000000 forall a. Eq a => a -> a -> Bool
/= Word64
0 = (Char
'-'forall a. a -> [a] -> [a]
:)
| Bool
otherwise = forall a. a -> a
id
nan :: ShowS
nan String
s | Word64
w forall a. Bits a => a -> a -> a
.&. Word64
0x0008000000000000 forall a. Eq a => a -> a -> Bool
/= Word64
0 = String
"qNaN" forall a. [a] -> [a] -> [a]
++ String
s
| Bool
otherwise = String
"sNaN" forall a. [a] -> [a] -> [a]
++ String
s