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