reinterpret-cast (empty) → 0.1.0
raw patch · 7 files changed
+285/−0 lines, 7 filesdep +arraydep +basedep +criterionsetup-changed
Dependencies added: array, base, criterion, data-binary-ieee754, hspec, loop, reinterpret-cast
Files
- Setup.hs +2/−0
- bench/Bench.hs +36/−0
- reinterpret-cast.cabal +74/−0
- src/Data/ReinterpretCast.hs +14/−0
- src/Data/ReinterpretCast/Internal/ImplArray.hs +51/−0
- src/Data/ReinterpretCast/Internal/ImplFFI.hs +57/−0
- test/Main.hs +51/−0
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Bench.hs view
@@ -0,0 +1,36 @@+module 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+ ]+ ]
+ reinterpret-cast.cabal view
@@ -0,0 +1,74 @@+name: reinterpret-cast+version: 0.1.0+license: MIT+copyright: 2014 Niklas Hambüchen <mail@nh2.me>+author: Niklas Hambüchen <mail@nh2.me>+maintainer: Niklas Hambüchen <mail@nh2.me>+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
+ src/Data/ReinterpretCast.hs view
@@ -0,0 +1,14 @@+-- | Memory reinterpretation casts for Float\/Double and Word32\/Word64.+--+-- Currently we use the 'array' method from <http://stackoverflow.com/a/7002812/263061>.+--+-- 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
+ src/Data/ReinterpretCast/Internal/ImplArray.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE FlexibleContexts #-}++-- | This is the 'array' approach.+--+-- Implements casting via a 1-elemnt STUArray, as described in+-- <http://stackoverflow.com/a/7002812/263061>.+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
+ src/Data/ReinterpretCast/Internal/ImplFFI.hs view
@@ -0,0 +1,57 @@+-- | 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 = 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 #-}
+ test/Main.hs view
@@ -0,0 +1,51 @@+{-# 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