packages feed

sample-frame 0.0.1 → 0.0.2

raw patch · 7 files changed

+391/−25 lines, 7 filesdep +storable-tupledep +storablevectordep ~QuickCheckdep ~storable-recordnew-component:exe:speedtest

Dependencies added: storable-tuple, storablevector

Dependency ranges changed: QuickCheck, storable-record

Files

sample-frame.cabal view
@@ -1,5 +1,5 @@ Name:             sample-frame-Version:          0.0.1+Version:          0.0.2 License:          BSD3 License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -13,25 +13,29 @@    to handle signed and unsigned samples    of various size and number of channels in a uniform way.    .-   We expect that you use the types Int8, Word8 and so on+   We expect that you use the types 'Int8', 'Word8' and so on    for monophonic samples and thus provide instances of the class for them.    Further we define Stereo record and mu-law sample type.    Quadrophony can be achieved by nested Stereo value,    but I'm uncertain, whether this is a good way to go.    Maybe we add 5+1 channels or so in future.    .-   This is used by packages sox, alsa, synthesizer.+   This is used by packages @sox@, @alsa@, @synthesizer@. Tested-With:       GHC==6.10.4 Cabal-Version:     >=1.2 Build-Type:        Simple +Flag buildBenchmarks+  description: Build benchmark executables+  default:     False+ Flag splitBase   description: Choose the new smaller, split-up base package.  Library   Build-Depends:-    storable-record >=0.0.1 && <0.1,-    QuickCheck >= 1.0 && <2.0+    storable-record >=0.0.2 && <0.1,+    QuickCheck >= 1.0 && <3.0   If flag(splitBase)     Build-Depends:       base >= 2 && <5@@ -48,3 +52,19 @@     Sound.Frame     Sound.Frame.Stereo     Sound.Frame.MuLaw++Executable speedtest+  If flag(buildBenchmarks)+    Build-Depends:+      storablevector >=0.2.4 && <0.3,+      storable-record >=0.0.2 && <0.1,+      storable-tuple >=0.0.1 && <0.1+  Else+    Buildable: False+  GHC-Options: -Wall -fexcess-precision -threaded+-- -ddump-simpl-stats -ddump-asm+  Hs-Source-Dirs: src+  Main-Is: SpeedTest.hs+  Other-Modules:+    Sound.Frame.Stereo.Record+    Sound.Frame.Stereo.Traversable
src/Sound/Frame.hs view
@@ -1,10 +1,24 @@-module Sound.Frame where+module Sound.Frame+   (C(..),+   numberOfChannelsFoldable,+   sizeOfElementFoldable,+   sizeOfElementType,+   paddedSizeOf,+   withSignal,+   ) where  import Data.Word (Word8, Word16, Word32, ) import Data.Int (Int8, Int16, Int32, )-import Foreign.Storable (sizeOf, )+import Foreign.Storable (Storable, sizeOf, alignment, ) +import qualified Data.Foldable as Fold ++{- |+This is a class for nested tuples used as sample frames.++Should we make Storable a superclass of 'C'?+-} class C y where    {- | The argument is not touched and can be undefined -}    numberOfChannels :: y -> Int@@ -12,9 +26,41 @@    Size of elements.    In a nested record type, like @Stereo (Stereo a)@,    it is the size of the atomic element, in our example @a@.+   We assume that the atomic element values all have the same size,+   such that @sizeOfElement undefined@ is defined.    -}    sizeOfElement :: y -> Int +{- |+Default implementations for a foldable Frame.+-}+numberOfChannelsFoldable ::+   (C y, Fold.Foldable f) => f y -> Int+numberOfChannelsFoldable =+   Fold.foldl' (\n y -> n + numberOfChannels y) 0+--   Fold.sum . fmap numberOfChannels++sizeOfElementFoldable ::+   (C y, Fold.Foldable f) => f y -> Int+sizeOfElementFoldable =+   sizeOfElement . head . Fold.toList++{- |+Returns the size of an undefined element.+This might be more efficient than 'sizeOfElementFoldable'.+-}+sizeOfElementType ::+   (C y) => f y -> Int+sizeOfElementType =+   sizeOfElement . elementType+++{-# INLINE elementType #-}+elementType :: f a -> a+elementType _ =+   error "Sound.Frame.sizeOfElement may not depend on element values"++ instance C Word8 where    numberOfChannels _ = 1    sizeOfElement = sizeOf@@ -48,5 +94,15 @@    sizeOfElement = sizeOf  +{- |+Space that an element consumes in a Storable Array.+This is space for the element plus padding.+-}+-- cf. storable-record:FixedArray.roundUp+paddedSizeOf :: Storable a => a -> Int+paddedSizeOf x =+   sizeOf x + mod (- sizeOf x) (alignment x)++ withSignal :: (y -> a) -> (sig y -> a)-withSignal f _ = f undefined+withSignal f _ = f (error "Frame: dummy signal parameter touched")
src/Sound/Frame/MuLaw.hs view
@@ -11,7 +11,7 @@ import Data.Word (Word8, ) import Data.Int (Int16, ) -import Test.QuickCheck (Arbitrary(arbitrary, coarbitrary), )+import Test.QuickCheck (Arbitrary(arbitrary), )  import Prelude hiding (map, ) @@ -27,7 +27,6 @@  instance Arbitrary T where    arbitrary = fmap (cons . fromIntegral :: Int -> T) arbitrary-   coarbitrary = error "MuLaw.coarbitrary not implemented"   {-# INLINE cons #-}
src/Sound/Frame/Stereo.hs view
@@ -5,13 +5,16 @@  import qualified Sound.Frame as Frame -import Control.Applicative (liftA2, )+import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold++import Control.Applicative (Applicative, pure, (<*>), liftA2, ) import Control.Monad (liftM2, ) -import Foreign.Storable.Record as Store import Foreign.Storable (Storable (..), )+import Foreign.Ptr (Ptr, castPtr, ) -import Test.QuickCheck (Arbitrary(arbitrary, coarbitrary), )+import Test.QuickCheck (Arbitrary(arbitrary), )  import Prelude hiding (map, ) @@ -28,7 +31,6 @@  instance (Arbitrary a) => Arbitrary (T a) where    arbitrary = liftM2 cons arbitrary arbitrary-   coarbitrary = error "Stereo.coarbitrary not implemented"   {-# INLINE cons #-}@@ -43,24 +45,44 @@    {-# INLINE fmap #-}    fmap = map +-- useful for defining Additive instance+instance Applicative T where+   {-# INLINE pure #-}+   pure a = Cons a a+   {-# INLINE (<*>) #-}+   Cons fl fr <*> Cons l r = Cons (fl l) (fr r) -{-# INLINE store #-}-store :: Storable a => Store.Dictionary (T a)-store =-   Store.run $-   liftA2 Cons-      (Store.element left)-      (Store.element right)+instance Fold.Foldable T where+   {-# INLINE foldMap #-}+   foldMap = Trav.foldMapDefault +-- this allows for kinds of generic programming+instance Trav.Traversable T where+   {-# INLINE sequenceA #-}+   sequenceA ~(Cons l r) = liftA2 Cons l r++++{-# INLINE castToElemPtr #-}+castToElemPtr :: Ptr (T a) -> Ptr a+castToElemPtr = castPtr+ instance (Storable a) => Storable (T a) where    {-# INLINE sizeOf #-}-   sizeOf = Store.sizeOf store    {-# INLINE alignment #-}-   alignment = Store.alignment store    {-# INLINE peek #-}-   peek = Store.peek store    {-# INLINE poke #-}-   poke = Store.poke store+   -- cf. storable-record:FixedArray.roundUp+   sizeOf ~(Cons l r) =+      sizeOf l + mod (- sizeOf l) (alignment r) + sizeOf r+   alignment ~(Cons l _) = alignment l+   poke p (Cons l r) =+      let q = castToElemPtr p+      in  poke q l >> pokeElemOff q 1 r+   peek p =+      let q = castToElemPtr p+      in  liftM2 Cons+             (peek q) (peekElemOff q 1)   instance Frame.C a => Frame.C (T a) where
+ src/Sound/Frame/Stereo/Record.hs view
@@ -0,0 +1,88 @@+{-+This data type can be used as sample type for stereo signals.+-}+module Sound.Frame.Stereo.Record (T, left, right, cons, map, ) where++import qualified Sound.Frame as Frame++import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold++import Control.Applicative (Applicative, pure, (<*>), liftA2, )+import Control.Monad (liftM2, )++import Foreign.Storable.Record as Store+import Foreign.Storable (Storable (..), )++import Test.QuickCheck (Arbitrary(arbitrary), )++import Prelude hiding (map, )+++data T a = Cons {left, right :: !a}+   deriving (Eq)+++instance Show a => Show (T a) where+   showsPrec p x =+      showParen (p >= 10)+         (showString "Stereo.cons " . showsPrec 11 (left x) .+          showString " " . showsPrec 11 (right x))++instance (Arbitrary a) => Arbitrary (T a) where+   arbitrary = liftM2 cons arbitrary arbitrary+++{-# INLINE cons #-}+cons :: a -> a -> T a+cons = Cons++{-# INLINE map #-}+map :: (a -> b) -> T a -> T b+map f (Cons l r) = Cons (f l) (f r)++instance Functor T where+   {-# INLINE fmap #-}+   fmap = map++-- useful for defining Additive instance+instance Applicative T where+   {-# INLINE pure #-}+   pure a = Cons a a+   {-# INLINE (<*>) #-}+   Cons fl fr <*> Cons l r = Cons (fl l) (fr r)++instance Fold.Foldable T where+   {-# INLINE foldMap #-}+   foldMap = Trav.foldMapDefault++-- this allows for kinds of generic programming+instance Trav.Traversable T where+   {-# INLINE sequenceA #-}+   sequenceA ~(Cons l r) = liftA2 Cons l r+++{-# INLINE store #-}+store :: Storable a => Store.Dictionary (T a)+store =+   Store.run $+   liftA2 Cons+      (Store.element left)+      (Store.element right)++instance (Storable a) => Storable (T a) where+   {-# INLINE sizeOf #-}+   sizeOf = Store.sizeOf store+   {-# INLINE alignment #-}+   alignment = Store.alignment store+   {-# INLINE peek #-}+   peek = Store.peek store+   {-# INLINE poke #-}+   poke = Store.poke store+++instance Frame.C a => Frame.C (T a) where+   {-# INLINE numberOfChannels #-}+   numberOfChannels y = 2 * Frame.numberOfChannels (left y)+   {-# INLINE sizeOfElement #-}+   sizeOfElement = Frame.sizeOfElement . left
+ src/Sound/Frame/Stereo/Traversable.hs view
@@ -0,0 +1,80 @@+{-+This data type can be used as sample type for stereo signals.+-}+module Sound.Frame.Stereo.Traversable (T, left, right, cons, map, ) where++import qualified Sound.Frame as Frame++import qualified Data.Traversable as Trav+import qualified Data.Foldable as Fold++import Control.Applicative (Applicative, pure, (<*>), liftA2, )+import Control.Monad (liftM2, )++import Foreign.Storable.Traversable as Store+import Foreign.Storable (Storable (..), )++import Test.QuickCheck (Arbitrary(arbitrary), )++import Prelude hiding (map, )+++data T a = Cons {left, right :: !a}+   deriving (Eq)+++instance Show a => Show (T a) where+   showsPrec p x =+      showParen (p >= 10)+         (showString "Stereo.cons " . showsPrec 11 (left x) .+          showString " " . showsPrec 11 (right x))++instance (Arbitrary a) => Arbitrary (T a) where+   arbitrary = liftM2 cons arbitrary arbitrary+++{-# INLINE cons #-}+cons :: a -> a -> T a+cons = Cons++{-# INLINE map #-}+map :: (a -> b) -> T a -> T b+map f ~(Cons l r) = Cons (f l) (f r)++instance Functor T where+   {-# INLINE fmap #-}+   fmap = map++-- useful for defining Additive instance+instance Applicative T where+   {-# INLINE pure #-}+   pure a = Cons a a+   {-# INLINE (<*>) #-}+   ~(Cons fl fr) <*> ~(Cons l r) = Cons (fl l) (fr r)++instance Fold.Foldable T where+   {-# INLINE foldMap #-}+   foldMap = Trav.foldMapDefault++-- this allows for kinds of generic programming+instance Trav.Traversable T where+   {-# INLINE sequenceA #-}+   sequenceA ~(Cons l r) = liftA2 Cons l r+++instance (Storable a) => Storable (T a) where+   {-# INLINE sizeOf #-}+   sizeOf = Store.sizeOf+   {-# INLINE alignment #-}+   alignment = Store.alignment+   {-# INLINE peek #-}+   peek = Store.peek (error "instance Traversable Stereo is lazy, so we do not provide a real value here")+   {-# INLINE poke #-}+   poke = Store.poke+++instance Frame.C a => Frame.C (T a) where+   {-# INLINE numberOfChannels #-}+   numberOfChannels = Frame.numberOfChannelsFoldable+   {-# INLINE sizeOfElement #-}+   sizeOfElement = Frame.sizeOfElementType
+ src/SpeedTest.hs view
@@ -0,0 +1,101 @@+{-# OPTIONS_GHC -funbox-strict-fields -ddump-simpl -ddump-simpl-stats -O #-}+{-  -dverbose-core2core -ddump-simpl-iterations -}+{-+This module allows to compare speed of custom Storable instance of Stereo+versus the ones implemented using Storable.Record and Storable.Traversable.+-}+module Main where++-- import qualified Sound.Frame.Stereo as Stereo+import qualified Sound.Frame.Stereo.Traversable as Stereo+-- import qualified Sound.Frame.Stereo.Record as Stereo+import qualified Data.StorableVector as SV++import Control.Applicative (pure, liftA2, )++import Foreign.Storable.Tuple ()++import Data.Int (Int16)++import GHC.Float (float2Int, )+++{-+GHC-6.10.4:++Custom Storable instance:+real    0m0.680s+user    0m0.560s+sys     0m0.112s++Storable.Traversable instance:+real    0m25.187s+user    0m25.014s+sys     0m0.152s++Storable.Record instance:+real    0m3.017s+user    0m2.844s+sys     0m0.168s+-}+stereo :: SV.Vector (Stereo.T Int16)+stereo =+   fst $ SV.unfoldrN 10000000+      (\x0 ->+          let frac x = x - fromIntegral (float2Int x)+              x1 = frac (x0+440/44100)+              y0 = 2*x0-1+              toInt16 y =+                 fromIntegral $+                 float2Int (y*fromIntegral(maxBound::Int16))+          in  Just (Stereo.cons (toInt16 y0) (toInt16 y0), x1))+      (0::Float)++{-+GHC-6.10.4:++Custom Storable instance:+real    0m0.698s+user    0m0.668s+sys     0m0.032s++Storable.Traversable instance:+real    0m47.012s+user    0m46.839s+sys     0m0.164s++Storable.Record instance:+real    0m4.382s+user    0m4.336s+sys     0m0.044s+++GHC-6.12.1:++Storable.Traversable instance:+real    0m47.021s+user    0m46.827s+sys     0m0.108s+-}+stereoSum :: SV.Vector (Stereo.T Int16) -> Stereo.T Int16+stereoSum =+   SV.foldl' (liftA2 (+)) (pure 0)++stereoPair :: SV.Vector (Int16,Int16)+stereoPair =+   fst $ SV.unfoldrN 10000000+      (\x0 ->+          let frac x = x - fromIntegral (float2Int x)+              x1 = frac (x0+440/44100)+              y0 = 2*x0-1+              toInt16 y =+                 fromIntegral $+                 float2Int (y*fromIntegral(maxBound::Int16))+          in  Just ((toInt16 y0, toInt16 y0), x1))+      (0::Float)+++main :: IO ()+main =+   print $ stereoSum stereo+--   SV.writeFile "speed.s16" stereo