{-# 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
  | forall a. FixedPrim a -> Int
size FixedPrim Word32
w32fe forall a. Ord a => a -> a -> Bool
< forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: Float) =
      forall a. HasCallStack => [Char] -> a
error [Char]
"encodeFloatViaWord32F: encoding not wide enough"
  | Bool
otherwise = forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
fixedPrim (forall a. FixedPrim a -> Int
size FixedPrim Word32
w32fe) forall a b. (a -> b) -> a -> b
$ \Float
x Ptr Word8
op -> do
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
op) Float
x
      Word32
x' <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
op)
      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
  | forall a. FixedPrim a -> Int
size FixedPrim Word64
w64fe forall a. Ord a => a -> a -> Bool
< forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: Float) =
      forall a. HasCallStack => [Char] -> a
error [Char]
"encodeDoubleViaWord64F: encoding not wide enough"
  | Bool
otherwise = forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
fixedPrim (forall a. FixedPrim a -> Int
size FixedPrim Word64
w64fe) forall a b. (a -> b) -> a -> b
$ \Double
x Ptr Word8
op -> do
      forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
op) Double
x
      Word64
x' <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
op)
      forall a. FixedPrim a -> a -> Ptr Word8 -> IO ()
runF FixedPrim Word64
w64fe Word64
x' Ptr Word8
op