reinterpret-cast-0.1.0/0000755000000000000000000000000012330207305013164 5ustar0000000000000000reinterpret-cast-0.1.0/reinterpret-cast.cabal0000644000000000000000000000371312330207305017447 0ustar0000000000000000name: reinterpret-cast version: 0.1.0 license: MIT copyright: 2014 Niklas Hambüchen author: Niklas Hambüchen maintainer: Niklas Hambüchen category: Data build-type: Simple stability: experimental tested-with: GHC==7.6.3 cabal-version: >= 1.8 homepage: https://github.com/nh2/reinterpret-cast bug-reports: https://github.com/nh2/reinterpret-cast/issues synopsis: Memory reinterpretation casts for Float/Double and Word32/Word64 description: Memory reinterpretation casts for Float\/Double and Word32\/Word64. . The implementations in the @.Internal@ package are different ways to tackle the problem; the @array@ method (current default) is about 5 times faster than the @FFI@ method. source-repository head type: git location: git://github.com/nh2/reinterpret-cast.git library exposed-modules: Data.ReinterpretCast -- Internal Data.ReinterpretCast.Internal.ImplArray Data.ReinterpretCast.Internal.ImplFFI hs-source-dirs: src build-depends: base >= 4 && < 5 , array >= 0.4.0.1 ghc-options: -- -O2 actually matters here: -- * 10% performance difference for the 'array' method -- * 20% performance difference for the 'FFI' method -Wall -O2 test-suite tests type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs build-depends: base >= 4 && < 5 , reinterpret-cast , data-binary-ieee754 >= 0.4.4 , loop >= 0.2.0 , hspec >= 1.3.0.1 ghc-options: -Wall -O2 benchmark bench type: exitcode-stdio-1.0 hs-source-dirs: bench main-is: Bench.hs build-depends: base >= 4 && < 5 , reinterpret-cast , criterion >= 0.6.0.0 , data-binary-ieee754 >= 0.4.4 ghc-options: -- See notes in the 'library' section for use of -O2 -Wall -O2 reinterpret-cast-0.1.0/Setup.hs0000644000000000000000000000005612330207305014621 0ustar0000000000000000import Distribution.Simple main = defaultMain reinterpret-cast-0.1.0/test/0000755000000000000000000000000012330207305014143 5ustar0000000000000000reinterpret-cast-0.1.0/test/Main.hs0000644000000000000000000000334412330207305015367 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} import Control.Loop (numLoop) import Control.Monad import Data.Word import Test.Hspec import qualified Data.ReinterpretCast as Current import qualified Data.ReinterpretCast.Internal.ImplArray as Array import qualified Data.ReinterpretCast.Internal.ImplFFI as FFI -- Keep comparing against the data-binary-ieee754 package in case that changes. import qualified Data.Binary.IEEE754 as IEEE main :: IO () main = hspec $ do describe "Current" $ do it "wordToFloat" $ do Current.wordToFloat 1 `shouldBe` 1.0e-45 describe "exhaustive testing (~ 2 minutes per test)" $ do it "Word32 / float" $ do numLoop 0 (maxBound :: Word32) $ \w -> when (Current.floatToWord (Current.wordToFloat w) /= w) $ expectationFailure $ "Failed: " ++ show w describe "Comparing implementations" $ do let n32 = 1000000 :: Word32 it ("[0.." ++ show n32 ++ "] Word32 / float") $ do numLoop 0 n32 $ \w -> do let f = IEEE.wordToFloat w when (f /= Current.wordToFloat w) $ expectationFailure $ "Current failed: " ++ show w when (f /= Array.wordToFloat w) $ expectationFailure $ "Array failed: " ++ show w when (f /= FFI.wordToFloat w) $ expectationFailure $ "FFI failed: " ++ show w let n64 = 1000000 :: Word64 it ("[0.." ++ show n64 ++ "] Word64 / double") $ do numLoop 0 n64 $ \w -> do let f = IEEE.wordToDouble w when (f /= Current.wordToDouble w) $ expectationFailure $ "Current failed: " ++ show w when (f /= Array.wordToDouble w) $ expectationFailure $ "Array failed: " ++ show w when (f /= FFI.wordToDouble w) $ expectationFailure $ "FFI failed: " ++ show w reinterpret-cast-0.1.0/src/0000755000000000000000000000000012330207305013753 5ustar0000000000000000reinterpret-cast-0.1.0/src/Data/0000755000000000000000000000000012330207305014624 5ustar0000000000000000reinterpret-cast-0.1.0/src/Data/ReinterpretCast.hs0000644000000000000000000000101212330207305020270 0ustar0000000000000000-- | Memory reinterpretation casts for Float\/Double and Word32\/Word64. -- -- Currently we use the 'array' method from . -- -- If you need something like `Int32` or similar, `fromIntegral` will do the job -- within the integral types (so to/from @Word*@ are the only conversions needed). module Data.ReinterpretCast ( Impl.floatToWord , Impl.wordToFloat , Impl.doubleToWord , Impl.wordToDouble ) where import qualified Data.ReinterpretCast.Internal.ImplArray as Impl reinterpret-cast-0.1.0/src/Data/ReinterpretCast/0000755000000000000000000000000012330207305017742 5ustar0000000000000000reinterpret-cast-0.1.0/src/Data/ReinterpretCast/Internal/0000755000000000000000000000000012330207305021516 5ustar0000000000000000reinterpret-cast-0.1.0/src/Data/ReinterpretCast/Internal/ImplFFI.hs0000644000000000000000000000243512330207305023304 0ustar0000000000000000-- | This is the 'FFI' approach. -- -- Implements casting via the FFI, using `alloca` like in -- . 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 = fromFloat {-# INLINABLE floatToWord #-} -- | Reinterpret-casts a `F.Word32` to a `Float`. wordToFloat :: F.Word32 -> Float wordToFloat = toFloat {-# INLINABLE wordToFloat #-} -- | Reinterpret-casts a `Double` to a `F.Word64`. doubleToWord :: Double -> F.Word64 doubleToWord = fromFloat {-# INLINABLE doubleToWord #-} -- | Reinterpret-casts a `F.Word64` to a `Double`. wordToDouble :: F.Word64 -> Double wordToDouble = toFloat {-# INLINABLE wordToDouble #-} toFloat :: (F.Storable word, F.Storable float) => word -> float toFloat word = unsafePerformIO $ F.alloca $ \buf -> do F.poke (F.castPtr buf) word F.peek buf {-# INLINE toFloat #-} fromFloat :: (F.Storable word, F.Storable float) => float -> word fromFloat float = unsafePerformIO $ F.alloca $ \buf -> do F.poke (F.castPtr buf) float F.peek buf {-# INLINE fromFloat #-} reinterpret-cast-0.1.0/src/Data/ReinterpretCast/Internal/ImplArray.hs0000644000000000000000000000233212330207305023752 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} -- | This is the 'array' approach. -- -- Implements casting via a 1-elemnt STUArray, as described in -- . module Data.ReinterpretCast.Internal.ImplArray ( floatToWord , wordToFloat , doubleToWord , wordToDouble ) where import Data.Word (Word32, Word64) import Data.Array.ST (newArray, readArray, MArray, STUArray) import Data.Array.Unsafe (castSTUArray) import GHC.ST (runST, ST) -- | Reinterpret-casts a `Float` to a `Word32`. floatToWord :: Float -> Word32 floatToWord x = runST (cast x) {-# INLINEABLE floatToWord #-} -- | Reinterpret-casts a `Word32` to a `Float`. wordToFloat :: Word32 -> Float wordToFloat x = runST (cast x) {-# INLINEABLE wordToFloat #-} -- | Reinterpret-casts a `Double` to a `Word64`. doubleToWord :: Double -> Word64 doubleToWord x = runST (cast x) {-# INLINEABLE doubleToWord #-} -- | Reinterpret-casts a `Word64` to a `Double`. wordToDouble :: Word64 -> Double wordToDouble x = runST (cast x) {-# INLINEABLE wordToDouble #-} {-# INLINE cast #-} cast :: (MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) => a -> ST s b cast x = newArray (0 :: Int, 0) x >>= castSTUArray >>= flip readArray 0 reinterpret-cast-0.1.0/bench/0000755000000000000000000000000012330207305014243 5ustar0000000000000000reinterpret-cast-0.1.0/bench/Bench.hs0000644000000000000000000000304112330207305015614 0ustar0000000000000000module Main (main) where import Criterion.Main import qualified Data.ReinterpretCast as Current import qualified Data.ReinterpretCast.Internal.ImplArray as FC import qualified Data.ReinterpretCast.Internal.ImplFFI as FFI -- Keep comparing against the data-binary-ieee754 package in case that changes. import qualified Data.Binary.IEEE754 as IEEE main :: IO () main = do defaultMain [ bgroup "w2f" [ bench "current" $ whnf Current.wordToFloat 1 , bench "array" $ whnf FC.wordToFloat 1 , bench "FFI" $ whnf FFI.wordToFloat 1 , bench "ieee" $ whnf IEEE.wordToFloat 1 ] , bgroup "f2w" [ bench "current" $ whnf Current.floatToWord 1.0 , bench "array" $ whnf FC.floatToWord 1.0 , bench "FFI" $ whnf FFI.floatToWord 1.0 , bench "ieee" $ whnf IEEE.floatToWord 1.0 ] , bgroup "w2d" [ bench "current" $ whnf Current.wordToDouble 1 , bench "array" $ whnf FC.wordToDouble 1 , bench "FFI" $ whnf FFI.wordToDouble 1 , bench "ieee" $ whnf IEEE.wordToDouble 1 ] , bgroup "d2w" [ bench "current" $ whnf Current.doubleToWord 1.0 , bench "array" $ whnf FC.doubleToWord 1.0 , bench "FFI" $ whnf FFI.doubleToWord 1.0 , bench "ieee" $ whnf IEEE.doubleToWord 1.0 ] ]