synthesizer-core 0.8.1.2 → 0.8.2

raw patch · 13 files changed

+92/−61 lines, 13 filesdep +semigroupsdep ~utility-htPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: semigroups

Dependency ranges changed: utility-ht

API changes (from Hackage documentation)

Files

• src/Synthesizer/Causal/Process.hs +1/−2
• src/Synthesizer/CausalIO/Gate.hs +4/−0
• src/Synthesizer/CausalIO/Process.hs +30/−21
• src/Synthesizer/Generic/LengthSignal.hs +4/−0
• src/Synthesizer/Generic/Signal.hs +6/−2
• src/Synthesizer/Interpolation/Custom.hs +3/−4
• src/Synthesizer/Interpolation/Module.hs +4/−5
• src/Synthesizer/Plain/Builder.hs +5/−1
• src/Synthesizer/Plain/Filter/Recursive/SecondOrder.hs +9/−10
• src/Synthesizer/Plain/Filter/Recursive/Universal.hs +11/−12
• src/Synthesizer/State/Signal.hs +4/−0
• src/Synthesizer/Zip.hs +4/−0
• synthesizer-core.cabal +7/−4

@@ -79,7 +79,6 @@  import qualified Synthesizer.Plain.Modifier as Modifier -import qualified Data.StorableVector.Lazy as SVL import qualified Data.StorableVector as SV  import Foreign.Storable (Storable, )@@ -382,7 +381,7 @@ applyStorableChunk (Cons next start) = Cons    (\a -> StateT $ \ms ->       flip fmap ms $ \s ->-         SVL.crochetLChunk (runStateT . next) s a)+         SV.crochetLResult (runStateT . next) s a)    (Just start)  

@@ -20,6 +20,7 @@  import qualified Data.StorableVector as SV import qualified Data.Monoid as Mn+import qualified Data.Semigroup as Sg import Data.Maybe.HT (toMaybe, )  import qualified Numeric.NonNegative.Class as NonNeg@@ -60,6 +61,9 @@ instance CutG.NormalForm (Chunk a) where    evaluateHead (Chunk dur rel) =       dur `seq` rel `seq` ()++instance Sg.Semigroup (Chunk a) where+   (<>) = error "Gate.mappend cannot be defined"  instance Mn.Monoid (Chunk a) where    mempty = error "Gate.mempty cannot be defined"

