{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
-- |
-- Copyright   : (c) 2010 Simon Meier
--
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Simon Meier <iridcode@gmail.com>
-- Stability   : experimental
-- Portability : GHC
--
-- Conversion of 'Float's and 'Double's to 'Word32's and 'Word64's.
--
module Data.ByteString.Builder.Prim.Internal.Floating
    (
      -- coerceFloatToWord32
    -- , coerceDoubleToWord64
    encodeFloatViaWord32F
  , encodeDoubleViaWord64F
  ) where

import Foreign
import Data.ByteString.Builder.Prim.Internal

{-
We work around ticket http://ghc.haskell.org/trac/ghc/ticket/4092 using the
FFI to store the Float/Double in the buffer and peek it out again from there.
-}


-- | Encode a 'Float' using a 'Word32' encoding.
--
-- PRE: The 'Word32' encoding must have a size of at least 4 bytes.
{-# INLINE encodeFloatViaWord32F #-}
encodeFloatViaWord32F :: FixedPrim Word32 -> FixedPrim Float
encodeFloatViaWord32F :: FixedPrim Word32 -> FixedPrim Float
encodeFloatViaWord32F FixedPrim Word32
w32fe
  | FixedPrim Word32 -> Int
forall a. FixedPrim a -> Int
size FixedPrim Word32
w32fe Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) =
      [Char] -> FixedPrim Float
forall a. HasCallStack => [Char] -> a
error [Char]
"encodeFloatViaWord32F: encoding not wide enough"
  | Bool
otherwise = Int -> (Float -> Ptr Word8 -> IO ()) -> FixedPrim Float
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
fixedPrim (FixedPrim Word32 -> Int
forall a. FixedPrim a -> Int
size FixedPrim Word32
w32fe) ((Float -> Ptr Word8 -> IO ()) -> FixedPrim Float)
-> (Float -> Ptr Word8 -> IO ()) -> FixedPrim Float
forall a b. (a -> b) -> a -> b
$ \Float
x Ptr Word8
op -> do
      Ptr Float -> Float -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8 -> Ptr Float
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
op) Float
x
      Word32
x' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
op)
      FixedPrim Word32 -> Word32 -> Ptr Word8 -> IO ()
forall a. FixedPrim a -> a -> Ptr Word8 -> IO ()
runF FixedPrim Word32
w32fe Word32
x' Ptr Word8
op

-- | Encode a 'Double' using a 'Word64' encoding.
--
-- PRE: The 'Word64' encoding must have a size of at least 8 bytes.
{-# INLINE encodeDoubleViaWord64F #-}
encodeDoubleViaWord64F :: FixedPrim Word64 -> FixedPrim Double
encodeDoubleViaWord64F :: FixedPrim Word64 -> FixedPrim Double
encodeDoubleViaWord64F FixedPrim Word64
w64fe
  | FixedPrim Word64 -> Int
forall a. FixedPrim a -> Int
size FixedPrim Word64
w64fe Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Float -> Int
forall a. Storable a => a -> Int
sizeOf (Float
forall a. HasCallStack => a
undefined :: Float) =
      [Char] -> FixedPrim Double
forall a. HasCallStack => [Char] -> a
error [Char]
"encodeDoubleViaWord64F: encoding not wide enough"
  | Bool
otherwise = Int -> (Double -> Ptr Word8 -> IO ()) -> FixedPrim Double
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
fixedPrim (FixedPrim Word64 -> Int
forall a. FixedPrim a -> Int
size FixedPrim Word64
w64fe) ((Double -> Ptr Word8 -> IO ()) -> FixedPrim Double)
-> (Double -> Ptr Word8 -> IO ()) -> FixedPrim Double
forall a b. (a -> b) -> a -> b
$ \Double
x Ptr Word8
op -> do
      Ptr Double -> Double -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8 -> Ptr Double
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
op) Double
x
      Word64
x' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
op)
      FixedPrim Word64 -> Word64 -> Ptr Word8 -> IO ()
forall a. FixedPrim a -> a -> Ptr Word8 -> IO ()
runF FixedPrim Word64
w64fe Word64
x' Ptr Word8
op