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