@@ -40,6 +40,7 @@ import Control.Monad (mplus, )  import Data.Monoid (Monoid, mempty, mappend, )+import Data.Semigroup (Semigroup, (<>), )  import System.IO.Unsafe (unsafePerformIO, unsafeInterleaveIO, ) @@ -194,6 +195,9 @@    uncurry Zip.Cons ^<< ab &&& ac  +instance (CutG.Transform a, CutG.Read b, Semigroup b) => Semigroup (T a b) where+   (<>) = append (<>)+ {- | @mappend@ should be used sparingly. In a loop it will have to construct types at runtime@@ -204,27 +208,32 @@       (\ _a () -> return (mempty, ()))       (return ())       (\() -> return ())-   mappend-         (Cons nextX createX deleteX)-         (Cons nextY createY deleteY) = Cons-      (\a s ->-         case s of-            Left s0 -> do-               (b1,s1) <- nextX a s0-               let lenA = CutG.length a-                   lenB = CutG.length b1-               case compare lenA lenB of-                  LT -> error "CausalIO.Process.mappend: output chunk is larger than input chunk"-                  EQ -> return (b1, Left s1)-                  GT -> do-                     deleteX s1-                     (b2,s2) <- nextY (CutG.drop lenB a) =<< createY-                     return (mappend b1 b2, Right s2)-            Right s0 -> do-               (b1,s1) <- nextY a s0-               return (b1, Right s1))-      (fmap Left createX)-      (either deleteX deleteY)+   mappend = append mappend++append ::+   (CutG.Transform a, CutG.Read b) =>+   (b -> b -> b) -> T a b -> T a b -> T a b+append app+      (Cons nextX createX deleteX)+      (Cons nextY createY deleteY) = Cons+   (\a s ->+      case s of+         Left s0 -> do+            (b1,s1) <- nextX a s0+            let lenA = CutG.length a+                lenB = CutG.length b1+            case compare lenA lenB of+               LT -> error "CausalIO.Process.mappend: output chunk is larger than input chunk"+               EQ -> return (b1, Left s1)+               GT -> do+                  deleteX s1+                  (b2,s2) <- nextY (CutG.drop lenB a) =<< createY+                  return (app b1 b2, Right s2)+         Right s0 -> do+            (b1,s1) <- nextY a s0+            return (b1, Right s1))+   (fmap Left createX)+   (either deleteX deleteY)   data State a b =

@@ -6,6 +6,7 @@ import qualified Synthesizer.Generic.Cut as CutG  import Data.Monoid (Monoid, mempty, mappend, )+import Data.Semigroup (Semigroup, (<>), ) import Data.Tuple.HT (mapSnd, )  import qualified Algebra.Additive       as Additive@@ -34,6 +35,9 @@    negate xs = xs{body = SigG.map negate (body xs)}    (Cons xl xs) + (Cons yl ys) =       Cons (max xl yl) (SigG.mix xs ys)++instance (Semigroup sig) => Semigroup (T sig) where+   Cons xl xs <> Cons yl ys = Cons (xl+yl) (xs <> ys)  instance (Monoid sig) => Monoid (T sig) where    mempty = Cons zero mempty

@@ -52,6 +52,7 @@ import Data.Function (fix, ) import Data.Tuple.HT (mapPair, mapFst, fst3, snd3, thd3, ) import Data.Monoid (Monoid, mappend, mempty, )+import Data.Semigroup (Semigroup, (<>), )  import qualified Algebra.ToInteger    as ToInteger import qualified Algebra.ToRational   as ToRational@@ -148,9 +149,12 @@              ToInteger.C, ToRational.C, Absolute.C,              RealIntegral.C, Integral.C) +instance Semigroup LazySize where+   LazySize a <> LazySize b = LazySize (a + b)+ instance Monoid LazySize where    mempty = LazySize 0-   mappend (LazySize a) (LazySize b) = LazySize (a + b)+   mappend = (<>)  instance Monoid.C LazySize where    idt = LazySize 0@@ -363,7 +367,7 @@    scanL f a x = writeSV (readSV (SV.scanl f a) x)    {-# INLINE crochetL #-}    crochetL f a x =-      writeSV (fst (readSV (SVL.crochetLChunk f a) x))+      writeSV (fst (readSV (SV.crochetLResult f a) x))       -- fst . SV.crochetContL f acc    {-# INLINE zipWithAppend #-}    zipWithAppend f =

@@ -27,8 +27,7 @@  import Synthesizer.Interpolation.Class ((+.*), ) -import Control.Applicative.HT (liftA4, )-import Control.Applicative (liftA2, )+import qualified Control.Applicative.HT as App  import NumericPrelude.Numeric import NumericPrelude.Base@@ -40,7 +39,7 @@ linear :: (Interpol.C t y) => T t y linear =    fromPrefixReader "linear" 0-      (liftA2+      (App.lift2           (\x0 x1 phase -> Interpol.combine2 phase (x0,x1))           getNode getNode) @@ -57,7 +56,7 @@ {-# INLINE cubic #-} cubic :: (Field.C t, Interpol.C t y) => T t y cubic =-   fromPrefixReader "cubicAlt" 1 $ liftA4+   fromPrefixReader "cubicAlt" 1 $ App.lift4       (\xm1 x0 x1 x2 t ->        let (am1, a0, a1) = cubicHalf    t            ( b2, b1, b0) = cubicHalf (1-t)

@@ -28,8 +28,7 @@ import qualified Algebra.Module    as Module import qualified Algebra.Field     as Field -import Control.Applicative.HT (liftA4, )-import Control.Applicative (liftA2, )+import qualified Control.Applicative.HT as App  import NumericPrelude.Numeric import NumericPrelude.Base@@ -40,7 +39,7 @@ linear :: (Module.C t y) => T t y linear =    fromPrefixReader "linear" 0-      (liftA2 Core.linear getNode getNode)+      (App.lift2 Core.linear getNode getNode)  {- | Consider the signal to be piecewise cubic,@@ -56,13 +55,13 @@ cubic :: (Field.C t, Module.C t y) => T t y cubic =    fromPrefixReader "cubic" 1-      (liftA4 Core.cubic getNode getNode getNode getNode)+      (App.lift4 Core.cubic getNode getNode getNode getNode)  {-# INLINE cubicAlt #-} cubicAlt :: (Field.C t, Module.C t y) => T t y cubicAlt =    fromPrefixReader "cubicAlt" 1-      (liftA4 Core.cubicAlt getNode getNode getNode getNode)+      (App.lift4 Core.cubicAlt getNode getNode getNode getNode)   

@@ -6,6 +6,7 @@ import qualified Synthesizer.Basic.Binary as BinSmp  import Data.Monoid (Monoid, mempty, mappend, mconcat, Endo(Endo), appEndo, )+import Data.Semigroup (Semigroup, (<>), )  import qualified Algebra.FloatingPoint as Float import qualified Algebra.ToInteger as ToInteger@@ -21,9 +22,12 @@ type Put a = a -> T a  +instance Semigroup (T a) where+   x <> y = Cons $ decons x <> decons y+ instance Monoid (T a) where    mempty = Cons mempty-   mappend x y = Cons $ decons x `mappend` decons y+   mappend = (<>)  put :: Put a put = Cons . Endo . (:)

@@ -33,9 +33,8 @@  import qualified Synthesizer.Interpolation.Class as Interpol -import qualified Control.Applicative as App-import Control.Applicative.HT (liftA4, liftA5, )-import Control.Applicative (pure, )+import qualified Control.Applicative.HT as App+import Control.Applicative (Applicative, pure, (<*>), )  import qualified Data.Foldable as Fold import qualified Data.Traversable as Trav@@ -69,7 +68,7 @@    fmap f p = Parameter       (f $ c0 p) (f $ c1 p) (f $ c2 p) (f $ d1 p) (f $ d2 p) -instance App.Applicative Parameter where+instance Applicative Parameter where    {-# INLINE pure #-}    pure x = Parameter x x x x x    {-# INLINE (<*>) #-}@@ -83,14 +82,14 @@ instance Trav.Traversable Parameter where    {-# INLINE sequenceA #-}    sequenceA p =-      liftA5 Parameter+      App.lift5 Parameter          (c0 p) (c1 p) (c2 p) (d1 p) (d2 p)  instance Interpol.C a v => Interpol.C a (Parameter v) where    {-# INLINE scaleAndAccumulate #-}    scaleAndAccumulate =       Interpol.runMac $-         liftA5 Parameter+         App.lift5 Parameter             (Interpol.element c0)             (Interpol.element c1)             (Interpol.element c2)@@ -115,7 +114,7 @@    fmap f p = State       (f $ u1 p) (f $ u2 p) (f $ y1 p) (f $ y2 p) -instance App.Applicative State where+instance Applicative State where    {-# INLINE pure #-}    pure x = State x x x x    {-# INLINE (<*>) #-}@@ -129,7 +128,7 @@ instance Trav.Traversable State where    {-# INLINE sequenceA #-}    sequenceA p =-      liftA4 State+      App.lift4 State          (u1 p) (u2 p) (y1 p) (y2 p)  @@ -144,7 +143,7 @@    Storable a => Store.Dictionary (Parameter a) storeParameter =    Store.run $-   liftA5 Parameter+   App.lift5 Parameter       (Store.element c0)       (Store.element c1)       (Store.element c2)@@ -162,7 +161,7 @@    Storable a => Store.Dictionary (State a) storeState =    Store.run $-   liftA4 State+   App.lift4 State       (Store.element u1)       (Store.element u2)       (Store.element y1)

@@ -40,9 +40,8 @@ import qualified Synthesizer.Interpolation.Class as Interpol  import qualified Control.Monad.Trans.State as MS-import qualified Control.Applicative as App-import Control.Applicative.HT (liftA4, liftA6, )-import Control.Applicative (pure, liftA2, )+import qualified Control.Applicative.HT as App+import Control.Applicative (Applicative, pure, (<*>))  import qualified Data.Foldable as Fold import qualified Data.Traversable as Trav@@ -67,7 +66,7 @@    fmap f p = Parameter       (f $ k1 p) (f $ k2 p) (f $ ampIn p) (f $ ampI1 p) (f $ ampI2 p) (f $ ampLimit p) -instance App.Applicative Parameter where+instance Applicative Parameter where    {-# INLINE pure #-}    pure x = Parameter x x x x x x    {-# INLINE (<*>) #-}@@ -81,7 +80,7 @@ instance Trav.Traversable Parameter where    {-# INLINE sequenceA #-}    sequenceA p =-      liftA6 Parameter+      App.lift6 Parameter          (k1 p) (k2 p) (ampIn p) (ampI1 p) (ampI2 p) (ampLimit p)  instance Interpol.C a v => Interpol.C a (Parameter v) where@@ -89,7 +88,7 @@    scaleAndAccumulate =       Interpol.scaleAndAccumulateApplicative {--      Interpol.runMac $ liftA6 Parameter+      Interpol.runMac $ App.lift6 Parameter          (Interpol.element k1)          (Interpol.element k2)          (Interpol.element ampIn)@@ -108,7 +107,7 @@    Storable a => Store.Dictionary (Parameter a) storeParameter =    Store.run $-   liftA6 Parameter+   App.lift6 Parameter       (Store.element k1)       (Store.element k2)       (Store.element ampIn)@@ -125,7 +124,7 @@    fmap f p = Result       (f $ highpass p) (f $ bandpass p) (f $ lowpass p) (f $ bandlimit p) -instance App.Applicative Result where+instance Applicative Result where    {-# INLINE pure #-}    pure x = Result x x x x    {-# INLINE (<*>) #-}@@ -139,7 +138,7 @@ instance Trav.Traversable Result where    {-# INLINE sequenceA #-}    sequenceA p =-      liftA4 Result+      App.lift4 Result          (highpass p) (bandpass p) (lowpass p) (bandlimit p)  instance Additive.C v => Additive.C (Result v) where@@ -148,8 +147,8 @@    {-# INLINE (-) #-}    {-# INLINE negate #-}    zero   = pure zero-   (+)    = liftA2 (+)-   (-)    = liftA2 (-)+   (+)    = App.lift2 (+)+   (-)    = App.lift2 (-)    negate = fmap negate {-    zero = Result zero zero zero zero@@ -179,7 +178,7 @@    Storable a => Store.Dictionary (Result a) storeResult =    Store.run $-   liftA4 Result+   App.lift4 Result       (Store.element highpass)       (Store.element bandpass)       (Store.element lowpass)

@@ -35,6 +35,7 @@  import Data.Foldable (Foldable, foldr, ) import Data.Monoid (Monoid, mappend, mempty, )+import Data.Semigroup (Semigroup, (<>), )  import qualified Synthesizer.Storable.Signal as SigSt import qualified Data.StorableVector.Lazy.Pattern as SVL@@ -937,6 +938,9 @@ monoidConcatMap :: Monoid m => (a -> m) -> T a -> m monoidConcatMap = foldMap ++instance Semigroup (T y) where+   (<>) = append  instance Monoid (T y) where    mempty = empty

@@ -6,6 +6,7 @@ import Control.Arrow (Arrow, (<<<), (^<<), (<<^), )  import Data.Monoid (Monoid, mempty, mappend, )+import Data.Semigroup (Semigroup, (<>), )   {- |@@ -108,6 +109,9 @@ arrowSplitShorten a b =    arrowFirstShorten a <<< arrowSecondShorten b ++instance (Semigroup a, Semigroup b) => Semigroup (T a b) where+   Cons a0 b0 <> Cons a1 b1 = Cons (a0 <> a1) (b0 <> b1)  instance (Monoid a, Monoid b) => Monoid (T a b) where    mempty = Cons mempty mempty

@@ -1,5 +1,5 @@ Name:           synthesizer-core-Version:        0.8.1.2+Version:        0.8.2 License:        GPL License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de>@@ -25,7 +25,7 @@ Stability:      Experimental Tested-With:    GHC==6.4.1, GHC==6.8.2, GHC==6.10.4, GHC==6.12.3 Tested-With:    GHC==7.0.4, GHC==7.2.1, GHC==7.4.2, GHC==7.6.3-Cabal-Version:  >=1.14+Cabal-Version:  1.14 Build-Type:     Simple  Extra-Source-Files:@@ -38,7 +38,7 @@   Source-Repository this-  Tag:         0.8.1.2+  Tag:         0.8.2   Type:        darcs   Location:    http://code.haskell.org/synthesizer/core/ @@ -52,12 +52,13 @@     sox >=0.1 && <0.3,     transformers >=0.2 && <0.6,     non-empty >=0.2 && <0.4,+    semigroups >=0.1 && <1.0,     event-list >=0.1 && <0.2,     non-negative >=0.1 && <0.2,     explicit-exception >=0.1.6 && <0.2,     numeric-prelude >=0.4.2 && <0.5,     numeric-quest >=0.1 && <0.3,-    utility-ht >=0.0.12 && <0.1,+    utility-ht >=0.0.14 && <0.1,     filepath >=1.1 && <1.5,     bytestring >=0.9 && <0.11,     binary >=0.1 && <1,@@ -273,6 +274,8 @@     Test.Sound.Synthesizer.Generic.Filter     Test.Sound.Synthesizer.Storable.Cut     Test.Sound.Synthesizer.Causal.Analysis+    Synthesizer.Basic.NumberTheory+    Synthesizer.Generic.Permutation   Main-Is: Test/Main.hs