-- | This is the 'FFI' approach.
--
-- Implements casting via the FFI, using `alloca` like in
-- <http://hackage.haskell.org/package/data-binary-ieee754>.
module Data.ReinterpretCast.Internal.ImplFFI
  ( floatToWord
  , wordToFloat
  , doubleToWord
  , wordToDouble
  ) where

import qualified Foreign as F
import           System.IO.Unsafe (unsafePerformIO)


-- | Reinterpret-casts a `Float` to a `F.Word32`.
floatToWord :: Float -> F.Word32
floatToWord :: Float -> Word32
floatToWord = Float -> Word32
forall word float. (Storable word, Storable float) => float -> word
fromFloat

{-# INLINABLE floatToWord #-}


-- | Reinterpret-casts a `F.Word32` to a `Float`.
wordToFloat :: F.Word32 -> Float
wordToFloat :: Word32 -> Float
wordToFloat = Word32 -> Float
forall word float. (Storable word, Storable float) => word -> float
toFloat

{-# INLINABLE wordToFloat #-}


-- | Reinterpret-casts a `Double` to a `F.Word64`.
doubleToWord :: Double -> F.Word64
doubleToWord :: Double -> Word64
doubleToWord = Double -> Word64
forall word float. (Storable word, Storable float) => float -> word
fromFloat

{-# INLINABLE doubleToWord #-}


-- | Reinterpret-casts a `F.Word64` to a `Double`.
wordToDouble :: F.Word64 -> Double
wordToDouble :: Word64 -> Double
wordToDouble = Word64 -> Double
forall word float. (Storable word, Storable float) => word -> float
toFloat

{-# INLINABLE wordToDouble #-}


toFloat :: (F.Storable word, F.Storable float) => word -> float
toFloat :: 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

{-# INLINE toFloat #-}


fromFloat :: (F.Storable word, F.Storable float) => float -> word
fromFloat :: 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

{-# INLINE fromFloat #-}