module Data.Binary.IEEE754 (
getFloat16be, getFloat16le
, getFloat32be, getFloat32le
, getFloat64be, getFloat64le
, putFloat32be, putFloat32le
, putFloat64be, putFloat64le
, floatToWord, wordToFloat
, doubleToWord, wordToDouble
) where
import Prelude hiding (exp)
import Data.Bits (shiftL, shiftR, (.|.), (.&.))
import qualified Foreign as F
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.Binary.Get as G
import qualified Data.Binary.Put as P
getFloat16be :: G.Get Float
getFloat16be :: Get Float
getFloat16be = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> Float
toFloat16 Get Word16
G.getWord16be
getFloat16le :: G.Get Float
getFloat16le :: Get Float
getFloat16le = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> Float
toFloat16 Get Word16
G.getWord16le
getFloat32be :: G.Get Float
getFloat32be :: Get Float
getFloat32be = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall word float. (Storable word, Storable float) => word -> float
toFloat Get Word32
G.getWord32be
getFloat32le :: G.Get Float
getFloat32le :: Get Float
getFloat32le = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall word float. (Storable word, Storable float) => word -> float
toFloat Get Word32
G.getWord32le
getFloat64be :: G.Get Double
getFloat64be :: Get Double
getFloat64be = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall word float. (Storable word, Storable float) => word -> float
toFloat Get Word64
G.getWord64be
getFloat64le :: G.Get Double
getFloat64le :: Get Double
getFloat64le = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall word float. (Storable word, Storable float) => word -> float
toFloat Get Word64
G.getWord64le
putFloat32be :: Float -> P.Put
putFloat32be :: Float -> Put
putFloat32be = Word32 -> Put
P.putWord32be forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall word float. (Storable word, Storable float) => float -> word
fromFloat
putFloat32le :: Float -> P.Put
putFloat32le :: Float -> Put
putFloat32le = Word32 -> Put
P.putWord32le forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall word float. (Storable word, Storable float) => float -> word
fromFloat
putFloat64be :: Double -> P.Put
putFloat64be :: Double -> Put
putFloat64be = Word64 -> Put
P.putWord64be forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall word float. (Storable word, Storable float) => float -> word
fromFloat
putFloat64le :: Double -> P.Put
putFloat64le :: Double -> Put
putFloat64le = Word64 -> Put
P.putWord64le forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall word float. (Storable word, Storable float) => float -> word
fromFloat
floatToWord :: Float -> F.Word32
floatToWord :: Float -> Word32
floatToWord = forall word float. (Storable word, Storable float) => float -> word
fromFloat
wordToFloat :: F.Word32 -> Float
wordToFloat :: Word32 -> Float
wordToFloat = forall word float. (Storable word, Storable float) => word -> float
toFloat
doubleToWord :: Double -> F.Word64
doubleToWord :: Double -> Word64
doubleToWord = forall word float. (Storable word, Storable float) => float -> word
fromFloat
wordToDouble :: F.Word64 -> Double
wordToDouble :: Word64 -> Double
wordToDouble = forall word float. (Storable word, Storable float) => word -> float
toFloat
toFloat :: (F.Storable word, F.Storable float) => word -> float
toFloat :: forall word float. (Storable word, Storable float) => word -> float
toFloat word
word = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr float
buf -> do
forall a. Storable a => Ptr a -> a -> IO ()
F.poke (forall a b. Ptr a -> Ptr b
F.castPtr Ptr float
buf) word
word
forall a. Storable a => Ptr a -> IO a
F.peek Ptr float
buf
fromFloat :: (F.Storable word, F.Storable float) => float -> word
fromFloat :: forall word float. (Storable word, Storable float) => float -> word
fromFloat float
float = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca forall a b. (a -> b) -> a -> b
$ \Ptr word
buf -> do
forall a. Storable a => Ptr a -> a -> IO ()
F.poke (forall a b. Ptr a -> Ptr b
F.castPtr Ptr word
buf) float
float
forall a. Storable a => Ptr a -> IO a
F.peek Ptr word
buf
toFloat16 :: F.Word16 -> Float
toFloat16 :: Word16 -> Float
toFloat16 Word16
word16 = forall word float. (Storable word, Storable float) => word -> float
toFloat (Word32
sign32 forall a. Bits a => a -> a -> a
.|. Word32
word32) where
sign16 :: Word16
sign16 = Word16
word16 forall a. Bits a => a -> a -> a
.&. Word16
0x8000
exp16 :: Word16
exp16 = Word16
word16 forall a. Bits a => a -> a -> a
.&. Word16
0x7C00
frac16 :: Word16
frac16 = Word16
word16 forall a. Bits a => a -> a -> a
.&. Word16
0x3FF
sign32 :: Word32
sign32 = if Word16
sign16 forall a. Ord a => a -> a -> Bool
> Word16
0
then Word32
0x80000000
else Word32
0
word32 :: F.Word32
word32 :: Word32
word32 | Word16
word16 forall a. Bits a => a -> a -> a
.&. Word16
0x7FFF forall a. Eq a => a -> a -> Bool
== Word16
0 = Word32
0
| Word16
exp16 forall a. Eq a => a -> a -> Bool
== Word16
0x7C00 = Word32
special
| Bool
otherwise = forall a. Bits a => a -> Int -> a
shiftL Word32
exp32 Int
23 forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL Word32
frac32 Int
13
special :: Word32
special = if Word16
frac16 forall a. Eq a => a -> a -> Bool
== Word16
0
then Word32
0x7F800000
else Word32
0x7FC00000 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
frac16
(Word32
exp32, Word32
frac32) = if Word16
exp16 forall a. Ord a => a -> a -> Bool
> Word16
0
then (Word32, Word32)
normalised
else (Word32, Word32)
denormalised
normalised :: (Word32, Word32)
normalised = (Word32
exp, Word32
frac) where
exp :: Word32
exp = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
exp16 forall a. Bits a => a -> Int -> a
`shiftR` Int
10) forall a. Num a => a -> a -> a
- Word32
15 forall a. Num a => a -> a -> a
+ Word32
127
frac :: Word32
frac = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
frac16
denormalised :: (Word32, Word32)
denormalised = (Word32
exp, Word32
frac) where
exp :: Word32
exp = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
exp16 forall a. Bits a => a -> Int -> a
`shiftR` Int
10) forall a. Num a => a -> a -> a
- Word32
15 forall a. Num a => a -> a -> a
+ Word32
127 forall a. Num a => a -> a -> a
- Word32
e
(Word32
e, Word32
frac ) = forall {a} {b} {a}.
(Bits a, Bits b, Integral a, Num a, Num b) =>
a -> a -> (a, b)
step Word32
0 (forall a. Bits a => a -> Int -> a
shiftL Word16
frac16 Int
1) where
step :: a -> a -> (a, b)
step a
acc a
x = if a
x forall a. Bits a => a -> a -> a
.&. a
0x400 forall a. Eq a => a -> a -> Bool
== a
0
then a -> a -> (a, b)
step (a
acc forall a. Num a => a -> a -> a
+ a
1) (forall a. Bits a => a -> Int -> a
shiftL a
x Int
1)
else (a
acc, forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x forall a. Bits a => a -> a -> a
.&. b
0x3FF)