1-- see also speed test in sample-frame package 2module Main where 3 4import qualified Data.StorableVector as SV 5 6import qualified System.TimeIt as T 7 8import Foreign.Storable.Newtype as StoreNew 9import Foreign.Storable.Record as Store 10import Foreign.Storable (Storable (..), ) 11 12import Control.Applicative (liftA2, ) 13 14import Data.Word (Word8, ) 15 16 17data MonoN a = MonoN {singleN :: a} 18 deriving Show 19 20instance (Storable a) => Storable (MonoN a) where 21 {- INLINE sizeOf -} 22 sizeOf = StoreNew.sizeOf singleN 23 {- INLINE alignment -} 24 alignment = StoreNew.alignment singleN 25 {- INLINE peek -} 26 peek = StoreNew.peek MonoN 27 {- INLINE poke -} 28 poke = StoreNew.poke singleN 29 30 31newtype Mono a = Mono {single :: a} 32 deriving Show 33 34{-# INLINE storeMono #-} 35storeMono :: Storable a => Store.Dictionary (Mono a) 36storeMono = 37 Store.run $ fmap Mono $ Store.element single 38 39instance (Storable a) => Storable (Mono a) where 40 {-# INLINE sizeOf #-} 41 sizeOf = Store.sizeOf storeMono 42 {-# INLINE alignment #-} 43 alignment = Store.alignment storeMono 44 {-# INLINE peek #-} 45 peek = Store.peek storeMono 46 {-# INLINE poke #-} 47 poke = Store.poke storeMono 48 49 50data Stereo a = Stereo {left, right :: a} 51 deriving Show 52 53-- inline makes performance even worse 54{- INLINE storeStereo -} 55storeStereo :: Storable a => Store.Dictionary (Stereo a) 56storeStereo = 57 Store.run $ 58 liftA2 Stereo 59 (Store.element left) 60 (Store.element right) 61 62instance (Storable a) => Storable (Stereo a) where 63 {- INLINE sizeOf -} 64 sizeOf = Store.sizeOf storeStereo 65 {- INLINE alignment -} 66 alignment = Store.alignment storeStereo 67 {- INLINE peek -} 68 peek = Store.peek storeStereo 69 {- INLINE poke -} 70 poke = Store.poke storeStereo 71 72 73size :: Int 74size = 10000000 75 76main :: IO () 77main = mapM_ T.timeIt $ 78 (print $ SV.last $ SV.iterateN size (1+) (0::Float)) : 79 (print $ SV.last $ SV.iterateN size (1+) (0::Word8)) : 80 (print $ SV.last $ 81 SV.iterateN size (\x -> MonoN (singleN x + 1)) (MonoN (0::Float))) : 82 (print $ SV.last $ 83 SV.iterateN size (\x -> Mono (single x + 1)) (Mono (0::Float))) : 84 (print $ SV.last $ 85 SV.iterateN size (\x -> Stereo (left x + 1) (right x + 3)) 86 (Stereo 1 2 :: Stereo Float)) : 87 [] 88