synthesizer-core 0.8.4 → 0.9

raw patch · 66 files changed

+1565/−1145 lines, 66 filesdep +doctest-exitcode-stdiodep +doctest-libdep ~basedep ~deepseqdep ~randomPVP ok

version bump matches the API change (PVP)

Dependencies added: doctest-exitcode-stdio, doctest-lib

Dependency ranges changed: base, deepseq, random, semigroups, storablevector

API changes (from Hackage documentation)

Files

• Changes.md +22/−1
• Makefile +12/−0
• speedtest/Fourier.hs +6/−4
• src/Synthesizer/Basic/Wave.hs +77/−3
• src/Synthesizer/Causal/Analysis.hs +53/−0
• src/Synthesizer/Causal/Process.hs +11/−12
• src/Synthesizer/CausalIO/Gate.hs +10/−10
• src/Synthesizer/CausalIO/Process.hs +3/−3
• src/Synthesizer/ChunkySize.hs +84/−5
• src/Synthesizer/ChunkySize/Cut.hs +15/−16
• src/Synthesizer/ChunkySize/Signal.hs +7/−7
• src/Synthesizer/Generic/Analysis.hs +19/−21
• src/Synthesizer/Generic/Control.hs +65/−80
• src/Synthesizer/Generic/Cut.hs +38/−13
• src/Synthesizer/Generic/Cyclic.hs +4/−5
• src/Synthesizer/Generic/Displacement.hs +1/−1
• src/Synthesizer/Generic/Filter/Delay.hs +6/−6
• src/Synthesizer/Generic/Filter/NonRecursive.hs +39/−72
• src/Synthesizer/Generic/Filter/Recursive/Comb.hs +6/−7
• src/Synthesizer/Generic/Filter/Recursive/MovingAverage.hs +3/−3
• src/Synthesizer/Generic/Fourier.hs +7/−7
• src/Synthesizer/Generic/Interpolation.hs +10/−10
• src/Synthesizer/Generic/LengthSignal.hs +1/−1
• src/Synthesizer/Generic/Loop.hs +3/−4
• src/Synthesizer/Generic/Noise.hs +7/−14
• src/Synthesizer/Generic/Oscillator.hs +12/−19
• src/Synthesizer/Generic/Piece.hs +40/−28
• src/Synthesizer/Generic/Signal.hs +238/−231
• src/Synthesizer/Generic/Tutorial.hs +19/−17
• src/Synthesizer/PiecewiseConstant/Generic.hs +4/−5
• src/Synthesizer/Plain/Oscillator.hs +28/−1
• src/Synthesizer/State/Signal.hs +4/−88
• src/Synthesizer/State/Storable.hs +88/−0
• src/Synthesizer/State/ToneModulation.hs +2/−2
• src/Synthesizer/Storable/Cut.hs +37/−0
• src/Synthesizer/Storable/Filter/NonRecursive.hs +6/−6
• src/Synthesizer/Zip.hs +3/−3
• synthesizer-core.cabal +30/−24
• test/DocTest/Main.hs +18/−0
• test/DocTest/Synthesizer/Basic/Wave.hs +102/−0
• test/DocTest/Synthesizer/Causal/Analysis.hs +66/−0
• test/DocTest/Synthesizer/Generic/Signal.hs +75/−0
• test/DocTest/Synthesizer/Plain/Oscillator.hs +36/−0
• test/DocTest/Synthesizer/Storable/Cut.hs +46/−0
• test/Test/Main.hs +9/−10
• test/Test/Sound/Synthesizer/Basic/NumberTheory.hs +22/−25
• test/Test/Sound/Synthesizer/Basic/ToneModulation.hs +12/−11
• test/Test/Sound/Synthesizer/Causal/Analysis.hs +0/−49
• test/Test/Sound/Synthesizer/Generic/Cut.hs +10/−10
• test/Test/Sound/Synthesizer/Generic/Filter.hs +7/−7
• test/Test/Sound/Synthesizer/Generic/Fourier.hs +16/−15
• test/Test/Sound/Synthesizer/Generic/FourierInteger.hs +12/−12
• test/Test/Sound/Synthesizer/Generic/Permutation.hs +5/−5
• test/Test/Sound/Synthesizer/Generic/ToneModulation.hs +7/−7
• test/Test/Sound/Synthesizer/Plain/Analysis.hs +17/−17
• test/Test/Sound/Synthesizer/Plain/Control.hs +9/−9
• test/Test/Sound/Synthesizer/Plain/Filter.hs +28/−30
• test/Test/Sound/Synthesizer/Plain/Filter/Allpass.hs +4/−6
• test/Test/Sound/Synthesizer/Plain/Filter/FirstOrder.hs +11/−11
• test/Test/Sound/Synthesizer/Plain/Filter/Hilbert.hs +4/−10
• test/Test/Sound/Synthesizer/Plain/Interpolation.hs +11/−13
• test/Test/Sound/Synthesizer/Plain/Oscillator.hs +0/−36
• test/Test/Sound/Synthesizer/Plain/ToneModulation.hs +17/−17
• test/Test/Sound/Synthesizer/Plain/Wave.hs +0/−74
• test/Test/Sound/Synthesizer/Storable/Cut.hs +0/−40
• test/Test/Utility.hs +1/−2

@@ -1,6 +1,27 @@ # Change log for the `synthesizer-core` package -## 8.1+## 0.9++* `SigG.Read` -> `SigG.Consume`++  `SigG.Write` -> `SigG.Produce`++  `SigG.LazySize` -> `ChunkySize.LazySize`++* `SigG.Produce`: Remove `LazySize` parameter.+  This rules out the `instance Produce StorableVector.Lazy`.+  You only have `instance Produce StorableVector.Typed`,+  i.e. storable vectors with maximum chunk size encoded in a type parameter.+  `instance Transform StorableVector.Lazy` and+  `instance Consume StorableVector.Lazy` are still provided, though.++  The `LazySize` parameters in the `Write` class+  only had a meaning for chunky storable vectors.+  If you need to produce (chunky or monolithic) storable vectors,+  better program your signal generator with `State.Signal`+  and then render it using `State.Signal.toStrictStorableSignal`.++## 0.8.1  * `Plain.Filter.Recursive.FirstOrder.highpassInit`,   `Plain.Filter.Recursive.FirstOrder.highpassModifierInit`

@@ -2,6 +2,18 @@  # HIDE_SYNTH = -hide-package synthesizer +run-test:	update-test+	runhaskell Setup configure --user --enable-test --enable-benchmarks+	runhaskell Setup build+	runhaskell Setup haddock+	./dist/build/test/test++update-test:	test-module.list+	doctest-extract-0.1 -i src/ -o test/ --module-prefix DocTest --library-main=Main $$(cat test-module.list)++test-module.list:	synthesizer-core.cabal+	perl -p -e 's:( +DocTest\.(Synthesizer.+)|.*\n):\2:' $< >$@+  ghci: 	ghci -Wall -odirdist/build -hidirdist/build $(HIDE_SYNTH) -i:$(MODULE_PATH)

@@ -7,6 +7,7 @@ import qualified Synthesizer.State.Noise as NoiseS import qualified Synthesizer.State.Signal as SigS +import qualified Data.StorableVector.Lazy.Typed as SVT import qualified Data.StorableVector as SV  import qualified Number.Complex as NPComplex@@ -23,12 +24,13 @@ test0 =    SigSt.writeFile "fouriertest.f64" $    SigG.take 65536 $-   (NoiseG.white SigG.defaultLazySize :: SigSt.T Double)+   SVT.toVectorLazy $+   (NoiseG.white :: SVT.DefaultVector Double)  test1 :: IO () test1 =    SigSt.writeFile "fouriertest.f64" $-   SigG.fromState SigG.defaultLazySize $+   SigS.toStorableSignal SigSt.defaultChunkSize $    SigS.take 65536 $    SigS.map (NPComplex.+: 0) $    (NoiseS.white :: SigS.T Double)@@ -38,7 +40,7 @@    writeFile "fouriertest.cache" $    show $ Fourier.cacheBackward $    (\sig ->-      SigG.fromState SigG.defaultLazySize sig ::+      SigS.toStorableSignal SigSt.defaultChunkSize sig ::          SigSt.T (NPComplex.T Double)) $    SigS.take n $    SigS.map (NPComplex.+: 0) $@@ -48,7 +50,7 @@ test3 n =    let sig :: SigSt.T (NPComplex.T Double)        sig =-          SigG.fromState SigG.defaultLazySize $+          SigS.toStorableSignal SigSt.defaultChunkSize $           SigS.take n $           SigS.map (NPComplex.+: 0) $           NoiseS.white

@@ -43,6 +43,7 @@    sawCos,    sawComplex,    superSaw,+   multiSaw,    square,    squareCos,    squareComplex,@@ -106,6 +107,26 @@ import NumericPrelude.Base  +{- $setup+>>> import qualified Synthesizer.Basic.Wave  as Wave+>>> import qualified Synthesizer.Basic.Phase as Phase+>>>+>>> import qualified Test.QuickCheck as QC+>>>+>>> import NumericPrelude.Numeric+>>> import NumericPrelude.Base+>>> import Prelude ()+>>>+>>> zeroDCOffset :: Wave.T Double Double -> QC.Property+>>> zeroDCOffset wave =+>>>    QC.forAll (QC.choose (100,600)) $ \periodInt ->+>>>    let period = fromIntegral periodInt+>>>        xs = take periodInt $ map Phase.fromRepresentative $+>>>             map (/period) $ iterate (1+) 0.5+>>>    in  abs (sum (map (Wave.apply wave) xs))  <  period / fromInteger 100+-}++ {- * Definition and construction -}  newtype T t y = Cons {decons :: Phase.T t -> y}@@ -189,13 +210,19 @@  {- ** unparameterized -} -{- | map a phase to value of a sine wave -}+{- | map a phase to value of a sine wave++prop> zeroDCOffset Wave.sine+-} {- disabled SPECIALISE sine :: Double -> Double -} {-# INLINE sine #-} sine :: Trans.C a => T a a sine = fromFunction $ \x -> sin (2*pi*x)  {-# INLINE cosine #-}+{- |+prop> zeroDCOffset Wave.cosine+-} cosine :: Trans.C a => T a a cosine = fromFunction $ \x -> cos (2*pi*x) @@ -208,6 +235,8 @@ Surprisingly it is not really faster than 'sine'. The wave results from integrating the 'triangle' wave, thus it the @k@-th harmonic has amplitude @recip (k^3)@.++prop> zeroDCOffset Wave.fastSine2 -} {-# INLINE fastSine2 #-} fastSine2 :: (Ord a, Ring.C a) => T a a@@ -228,6 +257,8 @@  {- | Piecewise third order polynomial approximation by integrating 'fastSine2'.++prop> zeroDCOffset Wave.fastSine3 -} {-# INLINE fastSine3 #-} fastSine3 :: (Ord a, Ring.C a) => T a a@@ -248,6 +279,8 @@  {- | Piecewise fourth order polynomial approximation by integrating 'fastSine3'.++prop> zeroDCOffset Wave.fastSine4 -} {-# INLINE fastSine4 #-} fastSine4 :: (Ord a, Field.C a) => T a a@@ -380,6 +413,8 @@  {- | saw tooth, it's a ramp down in order to have a positive coefficient for the first partial sine++prop> zeroDCOffset Wave.saw -} {- disabled SPECIALISE saw :: Double -> Double -} {-# INLINE saw #-}@@ -391,6 +426,8 @@ but the partial waves are shifted by 90 degree. That is, it is the Hilbert transform of the saw wave. The formula is derived from 'sawComplex'.++prop> zeroDCOffset Wave.sawCos -} {-# INLINE sawCos #-} sawCos :: (RealRing.C a, Trans.C a) => T a a@@ -472,7 +509,31 @@       sum $ map fraction $ take n $ iterate (d+) x  -{- | square -}+{- |+>      ///+>     /+>    /+> ///++@multiSaw 0 (-2)@ is the regular saw tooth wave.++Could also be composed by distorting an amplified saw tooth.+-}+multiSaw :: (RealRing.C a, Field.C a) => a -> a -> T a a+multiSaw depth slope =+   fromFunction $ \x ->+      let y = slope*(x-1/2) in+      if' (-1 <= y && y <= 1) y $+      signum y * ((1-depth) + fractionAtGrid depth (abs y - 1))++fractionAtGrid :: (RealRing.C a, Field.C a) => a -> a -> a+fractionAtGrid depth y = if' (depth==0) 0 (depth*fraction (y/depth))+++{- | square++prop> zeroDCOffset Wave.square+-} {- disabled SPECIALISE square :: Double -> Double -} {-# INLINE square #-} square :: (Ord a, Ring.C a) => T a a@@ -528,7 +589,10 @@ -}  -{- | triangle -}+{- | triangle++prop> zeroDCOffset Wave.triangle+-} {- disabled SPECIALISE triangle :: Double -> Double -} {-# INLINE triangle #-} triangle :: (Ord a, Ring.C a) => T a a@@ -935,6 +999,8 @@ {- | Like 'squareAsymmetric' but with zero average. It could be simulated by adding two saw oscillations with 180 degree phase difference and opposite sign.++prop> QC.forAll (QC.choose (-1,1)) $ zeroDCOffset . Wave.squareBalanced -} {- disabled SPECIALISE squareBalanced :: Double -> Double -> Double -} {-# INLINE squareBalanced #-}@@ -960,6 +1026,8 @@  {- | Mixing 'trapezoid' and 'trianglePike' you can get back a triangle wave form++prop> QC.forAll (QC.choose (0,1)) $ zeroDCOffset . Wave.trapezoid -} {- disabled SPECIALISE trapezoid :: Double -> Double -> Double -} {-# INLINE trapezoid #-}@@ -1006,6 +1074,12 @@  {- | trapezoid with distinct high and low time and zero direct current offset++prop> :{+   QC.forAll (QC.choose (0,1)) $ \w ->+   QC.forAll (QC.choose (-1,1)) $ \r ->+   zeroDCOffset $ Wave.trapezoidBalanced w r+:} -} {- disabled SPECIALISE trapezoidBalanced :: Double -> Double -> Double -> Double -} {-# INLINE trapezoidBalanced #-}

@@ -16,10 +16,38 @@ import NumericPrelude.Base  +{- $setup+>>> import qualified Synthesizer.Causal.Analysis as AnaC+>>> import qualified Synthesizer.Causal.Process as Causal+>>> import qualified Synthesizer.Plain.Analysis as Ana+>>>+>>> import Control.Arrow ((<<<))+>>>+>>> import qualified Data.NonEmpty.Class as NonEmptyC+>>> import qualified Data.NonEmpty as NonEmpty+>>> import qualified Data.List.Match as Match+>>> import qualified Data.List as List+>>>+>>> import qualified Test.QuickCheck as QC+>>>+>>> import NumericPrelude.Numeric+>>> import NumericPrelude.Base+>>> import Prelude ()+-}++ flipFlopHysteresis ::    (Ord y) => (y,y) -> Ana.BinaryLevel -> Causal.T y Ana.BinaryLevel flipFlopHysteresis bnds = Causal.scanL (Ana.flipFlopHysteresisStep bnds) +{- |+prop> :{+   \xs ->+      Match.take xs (Ana.deltaSigmaModulation xs)+      ==+      Causal.apply AnaC.deltaSigmaModulation (xs::[Rational])+:}+-} deltaSigmaModulation ::    RealRing.C y => Causal.T y Ana.BinaryLevel deltaSigmaModulation =@@ -29,6 +57,17 @@        uncurry (-))       (Causal.consInit zero <<^ Ana.binaryLevelToNumber) +{- |+prop> :{+   \threshold xs ->+      Match.take xs (Ana.deltaSigmaModulationPositive threshold xs)+      ==+      Causal.apply+         (AnaC.deltaSigmaModulationPositive <<<+          Causal.feedConstFst threshold)+         (xs::[Rational])+:}+-} deltaSigmaModulationPositive ::    RealRing.C y => Causal.T (y, y) y deltaSigmaModulationPositive =@@ -42,6 +81,20 @@ {- Abuse (Map a ()) as (Set a), because in GHC-7.4.2 there is no Set.elemAt function.+-}+{- |+prop> :{+   let movingMedian :: (Ord a) => Int -> [a] -> [a]+       movingMedian n =+         map (\xs -> List.sort xs !! div (length xs) 2) . NonEmpty.tail .+         NonEmptyC.zipWith (drop . max 0) (NonEmptyC.iterate succ (negate n)) .+         NonEmpty.inits++   in QC.forAll (QC.choose (1,20)) $ \n xs ->+         movingMedian n xs+         ==+         Causal.apply (AnaC.movingMedian n) (xs::[Char])+:} -} movingMedian :: (Ord a) => Int -> Causal.T a a movingMedian n =

@@ -80,7 +80,6 @@ import qualified Synthesizer.Plain.Modifier as Modifier  import qualified Data.StorableVector as SV- import Foreign.Storable (Storable, )  import qualified Control.Category as Cat@@ -280,7 +279,7 @@   {-# INLINE runViewL #-}-runViewL :: (SigG.Read sig a) =>+runViewL :: (SigG.Consume sig a) =>    sig a ->    (forall s. StateT s Maybe a -> s -> x) ->    x@@ -306,7 +305,7 @@ Better use 'feedFst' and (>>>). -} {-# INLINE applyFst #-}-applyFst, applyFst' :: (SigG.Read sig a) =>+applyFst, applyFst' :: (SigG.Consume sig a) =>    T (a,b) c -> sig a -> T b c applyFst c as =    c <<< feedFst as@@ -323,7 +322,7 @@ Better use 'feedSnd' and (>>>). -} {-# INLINE applySnd #-}-applySnd, applySnd' :: (SigG.Read sig b) =>+applySnd, applySnd' :: (SigG.Consume sig b) =>    T (a,b) c -> sig b -> T a c applySnd c as =    c <<< feedSnd as@@ -354,14 +353,14 @@  {-# INLINE apply2 #-} apply2 ::-   (SigG.Read sig a, SigG.Transform sig b, SigG.Transform sig c) =>+   (SigG.Consume sig a, SigG.Transform sig b, SigG.Transform sig c) =>    T (a,b) c -> sig a -> sig b -> sig c apply2 f x y =    apply (applyFst f x) y  {-# INLINE apply3 #-} apply3 ::-   (SigG.Read sig a, SigG.Read sig b, SigG.Transform sig c, SigG.Transform sig d) =>+   (SigG.Consume sig a, SigG.Consume sig b, SigG.Transform sig c, SigG.Transform sig d) =>    T (a,b,c) d -> sig a -> sig b -> sig c -> sig d apply3 f x y z =    apply2 (applyFst ((\(a,(b,c)) -> (a,b,c)) ^>> f) x) y z@@ -386,21 +385,21 @@   {-# INLINE feed #-}-feed :: (SigG.Read sig a) =>+feed :: (SigG.Consume sig a) =>    sig a -> T () a feed proc =    runViewL proc (\getNext ->       fromStateMaybe (const getNext))  {-# INLINE feedFst #-}-feedFst :: (SigG.Read sig a) =>+feedFst :: (SigG.Consume sig a) =>    sig a -> T b (a,b) feedFst proc =    runViewL proc (\getNext ->       fromStateMaybe (\b -> fmap (flip (,) b) getNext))  {-# INLINE feedSnd #-}-feedSnd :: (SigG.Read sig a) =>+feedSnd :: (SigG.Consume sig a) =>    sig a -> T b (b,a) feedSnd proc =    runViewL proc (\getNext ->@@ -415,13 +414,13 @@ feedConstSnd a = map (\b -> (b,a))  {-# INLINE feedGenericFst #-}-feedGenericFst :: (SigG.Read sig a) =>+feedGenericFst :: (SigG.Consume sig a) =>    sig a -> T b (a,b) feedGenericFst =    feedFst . SigG.toState  {-# INLINE feedGenericSnd #-}-feedGenericSnd :: (SigG.Read sig a) =>+feedGenericSnd :: (SigG.Consume sig a) =>    sig a -> T b (b,a) feedGenericSnd =    feedSnd . SigG.toState@@ -448,7 +447,7 @@    mapAccumL (\x acc -> (x, Just $ maybe x (flip f x) acc)) Nothing  {-# INLINE zipWith #-}-zipWith :: (SigG.Read sig a) =>+zipWith :: (SigG.Consume sig a) =>    (a -> b -> c) -> sig a -> T b c zipWith f = applyFst (map (uncurry f)) 

@@ -11,7 +11,7 @@ import qualified Synthesizer.Zip as Zip  import qualified Synthesizer.Generic.Cut as CutG-import qualified Synthesizer.Generic.Signal as SigG+import qualified Synthesizer.ChunkySize as ChunkySize import Synthesizer.PiecewiseConstant.Signal (StrictTime, )  import qualified Control.Monad.Trans.State as MS@@ -54,7 +54,7 @@      else error "release time must be strictly before chunk end"  -instance CutG.Read (Chunk a) where+instance CutG.Consume (Chunk a) where    null (Chunk dur _) = isZero dur    length (Chunk dur _) = fromIntegral dur @@ -87,39 +87,39 @@    (Arrow arrow) =>    arrow (Chunk a) (SV.Vector ()) allToStorableVector = arr $-   (\(SigG.LazySize n) -> SV.replicate n ())+   (\(ChunkySize.LazySize n) -> SV.replicate n ())    ^<<    allToChunkySize  toStorableVector ::    PIO.T (Chunk a) (SV.Vector ()) toStorableVector =-   (\(SigG.LazySize n) -> SV.replicate n ())+   (\(ChunkySize.LazySize n) -> SV.replicate n ())    ^<<    toChunkySize   allToChunkySize ::    (Arrow arrow) =>-   arrow (Chunk a) SigG.LazySize+   arrow (Chunk a) ChunkySize.LazySize allToChunkySize = arr $-   \(Chunk time _) -> SigG.LazySize (fromIntegral time)+   \(Chunk time _) -> ChunkySize.LazySize (fromIntegral time)  toChunkySize ::-   PIO.T (Chunk a) SigG.LazySize+   PIO.T (Chunk a) ChunkySize.LazySize toChunkySize =    PIO.traverse True $    \(Chunk time mRelease) -> do       running <- MS.get       if not running-        then return $ SigG.LazySize 0+        then return $ ChunkySize.LazySize 0         else           case mRelease of              Nothing ->-                return $ SigG.LazySize (fromIntegral time)+                return $ ChunkySize.LazySize (fromIntegral time)              Just (relTime, _) -> do                 MS.put False-                return $ SigG.LazySize (fromIntegral relTime)+                return $ ChunkySize.LazySize (fromIntegral relTime)   {- |

@@ -195,7 +195,7 @@    uncurry Zip.Cons ^<< ab &&& ac  -instance (CutG.Transform a, CutG.Read b, Semigroup b) => Semigroup (T a b) where+instance (CutG.Transform a, CutG.Consume b, Semigroup b) => Semigroup (T a b) where    (<>) = append (<>)  {- |@@ -203,7 +203,7 @@ In a loop it will have to construct types at runtime which is rather expensive. -}-instance (CutG.Transform a, CutG.Read b, Monoid b) => Monoid (T a b) where+instance (CutG.Transform a, CutG.Consume b, Monoid b) => Monoid (T a b) where    mempty = Cons       (\ _a () -> return (mempty, ()))       (return ())@@ -211,7 +211,7 @@    mappend = append mappend  append ::-   (CutG.Transform a, CutG.Read b) =>+   (CutG.Transform a, CutG.Consume b) =>    (b -> b -> b) -> T a b -> T a b -> T a b append app       (Cons nextX createX deleteX)

@@ -1,33 +1,112 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Synthesizer.ChunkySize where -import qualified Synthesizer.Generic.Signal as SigG+import qualified Synthesizer.Generic.Cut as Cut+ import qualified Number.NonNegativeChunky as Chunky import qualified Numeric.NonNegative.Chunky as Chunky98 +import qualified Algebra.ToInteger    as ToInteger+import qualified Algebra.ToRational   as ToRational+import qualified Algebra.Absolute     as Absolute+import qualified Algebra.RealIntegral as RealIntegral+import qualified Algebra.IntegralDomain as Integral+import qualified Algebra.NonNegative  as NonNeg+import qualified Algebra.ZeroTestable as ZeroTestable+import qualified Algebra.Ring     as Ring+import qualified Algebra.Additive as Additive+import qualified Algebra.Monoid   as Monoid+import Algebra.Ring ((*), )+import Algebra.Additive ((+), (-), )+ import qualified Data.StorableVector.Lazy as SigSt import qualified Data.StorableVector.Lazy.Pattern as SigStV  import qualified Data.List as List+import Data.Monoid (Monoid, mappend, mempty, )+import Data.Semigroup (Semigroup, (<>), ) +import qualified Test.QuickCheck as QC -type T = Chunky.T SigG.LazySize+import qualified Prelude as P+import Prelude (Eq, Ord, Show, Int, fmap, max, min, id, (.), ($), (==), )  +{- |+This type is used for specification of the maximum size of strict packets.+Packets can be smaller, can have different sizes in one signal.+In some kinds of streams, like lists and stateful generators,+the packet size is always 1.+The packet size is not just a burden caused by efficiency,+but we need control over packet size in applications with feedback.++ToDo: Make the element type of the corresponding signal a type parameter.+This helps to distinguish chunk sizes of scalar and vectorised signals.+-}+newtype LazySize = LazySize Int+   deriving (Eq, Ord, Show,+             Additive.C, Ring.C, ZeroTestable.C,+             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 = (<>)++instance Monoid.C LazySize where+   idt = LazySize 0+   LazySize a <*> LazySize b = LazySize (a + b)++instance NonNeg.C LazySize where+   split = NonNeg.splitDefault (\(LazySize n) -> n) LazySize++instance QC.Arbitrary LazySize where+   arbitrary =+      case SigSt.defaultChunkSize of+         SigSt.ChunkSize n -> fmap LazySize (QC.choose (1, 2 * n))++instance Cut.Consume LazySize where+   null (LazySize n) = n==0+   length (LazySize n) = n++instance Cut.Transform LazySize where+   {-# INLINE take #-}+   take m (LazySize n) = LazySize $ min (max 0 m) n+   {-# INLINE drop #-}+   drop m (LazySize n) = LazySize $ max 0 $ n - max 0 m+   {-# INLINE splitAt #-}+   splitAt m x =+      let y = Cut.take m x+      in  (y, x-y)+   {-# INLINE dropMarginRem #-}+   dropMarginRem n m x@(LazySize xs) =+      let d = min m $ max 0 $ xs - n+      in  (m-d, Cut.drop d x)+   {-# INLINE reverse #-}+   reverse = id+++type T = Chunky.T LazySize++ fromStorableVectorSize ::    SigStV.LazySize -> T fromStorableVectorSize =    Chunky.fromChunks .-   List.map (\(SigSt.ChunkSize size) -> (SigG.LazySize size)) .+   List.map (\(SigSt.ChunkSize size) -> (LazySize size)) .    Chunky98.toChunks  toStorableVectorSize ::    T -> SigStV.LazySize toStorableVectorSize =    Chunky98.fromChunks .-   List.map (\(SigG.LazySize size) -> (SigSt.ChunkSize size)) .+   List.map (\(LazySize size) -> (SigSt.ChunkSize size)) .    Chunky.toChunks  toNullList :: T -> [()] toNullList =-   List.concatMap (\(SigG.LazySize n) -> List.replicate n ()) .+   List.concatMap (\(LazySize n) -> List.replicate n ()) .    Chunky.toChunks

@@ -6,7 +6,6 @@  import qualified Synthesizer.ChunkySize as ChunkySize import qualified Synthesizer.Generic.Cut as Cut-import qualified Synthesizer.Generic.Signal as SigG import qualified Synthesizer.State.Signal as SigS  import qualified Data.StorableVector.Lazy.Pattern as SigStV@@ -21,21 +20,21 @@ import Data.Monoid (Monoid, )  import NumericPrelude.Numeric-import NumericPrelude.Base hiding (splitAt, Read, )+import NumericPrelude.Base hiding (splitAt, ) import Prelude ()  -class Cut.Read sig => Read sig where+class Cut.Consume sig => Consume sig where    length :: sig -> ChunkySize.T -class (Read sig, Monoid sig) => Transform sig where+class (Consume sig, Monoid sig) => Transform sig where    take :: ChunkySize.T -> sig -> sig    drop :: ChunkySize.T -> sig -> sig    splitAt :: ChunkySize.T -> sig -> (sig, sig)  --- instance Storable y => Read SigSt.T y where-instance Storable y => Read (Vector.Vector y) where+-- instance Storable y => Consume SigSt.T y where+instance Storable y => Consume (Vector.Vector y) where    {-# INLINE length #-}    length = ChunkySize.fromStorableVectorSize . SigStV.length @@ -48,10 +47,10 @@    splitAt = SigStV.splitAt . ChunkySize.toStorableVectorSize  -instance Read ([] y) where+instance Consume ([] y) where    {-# INLINE length #-}    length xs =-      Chunky.fromChunks $ Match.replicate xs $ SigG.LazySize one+      Chunky.fromChunks $ Match.replicate xs $ ChunkySize.LazySize one  instance Transform ([] y) where    {-# INLINE take #-}@@ -61,14 +60,14 @@    drop ns xs =       -- 'drop' cannot make much use of laziness, thus 'foldl' is ok       List.foldl-         (\x (SigG.LazySize n) -> List.drop n x)+         (\x (ChunkySize.LazySize n) -> List.drop n x)          xs (Chunky.toChunks ns)    {-# INLINE splitAt #-}    splitAt ns =       Match.splitAt (ChunkySize.toNullList ns)  {--instance Read (SigFL.T y) where+instance Consume (SigFL.T y) where    {-# INLINE length #-}    length = SigFL.length @@ -81,11 +80,11 @@    splitAt = SigFL.splitAt -} -instance Read (SigS.T y) where+instance Consume (SigS.T y) where    {-# INLINE length #-}    length =       Chunky.fromChunks . SigS.toList .-      SigS.map (const (SigG.LazySize one))+      SigS.map (const (ChunkySize.LazySize one))  instance Transform (SigS.T y) where    {-# INLINE take #-}@@ -96,13 +95,13 @@               then Just (x, (pred n, ns))               else                 case ns of-                  SigG.LazySize m : ms -> Just (x, (pred m, ms))+                  ChunkySize.LazySize m : ms -> Just (x, (pred m, ms))                   [] -> Nothing)          (zero, Chunky.toChunks $ Chunky.normalize size0)    {-# INLINE drop #-}    drop ns xs =       List.foldl-         (\x (SigG.LazySize n) -> SigS.drop n x)+         (\x (ChunkySize.LazySize n) -> SigS.drop n x)          xs (Chunky.toChunks ns)    {-# INLINE splitAt #-}    splitAt n =@@ -115,7 +114,7 @@ {- useful for application of non-negative chunky numbers as gate signals -}-instance (ToInteger.C a, NonNeg.C a) => Read (Chunky.T a) where+instance (ToInteger.C a, NonNeg.C a) => Consume (Chunky.T a) where    {-# INLINE length #-}    length = sum . List.map (fromIntegral . toInteger) . Chunky.toChunks @@ -154,7 +153,7 @@   -instance (P.Integral a) => Read (Chunky98.T a) where+instance (P.Integral a) => Consume (Chunky98.T a) where    {-# INLINE null #-}    null = List.null . Chunky98.toChunks    {-# INLINE length #-}

@@ -21,42 +21,42 @@ import Prelude (Maybe(Just), fst, (.), id, )  -class (SigG.Write sig y, Cut.Transform (sig y)) => Write sig y where+class (SigG.Transform sig y, Cut.Transform (sig y)) => Produce sig y where    unfoldRN :: ChunkySize.T -> (s -> Maybe (y,s)) -> s -> sig y  -instance Storable y => Write Vector.Vector y where+instance Storable y => Produce Vector.Vector y where    {-# INLINE unfoldRN #-}    unfoldRN size f =       fst .       SigStV.unfoldrN          (ChunkySize.toStorableVectorSize size) f -instance Write [] y where+instance Produce [] y where    {-# INLINE unfoldRN #-}    unfoldRN size f =       Match.take (ChunkySize.toNullList size) .       List.unfoldr f -instance Write SigS.T y where+instance Produce SigS.T y where    {-# INLINE unfoldRN #-}    unfoldRN size f =       Cut.take size . SigS.unfoldR f   {-# INLINE replicate #-}-replicate :: (Write sig y) =>+replicate :: (Produce sig y) =>    ChunkySize.T -> y -> sig y replicate = iterateN id  {-# INLINE iterateN #-}-iterateN :: (Write sig y) =>+iterateN :: (Produce sig y) =>    (y -> y) -> ChunkySize.T -> y -> sig y iterateN f size =    unfoldRN size (\y -> Just (y, f y))  {-# INLINE fromState #-}-fromState :: (Write sig y) =>+fromState :: (Produce sig y) =>    ChunkySize.T -> SigS.T y -> sig y fromState size (SigS.Cons f x) =    unfoldRN size (runStateT f) x

@@ -26,25 +26,25 @@ {- | Volume based on Manhattan norm. -}-volumeMaximum :: (RealRing.C y, SigG.Read sig y) => sig y -> y+volumeMaximum :: (RealRing.C y, SigG.Consume sig y) => sig y -> y volumeMaximum =    AnaS.volumeMaximum . SigG.toState  {- | Volume based on Energy norm. -}-volumeEuclidean :: (Algebraic.C y, SigG.Read sig y) => sig y -> y+volumeEuclidean :: (Algebraic.C y, SigG.Consume sig y) => sig y -> y volumeEuclidean =    AnaS.volumeEuclidean . SigG.toState -volumeEuclideanSqr :: (Field.C y, SigG.Read sig y) => sig y -> y+volumeEuclideanSqr :: (Field.C y, SigG.Consume sig y) => sig y -> y volumeEuclideanSqr =    AnaS.volumeEuclideanSqr . SigG.toState  {- | Volume based on Sum norm. -}-volumeSum :: (Field.C y, RealRing.C y, SigG.Read sig y) => sig y -> y+volumeSum :: (Field.C y, RealRing.C y, SigG.Consume sig y) => sig y -> y volumeSum =    AnaS.volumeSum . SigG.toState @@ -54,7 +54,7 @@ Volume based on Manhattan norm. -} volumeVectorMaximum ::-   (NormedMax.C y yv, Ord y, SigG.Read sig yv) =>+   (NormedMax.C y yv, Ord y, SigG.Consume sig yv) =>    sig yv -> y volumeVectorMaximum =    AnaS.volumeVectorMaximum . SigG.toState@@ -63,13 +63,13 @@ Volume based on Energy norm. -} volumeVectorEuclidean ::-   (Algebraic.C y, NormedEuc.C y yv, SigG.Read sig yv) =>+   (Algebraic.C y, NormedEuc.C y yv, SigG.Consume sig yv) =>    sig yv -> y volumeVectorEuclidean =    AnaS.volumeVectorEuclidean . SigG.toState  volumeVectorEuclideanSqr ::-   (Field.C y, NormedEuc.Sqr y yv, SigG.Read sig yv) =>+   (Field.C y, NormedEuc.Sqr y yv, SigG.Consume sig yv) =>    sig yv -> y volumeVectorEuclideanSqr =    AnaS.volumeVectorEuclideanSqr . SigG.toState@@ -78,7 +78,7 @@ Volume based on Sum norm. -} volumeVectorSum ::-   (NormedSum.C y yv, Field.C y, SigG.Read sig yv) =>+   (NormedSum.C y yv, Field.C y, SigG.Consume sig yv) =>    sig yv -> y volumeVectorSum =    AnaS.volumeVectorSum . SigG.toState@@ -90,7 +90,7 @@ Compute minimum and maximum value of the stream the efficient way. Input list must be non-empty and finite. -}-bounds :: (Ord y, SigG.Read sig y) => sig y -> (y,y)+bounds :: (Ord y, SigG.Consume sig y) => sig y -> (y,y) bounds =    AnaS.bounds . SigG.toState @@ -204,7 +204,7 @@ -}  {--histogramIntMap :: (RealField.C y, SigG.Read sig y) =>+histogramIntMap :: (RealField.C y, SigG.Consume sig y) =>    y -> sig y -> (Int, sig Int) histogramIntMap binsPerUnit =    histogramDiscreteIntMap . quantize binsPerUnit@@ -217,11 +217,11 @@ attachOne = SigG.map (\i -> (i,one))  meanValues ::-   (RealField.C y, SigG.Read sig y) => sig y -> [(Int,y)]+   (RealField.C y, SigG.Consume sig y) => sig y -> [(Int,y)] meanValues x = concatMap spread (zip x (tail x))  spread ::-   (RealField.C y, SigG.Read sig y) => (y,y) -> [(Int,y)]+   (RealField.C y, SigG.Consume sig y) => (y,y) -> [(Int,y)] spread lr0 =    let (l,r) = sortPair lr0        (li,lf) = splitFraction l@@ -242,23 +242,23 @@ This is identical to the arithmetic mean. -} directCurrentOffset ::-   (Field.C y, SigG.Read sig y) => sig y -> y+   (Field.C y, SigG.Consume sig y) => sig y -> y directCurrentOffset = average   scalarProduct ::-   (Ring.C y, SigG.Read sig y) => sig y -> sig y -> y+   (Ring.C y, SigG.Consume sig y) => sig y -> sig y -> y scalarProduct xs ys =    AnaS.scalarProduct (SigG.toState xs) (SigG.toState ys)  {- | 'directCurrentOffset' must be non-zero. -}-centroid :: (Field.C y, SigG.Read sig y) => sig y -> y+centroid :: (Field.C y, SigG.Consume sig y) => sig y -> y centroid =    AnaS.centroid . SigG.toState -average :: (Field.C y, SigG.Read sig y) => sig y -> y+average :: (Field.C y, SigG.Consume sig y) => sig y -> y average =    AnaS.average . SigG.toState @@ -296,10 +296,8 @@  More sophisticated algorithms like Rader, Cooley-Tukey, Winograd, Prime-Factor may follow. -}-chirpTransform ::-   (SigG.Write sig y, Ring.C y) =>-   SigG.LazySize -> y -> sig y -> sig y-chirpTransform size z =-   SigG.fromState size .+chirpTransform :: (SigG.Produce sig y, Ring.C y) => y -> sig y -> sig y+chirpTransform z =+   SigG.fromState .    AnaS.chirpTransform z .    SigG.toState

@@ -37,41 +37,37 @@  {- * Control curve generation -} -constant :: (SigG.Write sig y) =>-   SigG.LazySize -> y -> sig y+constant :: (SigG.Produce sig y) => y -> sig y constant = SigG.repeat  -linear :: (Additive.C y, SigG.Write sig y) =>-      SigG.LazySize-   -> y   {-^ steepness -}+linear :: (Additive.C y, SigG.Produce sig y) =>+      y   {-^ steepness -}    -> y   {-^ initial value -}    -> sig y           {-^ linear progression -}-linear size d y0 = SigG.iterate size (d+) y0+linear d y0 = SigG.iterate (d+) y0  {- | Minimize rounding errors by reducing number of operations per element to a logarithmuc number. -} linearMultiscale ::-   (Additive.C y, SigG.Write sig y) =>-      SigG.LazySize-   -> y+   (Additive.C y, SigG.Produce sig y) =>+      y    -> y    -> sig y-linearMultiscale size =-   curveMultiscale size (+)+linearMultiscale =+   curveMultiscale (+)  {- | Linear curve starting at zero. -}-linearMultiscaleNeutral :: (Additive.C y, SigG.Write sig y) =>-      SigG.LazySize-   -> y+linearMultiscaleNeutral :: (Additive.C y, SigG.Produce sig y) =>+      y    -> sig y-linearMultiscaleNeutral size slope =-   curveMultiscaleNeutral size (+) slope zero+linearMultiscaleNeutral slope =+   curveMultiscaleNeutral (+) slope zero  {- | Linear curve of a fixed length.@@ -80,54 +76,49 @@ This way we can concatenate several lines without duplicate adjacent values. -}-line :: (Field.C y, SigG.Write sig y) =>-      SigG.LazySize-   -> Int   {-^ length -}+line :: (Field.C y, SigG.Produce sig y) =>+      Int   {-^ length -}    -> (y,y) {-^ initial and final value -}    -> sig y             {-^ linear progression -}-line size n (y0,y1) =-   SigG.take n $ linear size ((y1-y0) / fromIntegral n) y0+line n (y0,y1) =+   SigG.take n $ linear ((y1-y0) / fromIntegral n) y0   exponential, exponentialMultiscale ::-   (Trans.C y, SigG.Write sig y) =>-      SigG.LazySize-   -> y   {-^ time where the function reaches 1\/e of the initial value -}+   (Trans.C y, SigG.Produce sig y) =>+      y   {-^ time where the function reaches 1\/e of the initial value -}    -> y   {-^ initial value -}    -> sig y           {-^ exponential decay -}-exponential size time =-   SigG.iterate size (* exp (- recip time))-exponentialMultiscale size time =-   curveMultiscale size (*) (exp (- recip time))+exponential time =+   SigG.iterate (* exp (- recip time))+exponentialMultiscale time =+   curveMultiscale (*) (exp (- recip time)) -exponentialMultiscaleNeutral :: (Trans.C y, SigG.Write sig y) =>-      SigG.LazySize-   -> y   {-^ time where the function reaches 1\/e of the initial value -}+exponentialMultiscaleNeutral :: (Trans.C y, SigG.Produce sig y) =>+      y   {-^ time where the function reaches 1\/e of the initial value -}    -> sig y           {-^ exponential decay -}-exponentialMultiscaleNeutral size time =-   curveMultiscaleNeutral size (*) (exp (- recip time)) one+exponentialMultiscaleNeutral time =+   curveMultiscaleNeutral (*) (exp (- recip time)) one -exponential2, exponential2Multiscale :: (Trans.C y, SigG.Write sig y) =>-      SigG.LazySize-   -> y   {-^ half life -}+exponential2, exponential2Multiscale :: (Trans.C y, SigG.Produce sig y) =>+      y   {-^ half life -}    -> y   {-^ initial value -}    -> sig y           {-^ exponential decay -}-exponential2 size halfLife =-   SigG.iterate size (*  0.5 ** recip halfLife)-exponential2Multiscale size halfLife =-   curveMultiscale size (*) (0.5 ** recip halfLife)+exponential2 halfLife =+   SigG.iterate (*  0.5 ** recip halfLife)+exponential2Multiscale halfLife =+   curveMultiscale (*) (0.5 ** recip halfLife) -exponential2MultiscaleNeutral :: (Trans.C y, SigG.Write sig y) =>-      SigG.LazySize-   -> y   {-^ half life -}+exponential2MultiscaleNeutral :: (Trans.C y, SigG.Produce sig y) =>+      y   {-^ half life -}    -> sig y           {-^ exponential decay -}-exponential2MultiscaleNeutral size halfLife =-   curveMultiscaleNeutral size (*) (0.5 ** recip halfLife) one+exponential2MultiscaleNeutral halfLife =+   curveMultiscaleNeutral (*) (0.5 ** recip halfLife) one   @@ -136,68 +127,62 @@     which is straight-forward but requires more explicit signatures.     But since it is needed rarely I setup a separate function. -} vectorExponential ::-   (Trans.C y, Module.C y v, SigG.Write sig v) =>-      SigG.LazySize-   ->  y  {-^ time where the function reaches 1\/e of the initial value -}+   (Trans.C y, Module.C y v, SigG.Produce sig v) =>+       y  {-^ time where the function reaches 1\/e of the initial value -}    ->  v  {-^ initial value -}    -> sig v           {-^ exponential decay -}-vectorExponential size time y0 =-   SigG.iterate size (exp (-1/time) *>) y0+vectorExponential time y0 =+   SigG.iterate (exp (-1/time) *>) y0  vectorExponential2 ::-   (Trans.C y, Module.C y v, SigG.Write sig v) =>-      SigG.LazySize-   ->  y  {-^ half life -}+   (Trans.C y, Module.C y v, SigG.Produce sig v) =>+       y  {-^ half life -}    ->  v  {-^ initial value -}    -> sig v           {-^ exponential decay -}-vectorExponential2 size halfLife y0 =-   SigG.iterate size (0.5**(1/halfLife) *>) y0+vectorExponential2 halfLife y0 =+   SigG.iterate (0.5**(1/halfLife) *>) y0   -cosine, cosineMultiscaleLinear :: (Trans.C y, SigG.Write sig y) =>-      SigG.LazySize-   ->  y  {-^ time t0 where  1 is approached -}+cosine, cosineMultiscaleLinear :: (Trans.C y, SigG.Produce sig y) =>+       y  {-^ time t0 where  1 is approached -}    ->  y  {-^ time t1 where -1 is approached -}    -> sig y           {-^ a cosine wave where one half wave is between t0 and t1 -}-cosine size = Ctrl.cosineWithSlope $-   \d x -> SigG.map cos (linear size d x)+cosine = Ctrl.cosineWithSlope $+   \d x -> SigG.map cos (linear d x) -cosineMultiscaleLinear size = Ctrl.cosineWithSlope $-   \d x -> SigG.map cos (linearMultiscale size d x)+cosineMultiscaleLinear = Ctrl.cosineWithSlope $+   \d x -> SigG.map cos (linearMultiscale d x)  cosineMultiscale ::-   (Trans.C y, SigG.Write sig (Complex.T y),+   (Trans.C y, SigG.Produce sig (Complex.T y),     SigG.Transform sig (Complex.T y), SigG.Transform sig y) =>-      SigG.LazySize-   ->  y  {-^ time t0 where  1 is approached -}+       y  {-^ time t0 where  1 is approached -}    ->  y  {-^ time t1 where -1 is approached -}    -> sig y           {-^ a cosine wave where one half wave is between t0 and t1 -}-cosineMultiscale size = Ctrl.cosineWithSlope $-   \d x -> SigG.map real (curveMultiscale size (*) (cis d) (cis x))+cosineMultiscale = Ctrl.cosineWithSlope $+   \d x -> SigG.map real (curveMultiscale (*) (cis d) (cis x))  -cubicHermite :: (Field.C y, SigG.Write sig y) =>-      SigG.LazySize-   -> (y, (y,y)) -> (y, (y,y)) -> sig y-cubicHermite size node0 node1 =-   SigG.map (Ctrl.cubicFunc node0 node1) $ linear size 1 0+cubicHermite :: (Field.C y, SigG.Produce sig y) =>+      (y, (y,y)) -> (y, (y,y)) -> sig y+cubicHermite node0 node1 =+   SigG.map (Ctrl.cubicFunc node0 node1) $ linear 1 0   {- * Auxiliary functions -}  -curveMultiscale :: (SigG.Write sig y) =>-   SigG.LazySize -> (y -> y -> y) -> y -> y -> sig y-curveMultiscale size op d y0 =-   SigG.cons y0 . SigG.map (op y0) $ SigG.iterateAssociative size op d+curveMultiscale :: (SigG.Produce sig y) => (y -> y -> y) -> y -> y -> sig y+curveMultiscale op d y0 =+   SigG.cons y0 . SigG.map (op y0) $ SigG.iterateAssociative op d  -curveMultiscaleNeutral :: (SigG.Write sig y) =>-   SigG.LazySize -> (y -> y -> y) -> y -> y -> sig y-curveMultiscaleNeutral size op d neutral =-   SigG.cons neutral $ SigG.iterateAssociative size op d+curveMultiscaleNeutral :: (SigG.Produce sig y) =>+   (y -> y -> y) -> y -> y -> sig y+curveMultiscaleNeutral op d neutral =+   SigG.cons neutral $ SigG.iterateAssociative op d

@@ -9,8 +9,9 @@  import qualified Synthesizer.Plain.Signal as Sig import qualified Synthesizer.State.Signal as SigS-import qualified Data.StorableVector as SV+import qualified Data.StorableVector.Lazy.Typed as SVT import qualified Data.StorableVector.Lazy as SVL+import qualified Data.StorableVector as SV  import qualified Algebra.ToInteger as ToInteger import qualified Algebra.Ring as Ring@@ -44,11 +45,11 @@     not, (||), (&&), min, max, )  -class Read sig where+class Consume sig where    null :: sig -> Bool    length :: sig -> Int -class (Read sig) => NormalForm sig where+class (Consume sig) => NormalForm sig where    {- |    Evaluating the first value of the signal    is necessary for avoiding a space leaks@@ -57,7 +58,7 @@    -}    evaluateHead :: sig -> () -class (Read sig, Monoid sig) => Transform sig where+class (Consume sig, Monoid sig) => Transform sig where    {- Monoid functions    {-    In our categorization 'empty' would belong to the Write class,@@ -78,7 +79,7 @@    reverse :: sig -> sig  -instance Storable y => Read (SV.Vector y) where+instance Storable y => Consume (SV.Vector y) where    {-# INLINE null #-}    null = SV.null    {-# INLINE length #-}@@ -104,8 +105,7 @@    reverse = SV.reverse  --- instance Storable y => Read SigSt.T y where-instance Storable y => Read (SVL.Vector y) where+instance Storable y => Consume (SVL.Vector y) where    {-# INLINE null #-}    null = SVL.null    {-# INLINE length #-}@@ -125,6 +125,7 @@    evaluateHead x = SVL.switchL () (\x _ -> rnf x) -} +-- instance Storable y => Consume SigSt.T y where instance Storable y => Transform (SVL.Vector y) where    {-    {-# INLINE empty #-}@@ -148,8 +149,32 @@    reverse = SVL.reverse  -instance Read ([] y) where+instance (SVT.Size size, Storable y) => Consume (SVT.Vector size y) where    {-# INLINE null #-}+   null = SVT.null+   {-# INLINE length #-}+   length = SVT.length++instance (SVT.Size size, Storable y) => NormalForm (SVT.Vector size y) where+   {-# INLINE evaluateHead #-}+   evaluateHead =+      ListHT.switchL () (\x _ -> evaluateHead x) . SVT.chunks++instance (SVT.Size size, Storable y) => Transform (SVT.Vector size y) where+   {-# INLINE take #-}+   take = SVT.take+   {-# INLINE drop #-}+   drop = SVT.drop+   {-# INLINE splitAt #-}+   splitAt = SVT.splitAt+   {-# INLINE dropMarginRem #-}+   dropMarginRem = SVT.dropMarginRem+   {-# INLINE reverse #-}+   reverse = SVT.reverse+++instance Consume ([] y) where+   {-# INLINE null #-}    null = List.null    {-# INLINE length #-}    length = List.length@@ -181,7 +206,7 @@    reverse = List.reverse  -instance Read (SigS.T y) where+instance Consume (SigS.T y) where    {-# INLINE null #-}    null = SigS.null    {-# INLINE length #-}@@ -228,7 +253,7 @@ {- | We abuse event lists for efficient representation of piecewise constant signals. -}-instance (P.Integral t) => Read (EventList.T t y) where+instance (P.Integral t) => Consume (EventList.T t y) where    null = EventList.null    length = fromIntegral . P.toInteger . P.sum . EventList.getTimes @@ -239,7 +264,7 @@ {- needed for chunks of MIDI events as input to CausalIO processes -}-instance (P.Integral t) => Read (EventListTT.T t y) where+instance (P.Integral t) => Consume (EventListTT.T t y) where    null = EventListMT.switchTimeL (\t xs -> t==0 && EventList.null xs)    length = fromIntegral . P.toInteger . P.sum . EventListTT.getTimes @@ -320,7 +345,7 @@ {- useful for application of non-negative chunky numbers as gate signals -}-instance (ToInteger.C a, NonNeg.C a) => Read (Chunky.T a) where+instance (ToInteger.C a, NonNeg.C a) => Consume (Chunky.T a) where    {-# INLINE null #-}    null = List.null . Chunky.toChunks    {-# INLINE length #-}@@ -366,7 +391,7 @@   -instance (P.Integral a) => Read (Chunky98.T a) where+instance (P.Integral a) => Consume (Chunky98.T a) where    {-# INLINE null #-}    null = List.null . Chunky98.toChunks    {-# INLINE length #-}

@@ -15,12 +15,11 @@   fromSignal ::-   (SigG.Write sig yv, Additive.C yv) =>-   SigG.LazySize -> Int -> sig yv -> sig yv-fromSignal chunkSize n =+   (SigG.Produce sig yv, Additive.C yv) =>+   Int -> sig yv -> sig yv+fromSignal n =    {- almost Sig.sum -}-   Sig.foldL SigG.mix (SigG.replicate chunkSize n zero) .-   CutG.sliceVertical n+   Sig.foldL SigG.mix (SigG.replicate n zero) . CutG.sliceVertical n  reverse ::    (SigG.Transform sig y) =>

@@ -48,7 +48,7 @@ In "Synthesizer.Basic.Distortion" you find a collection of appropriate distortion functions. -}-distort :: (SigG.Read sig c, SigG.Transform sig v) =>+distort :: (SigG.Consume sig c, SigG.Transform sig v) =>    (c -> v -> v) -> sig c -> sig v -> sig v distort = SigG.zipWith 

@@ -22,25 +22,25 @@  {-# INLINE static #-} static ::-   (Additive.C y, SigG.Write sig y) =>+   (Additive.C y, SigG.Produce sig y) =>    Int -> sig y -> sig y static = FiltNR.delay  {-# INLINE staticPad #-} staticPad ::-   (SigG.Write sig y) =>+   (SigG.Produce sig y) =>    y -> Int -> sig y -> sig y staticPad = FiltNR.delayPad  {-# INLINE staticPos #-} staticPos ::-   (Additive.C y, SigG.Write sig y) =>+   (Additive.C y, SigG.Produce sig y) =>    Int -> sig y -> sig y staticPos = FiltNR.delayPos  {-# INLINE staticNeg #-} staticNeg ::-   (SigG.Write sig y) =>+   (SigG.Produce sig y) =>    Int -> sig y -> sig y staticNeg = FiltNR.delayNeg @@ -49,7 +49,7 @@  {-# INLINE modulatedCore #-} modulatedCore ::-   (RealField.C t, Additive.C y, SigG.Read sig t, SigG.Transform sig t, SigG.Transform sig y) =>+   (RealField.C t, Additive.C y, SigG.Consume sig t, SigG.Transform sig t, SigG.Transform sig y) =>    Interpolation.T t y -> Int ->    sig t -> sig y -> sig y modulatedCore ip size =@@ -67,7 +67,7 @@ {-# INLINE modulated #-} modulated ::    (RealField.C t, Additive.C y,-    SigG.Read sig t, SigG.Transform sig t, SigG.Transform sig y, SigG.Write sig y) =>+    SigG.Consume sig t, SigG.Transform sig t, SigG.Transform sig y, SigG.Produce sig y) =>    Interpolation.T t y -> Int ->    sig t -> sig y -> sig y modulated ip minDev ts xs =

@@ -20,9 +20,6 @@    delayPad,    delayPos,    delayNeg,-   delayLazySize,-   delayPadLazySize,-   delayPosLazySize,    binomialMask,    binomial,    binomial1,@@ -62,8 +59,7 @@     -- for use in Storable.Filter.NonRecursive    maybeAccumulateRangeFromPyramid,-   accumulatePosModulatedFromPyramid,-   withPaddedInput,+    -- for use in Generic.Fourier    addShiftedSimple, @@ -83,6 +79,8 @@ import qualified Synthesizer.State.Signal as SigS  import Control.Monad (mplus, )++import qualified Data.List.Match as Match import Data.Function.HT (nest, ) import Data.Tuple.HT (mapSnd, mapPair, ) import Data.Maybe.HT (toMaybe, )@@ -136,7 +134,7 @@  {-# INLINE envelopeVector #-} envelopeVector ::-   (Module.C a v, SigG.Read sig a, SigG.Transform sig v) =>+   (Module.C a v, SigG.Consume sig a, SigG.Transform sig v) =>       sig a  {-^ the envelope -}    -> sig v  {-^ the signal to be enveloped -}    -> sig v@@ -146,7 +144,7 @@  {-# INLINE fadeInOut #-} fadeInOut ::-   (Field.C a, SigG.Write sig a) =>+   (Field.C a, SigG.Produce sig a) =>    Int -> Int -> Int -> sig a -> sig a fadeInOut tIn tHold tOut xs =    let slopeIn  =                  recip (fromIntegral tIn)@@ -158,10 +156,10 @@        But I assume that concatenating chunks of an envelope        is more efficient than concatenating generator loops.        However, our intermediate envelope is still observable,-       because we have to use SigG.Write class.+       because we have to use SigG.Produce class.        -}-       leadIn  = SigG.take tIn  $ Ctrl.linear SigG.defaultLazySize slopeIn  0-       leadOut = SigG.take tOut $ Ctrl.linear SigG.defaultLazySize slopeOut 1+       leadIn  = SigG.take tIn  $ Ctrl.linear slopeIn  0+       leadOut = SigG.take tOut $ Ctrl.linear slopeOut 1        (partIn, partHoldOut) = SigG.splitAt tIn xs        (partHold, partOut)   = SigG.splitAt tHold partHoldOut    in  envelope leadIn partIn `SigG.append`@@ -172,24 +170,24 @@ -- * Delay  {-# INLINE delay #-}-delay :: (Additive.C y, SigG.Write sig y) =>+delay :: (Additive.C y, SigG.Produce sig y) =>    Int -> sig y -> sig y delay =    delayPad zero  {-# INLINE delayPad #-}-delayPad :: (SigG.Write sig y) =>+delayPad :: (SigG.Produce sig y) =>    y -> Int -> sig y -> sig y delayPad z n =    if n<0      then SigG.drop (Additive.negate n)-     else SigG.append (SigG.replicate SigG.defaultLazySize n z)+     else SigG.append (SigG.replicate n z)  {-# INLINE delayPos #-}-delayPos :: (Additive.C y, SigG.Write sig y) =>+delayPos :: (Additive.C y, SigG.Produce sig y) =>    Int -> sig y -> sig y delayPos n =-   SigG.append (SigG.replicate SigG.defaultLazySize n zero)+   SigG.append (SigG.replicate n zero)  {-# INLINE delayNeg #-} delayNeg :: (SigG.Transform sig y) =>@@ -198,39 +196,11 @@   -{-# INLINE delayLazySize #-}-delayLazySize :: (Additive.C y, SigG.Write sig y) =>-   SigG.LazySize -> Int -> sig y -> sig y-delayLazySize size =-   delayPadLazySize size zero--{- |-The pad value @y@ must be defined,-otherwise the chunk size of the padding can be observed.--}-{-# INLINE delayPadLazySize #-}-delayPadLazySize :: (SigG.Write sig y) =>-   SigG.LazySize -> y -> Int -> sig y -> sig y-delayPadLazySize size z n =-   if n<0-     then SigG.drop (Additive.negate n)-     else SigG.append (SigG.replicate size n z)--{-# INLINE delayPosLazySize #-}-delayPosLazySize :: (Additive.C y, SigG.Write sig y) =>-   SigG.LazySize -> Int -> sig y -> sig y-delayPosLazySize size n =-   SigG.append (SigG.replicate size n zero)-- -- * smoothing -binomialMask ::-   (Field.C a, SigG.Write sig a) =>-   SigG.LazySize ->-   Int -> sig a-binomialMask size n =-   SigG.unfoldR size+binomialMask :: (Field.C a, SigG.Produce sig a) => Int -> sig a+binomialMask n =+   SigG.unfoldR       (\(x, a, b) ->           toMaybe (b>=0)              (x, (x * fromInteger b / fromInteger (a+1), a+1, b-1)))@@ -300,27 +270,26 @@   sumsDownsample2 ::-   (Additive.C v, SigG.Write sig v) =>-   SigG.LazySize -> sig v -> sig v-sumsDownsample2 cs =-   SigG.unfoldR cs (\xs ->+   (Additive.C v, SigG.Produce sig v) =>+   sig v -> sig v+sumsDownsample2 =+   SigG.unfoldR (\xs ->       flip fmap (SigG.viewL xs) $ \xxs0@(x0,xs0) ->          SigG.switchL xxs0 {- xs0 is empty -}             (\ x1 xs1 -> (x0+x1, xs1))             xs0)  downsample2 ::-   (SigG.Write sig v) =>-   SigG.LazySize -> sig v -> sig v-downsample2 cs =-   SigG.unfoldR cs-      (fmap (mapSnd SigG.laxTail) . SigG.viewL)+   (SigG.Produce sig v) =>+   sig v -> sig v+downsample2 =+   SigG.unfoldR (fmap (mapSnd SigG.laxTail) . SigG.viewL)  downsample ::-   (SigG.Write sig v) =>-   SigG.LazySize -> Int -> sig v -> sig v-downsample cs n =-   SigG.unfoldR cs+   (SigG.Produce sig v) =>+   Int -> sig v -> sig v+downsample n =+   SigG.unfoldR       (\xs -> fmap (mapSnd (const (SigG.drop n xs))) $ SigG.viewL xs)  @@ -389,12 +358,11 @@    SigG.sum . SigG.take (r-l) . SigG.drop l  pyramid ::-   (Additive.C v, SigG.Write sig v) =>+   (Additive.C v, SigG.Produce sig v) =>    Int -> sig v -> ([Int], [sig v]) pyramid height sig =    let sizes = reverse $ take (1+height) $ iterate (2*) 1-   in  (sizes,-        scanl (flip sumsDownsample2) sig (map SigG.LazySize $ tail sizes))+   in  (sizes, Match.take sizes $ iterate sumsDownsample2 sig)  {-# INLINE sumRangeFromPyramid #-} sumRangeFromPyramid ::@@ -501,7 +469,7 @@ -} {-# INLINE accumulatePosModulatedFromPyramid #-} accumulatePosModulatedFromPyramid ::-   (SigG.Transform sig (Int,Int), SigG.Write sig v) =>+   (SigG.Transform sig (Int,Int), SigG.Produce sig v) =>    ([sig v] -> (Int,Int) -> v) ->    ([Int], [sig v]) ->    sig (Int,Int) -> sig v@@ -512,14 +480,14 @@    in  SigG.concat $        zipWith           (\pyr ->-              SigG.fromState (SigG.LazySize blockSize) .+              SigG.fromState .               SigS.map (accumulate pyr) .               SigS.zipWith (\d -> mapPair ((d+), (d+))) (SigS.iterate (1+) 0) .               SigG.toState)           pyrStarts ctrlBlocks  sumsPosModulatedPyramid ::-   (Additive.C v, SigG.Transform sig (Int,Int), SigG.Write sig v) =>+   (Additive.C v, SigG.Transform sig (Int,Int), SigG.Produce sig v) =>    Int -> sig (Int,Int) -> sig v -> sig v sumsPosModulatedPyramid height ctrl xs =    accumulatePosModulatedFromPyramid@@ -528,7 +496,7 @@  withPaddedInput ::    (SigG.Transform sig Int, SigG.Transform sig (Int, Int),-    SigG.Write sig y) =>+    SigG.Produce sig y) =>    y -> (sig (Int, Int) -> sig y -> v) ->    Int ->    sig Int ->@@ -546,7 +514,7 @@ -} movingAverageModulatedPyramid ::    (Field.C a, Module.C a v,-    SigG.Transform sig Int, SigG.Transform sig (Int,Int), SigG.Write sig v) =>+    SigG.Transform sig Int, SigG.Transform sig (Int,Int), SigG.Produce sig v) =>    a -> Int -> Int -> sig Int -> sig v -> sig v movingAverageModulatedPyramid amp height maxC ctrl0 =    withPaddedInput zero@@ -557,11 +525,10 @@   inverseFrequencyModulationFloor ::-   (Ord t, Ring.C t, SigG.Write sig v, SigG.Read sig t) =>-   SigG.LazySize ->+   (Ord t, Ring.C t, SigG.Produce sig v, SigG.Consume sig t) =>    sig t -> sig v -> sig v-inverseFrequencyModulationFloor chunkSize ctrl xs =-   SigG.fromState chunkSize+inverseFrequencyModulationFloor ctrl xs =+   SigG.fromState       (FiltS.inverseFrequencyModulationFloor          (SigG.toState ctrl) (SigG.toState xs)) @@ -631,7 +598,7 @@ -} {-# INLINE generic #-} generic ::-   (Module.C a v, SigG.Transform sig a, SigG.Write sig v) =>+   (Module.C a v, SigG.Transform sig a, SigG.Produce sig v) =>    sig a -> sig v -> sig v generic m x =    if SigG.null m || SigG.null x

@@ -39,7 +39,7 @@ -} {-# INLINE karplusStrong #-} karplusStrong ::-   (Ring.C t, Module.C t y, SigG.Write sig y) =>+   (Ring.C t, Module.C t y, SigG.Transform sig y) =>    Filt1.Parameter t -> sig y -> sig y karplusStrong c wave =    SigG.delayLoop (SigG.modifyStatic Filt1.lowpassModifier c) wave@@ -53,7 +53,7 @@ instead of cutting the result according to the input length. -} {-# INLINE run #-}-run :: (Module.C t y, SigG.Write sig y) =>+run :: (Module.C t y, SigG.Transform sig y) =>    Int -> t -> sig y -> sig y run time gain =    runProc time (Filt.amplifyVector gain)@@ -63,7 +63,7 @@ Chunk size must be smaller than all of the delay times. -} {-# INLINE runMulti #-}-runMulti :: (Module.C t y, SigG.Write sig y) =>+runMulti :: (Module.C t y, SigG.Produce sig y) =>    [Int] -> t -> sig y -> sig y runMulti times gain x =     let y = foldl@@ -74,7 +74,7 @@  {- | Echos can be piped through an arbitrary signal processor. -} {-# INLINE runProc #-}-runProc :: (Additive.C y, SigG.Write sig y) =>+runProc :: (Additive.C y, SigG.Transform sig y) =>    Int -> (sig y -> sig y) -> sig y -> sig y runProc = SigG.delayLoopOverlap @@ -89,11 +89,10 @@        ys = CutG.append xs0 $ SigG.zipWith (+) xs1 $ Filt.amplifyVector gain ys    in  ys -_runInf :: (Module.C t y, SigG.Write sig y) => t -> Int -> sig y -> sig y+_runInf :: (Module.C t y, SigG.Produce sig y) => t -> Int -> sig y -> sig y _runInf gain delay xs =    let (xs0,xs1) =           CutG.splitAt delay $-          Filt.amplifyVector (1-gain) xs `CutG.append`-             SigG.repeat (SigG.LazySize delay) zero+          Filt.amplifyVector (1-gain) xs `CutG.append` SigG.repeat zero        ys = CutG.append xs0 $ SigG.zipWith (+) xs1 $ Filt.amplifyVector gain ys    in  ys

@@ -43,7 +43,7 @@ @ -} {-# INLINE sumsStaticInt #-}-sumsStaticInt :: (Additive.C v, SigG.Write sig v) =>+sumsStaticInt :: (Additive.C v, SigG.Produce sig v) =>    Int -> sig v -> sig v sumsStaticInt n xs =    Integration.run (sub xs (Delay.staticPos n xs))@@ -155,7 +155,7 @@ -} {-# INLINE sumsModulatedHalf #-} sumsModulatedHalf ::-   (RealField.C a, Module.C a v, SigG.Transform sig a, SigG.Write sig v) =>+   (RealField.C a, Module.C a v, SigG.Transform sig a, SigG.Produce sig v) =>    Int -> sig a -> sig v -> sig v sumsModulatedHalf maxDInt ds xs =    let maxD  = fromIntegral maxDInt@@ -167,7 +167,7 @@  {-# INLINE modulatedFrac #-} modulatedFrac ::-   (RealField.C a, Module.C a v, SigG.Transform sig a, SigG.Write sig v) =>+   (RealField.C a, Module.C a v, SigG.Transform sig a, SigG.Produce sig v) =>    Int -> sig a -> sig v -> sig v modulatedFrac maxDInt ds xs =    SigG.zipWith (\d y -> recip (2*d) *> y) ds $

@@ -74,9 +74,9 @@   class Ring.C y => Element y where-   recipInteger :: (SigG.Read sig y) => sig y -> y-   addId :: (SigG.Read sig y) => sig y -> y-   multId :: (SigG.Read sig y) => sig y -> y+   recipInteger :: (SigG.Consume sig y) => sig y -> y+   addId :: (SigG.Consume sig y) => sig y -> y+   multId :: (SigG.Consume sig y) => sig y -> y    {- |    It must hold: @@ -88,7 +88,7 @@    since we need for caching that the cache is uniquely determined    by singal length and transform direction.    -}-   conjugatePrimitiveRootsOfUnity :: (SigG.Read sig y) => sig y -> (y,y)+   conjugatePrimitiveRootsOfUnity :: (SigG.Consume sig y) => sig y -> (y,y)  instance Trans.C a => Element (Complex.T a) where    recipInteger sig = recip (fromIntegral (SigG.length sig)) +: zero@@ -134,14 +134,14 @@       in  (z, recip z)  -head :: (SigG.Read sig y) => sig y -> y+head :: (SigG.Consume sig y) => sig y -> y head =    SigG.switchL (error "Generic.Signal.head: empty signal") const .    SigG.toState   directionPrimitiveRootsOfUnity ::-   (Element y, SigG.Read sig y) =>+   (Element y, SigG.Consume sig y) =>    sig y -> ((Direction,y), (Direction,y)) directionPrimitiveRootsOfUnity x =    let (z,zInv) = conjugatePrimitiveRootsOfUnity x@@ -459,7 +459,7 @@    Ana.chirpTransform z $ SigG.toState sig  powers ::-   (Element y, SigG.Read sig y) =>+   (Element y, SigG.Consume sig y) =>    sig y -> y -> SigS.T y powers sig c = SigS.iterate (c*) $ multId sig 

@@ -31,17 +31,17 @@ {-* Interpolation with various padding methods -}  {-# INLINE zeroPad #-}-zeroPad :: (RealRing.C t, SigG.Write sig y) =>+zeroPad :: (RealRing.C t, SigG.Produce sig y) =>    (T t y -> t -> sig y -> a) ->    y -> T t y -> t -> sig y -> a zeroPad interpolate z ip phase x =    let (phInt, phFrac) = splitFraction phase    in  interpolate ip phFrac           (FiltNR.delayPad z (offset ip - phInt)-              (SigG.append x (SigG.repeat SigG.defaultLazySize z)))+              (SigG.append x (SigG.repeat z)))  {-# INLINE constantPad #-}-constantPad :: (RealRing.C t, SigG.Write sig y) =>+constantPad :: (RealRing.C t, SigG.Produce sig y) =>    (T t y -> t -> sig y -> a) ->    T t y -> t -> sig y -> a constantPad interpolate ip phase x =@@ -49,7 +49,7 @@        xPad =           do (xFirst,_) <- SigG.viewL x              return (FiltNR.delayPad xFirst-                (offset ip - phInt) (SigG.extendConstant SigG.defaultLazySize x))+                (offset ip - phInt) (SigG.extendConstant x))    in  interpolate ip phFrac           (fromMaybe SigG.empty xPad) @@ -83,7 +83,7 @@  {-* Interpolation of multiple values with various padding methods -} -func :: (SigG.Read sig y) =>+func :: (SigG.Consume sig y) =>    T t y -> t -> sig y -> y func ip phase =    Interpolation.func ip phase . SigG.toState@@ -124,14 +124,14 @@  {-# INLINE multiRelativeZeroPad #-} multiRelativeZeroPad ::-   (RealRing.C t, SigG.Transform sig t, SigG.Transform sig y, SigG.Write sig y) =>+   (RealRing.C t, SigG.Transform sig t, SigG.Transform sig y, SigG.Produce sig y) =>    y -> T t y -> t -> sig t -> sig y -> sig y multiRelativeZeroPad z ip phase fs x =    zeroPad multiRelative z ip phase x fs  {-# INLINE multiRelativeConstantPad #-} multiRelativeConstantPad ::-   (RealRing.C t, SigG.Transform sig t, SigG.Transform sig y, SigG.Write sig y) =>+   (RealRing.C t, SigG.Transform sig t, SigG.Transform sig y, SigG.Produce sig y) =>    T t y -> t -> sig t -> sig y -> sig y multiRelativeConstantPad ip phase fs x =    constantPad multiRelative ip phase x fs@@ -161,21 +161,21 @@  {-# INLINE multiRelativeZeroPadConstant #-} multiRelativeZeroPadConstant ::-   (RealRing.C t, Additive.C y, SigG.Transform sig t, SigG.Transform sig y, SigG.Write sig y) =>+   (RealRing.C t, Additive.C y, SigG.Transform sig t, SigG.Transform sig y, SigG.Produce sig y) =>    t -> sig t -> sig y -> sig y multiRelativeZeroPadConstant =    multiRelativeZeroPad zero constant  {-# INLINE multiRelativeZeroPadLinear #-} multiRelativeZeroPadLinear ::-   (RealRing.C t, Module.C t y, SigG.Transform sig t, SigG.Transform sig y, SigG.Write sig y) =>+   (RealRing.C t, Module.C t y, SigG.Transform sig t, SigG.Transform sig y, SigG.Produce sig y) =>    t -> sig t -> sig y -> sig y multiRelativeZeroPadLinear =    multiRelativeZeroPad zero linear  {-# INLINE multiRelativeZeroPadCubic #-} multiRelativeZeroPadCubic ::-   (RealField.C t, Module.C t y, SigG.Transform sig t, SigG.Transform sig y, SigG.Write sig y) =>+   (RealField.C t, Module.C t y, SigG.Transform sig t, SigG.Transform sig y, SigG.Produce sig y) =>    t -> sig t -> sig y -> sig y multiRelativeZeroPadCubic =    multiRelativeZeroPad zero cubic

@@ -18,7 +18,7 @@ data T sig = Cons {length :: Int, body :: sig}    deriving (Show) -fromSignal :: (CutG.Read sig) => sig -> T sig+fromSignal :: (CutG.Consume sig) => sig -> T sig fromSignal xs  =  Cons (CutG.length xs) xs  toSignal :: T sig -> sig

@@ -88,20 +88,19 @@ -} {-# INLINE timeReverse #-} timeReverse ::-   (SigG.Write sig yv, RealField.C q, Module.C q yv) =>-   SigG.LazySize ->+   (SigG.Produce sig yv, RealField.C q, Module.C q yv) =>    Interpolation.T q yv ->    Interpolation.T q yv ->    TimeControl q ->    q -> q -> (q, sig yv) -> (q, sig yv)-timeReverse lazySize ipLeap ipStep+timeReverse ipLeap ipStep       timeCtrlWave loopLen loopStart (period0, sample) =    let (period, timeCtrl) =           timeControl timeCtrlWave period0 (loopLen/2)        wave = WaveG.sampledTone ipLeap ipStep period sample        loopCenter = round $ loopStart + loopLen/2        loop =-          SigG.fromState lazySize $+          SigG.fromState $           OsciS.shapeFreqMod wave              (Phase.fromRepresentative $ fromIntegral loopCenter / period)              (SigS.map (fromIntegral loopCenter +) timeCtrl)

@@ -21,17 +21,11 @@ Deterministic white noise, uniformly distributed between -1 and 1. That is, variance is 1\/3. -}-white ::-   (Ring.C y, Random y, SigG.Write sig y) =>-   SigG.LazySize -> sig y-white size =-   SigG.fromState size $ Noise.white+white :: (Ring.C y, Random y, SigG.Produce sig y) => sig y+white = SigG.fromState $ Noise.white -whiteGen ::-   (Ring.C y, Random y, RandomGen g, SigG.Write sig y) =>-   SigG.LazySize -> g -> sig y-whiteGen size =-   SigG.fromState size . Noise.whiteGen+whiteGen :: (Ring.C y, Random y, RandomGen g, SigG.Produce sig y) => g -> sig y+whiteGen = SigG.fromState . Noise.whiteGen   {- |@@ -39,10 +33,9 @@ by a quadratic B-spline distribution. -} whiteQuadraticBSplineGen ::-   (Ring.C y, Random y, RandomGen g, SigG.Write sig y) =>-   SigG.LazySize -> g -> sig y-whiteQuadraticBSplineGen size =-   SigG.fromState size . Noise.whiteQuadraticBSplineGen+   (Ring.C y, Random y, RandomGen g, SigG.Produce sig y) => g -> sig y+whiteQuadraticBSplineGen =+   SigG.fromState . Noise.whiteQuadraticBSplineGen   randomPeeks ::

@@ -39,11 +39,10 @@ {- * Oscillators with arbitrary but constant waveforms -}  {- | oscillator with constant frequency -}-static :: (RealField.C a, SigG.Write sig b) =>-   SigG.LazySize ->+static :: (RealField.C a, SigG.Produce sig b) =>    Wave.T a b -> (Phase.T a -> a -> sig b)-static size wave phase freq =-   SigG.fromState size (OsciS.static wave phase freq)+static wave phase freq =+   SigG.fromState (OsciS.static wave phase freq)  {- | oscillator with modulated frequency -} freqMod :: (RealField.C a, SigG.Transform sig a, SigG.Transform sig b) =>@@ -72,7 +71,7 @@ {- | oscillator with both shape and frequency modulation -} shapeFreqMod ::    (RealField.C a,-    SigG.Read sig c, SigG.Transform sig a, SigG.Transform sig b) =>+    SigG.Consume sig c, SigG.Transform sig a, SigG.Transform sig b) =>    (c -> Wave.T a b) -> Phase.T a -> sig c -> sig a -> sig b shapeFreqMod wave phase parameters =    Causal.apply@@ -83,12 +82,11 @@ {- | oscillator with a sampled waveform with constant frequency This is essentially an interpolation with cyclic padding. -}-staticSample :: (RealField.C a, SigG.Read wave b, SigG.Write sig b) =>-   SigG.LazySize ->+staticSample :: (RealField.C a, SigG.Consume wave b, SigG.Produce sig b) =>    Interpolation.T a b -> wave b -> Phase.T a -> a -> sig b-staticSample size ip wave phase freq =+staticSample ip wave phase freq =    let len = fromIntegral $ SigG.length wave-   in  SigG.fromState size $+   in  SigG.fromState $        Interpolation.relativeCyclicPad           ip (len * Phase.toRepresentative phase)           (SigG.toState wave)@@ -100,7 +98,7 @@ -} freqModSample ::    (RealField.C a,-    SigG.Read wave b, SigG.Transform sig a, SigG.Transform sig b) =>+    SigG.Consume wave b, SigG.Transform sig a, SigG.Transform sig b) =>    Interpolation.T a b -> wave b -> Phase.T a -> sig a -> sig b freqModSample ip wave phase freqs =    let len = fromIntegral $ SigG.length wave@@ -118,11 +116,9 @@ {- * Oscillators with specific waveforms -}  {- | sine oscillator with static frequency -}-staticSine :: (Trans.C a, RealField.C a, SigG.Write sig a) =>-   SigG.LazySize ->+staticSine :: (Trans.C a, RealField.C a, SigG.Produce sig a) =>    Phase.T a -> a -> sig a-staticSine size =-   static size Wave.sine+staticSine = static Wave.sine  {- | sine oscillator with modulated frequency -} freqModSine :: (Trans.C a, RealField.C a, SigG.Transform sig a) =>@@ -137,11 +133,8 @@    Causal.applySameType (OsciC.phaseMod Wave.sine freq)  {- | saw tooth oscillator with modulated frequency -}-staticSaw :: (RealField.C a, SigG.Write sig a) =>-   SigG.LazySize ->-   Phase.T a -> a -> sig a-staticSaw size =-   static size Wave.saw+staticSaw :: (RealField.C a, SigG.Produce sig a) => Phase.T a -> a -> sig a+staticSaw = static Wave.saw  {- | saw tooth oscillator with modulated frequency -} freqModSaw :: (RealField.C a, SigG.Transform sig a) =>

@@ -6,7 +6,7 @@ I created a new module. -} module Synthesizer.Generic.Piece (-   T, run,+   T, run, runChunks,    step, linear, exponential,    cosine, halfSine, cubic,    FlatPosition(..),@@ -18,8 +18,12 @@ import qualified Synthesizer.Generic.Control as Ctrl import qualified Synthesizer.Generic.Cut as CutG import qualified Synthesizer.Generic.Signal as SigG+import qualified Synthesizer.Storable.Signal as SigSt+import qualified Synthesizer.State.Signal as SigS import Synthesizer.Generic.Displacement (raise, ) +import Foreign.Storable (Storable)+ import qualified Algebra.Transcendental        as Trans import qualified Algebra.RealField             as RealField import qualified Algebra.Field                 as Field@@ -31,73 +35,81 @@  {-# INLINE run #-} run :: (RealField.C a, CutG.Transform (sig a)) =>-   SigG.LazySize ->-   Piecewise.T a a (SigG.LazySize -> a -> sig a) ->-   sig a-run lazySize xs =+   Piecewise.T a a (a -> sig a) -> sig a+run xs =    SigG.concat $ zipWith       (\(n, t) (Piecewise.PieceData c yi0 yi1 d) ->-           SigG.take n $ Piecewise.computePiece c yi0 yi1 d lazySize t)+         SigG.take n $ Piecewise.computePiece c yi0 yi1 d t)       (Piecewise.splitDurations $ map Piecewise.pieceDur xs)       xs +{-# INLINE runChunks #-}+runChunks :: (RealField.C a, Storable a) =>+   Piecewise.T a a (a -> SigS.T a) -> SigSt.T a+runChunks xs =+   SigSt.fromChunks $+   zipWith+      (\(n, t) (Piecewise.PieceData c yi0 yi1 d) ->+         SigS.toStrictStorableSignal n $ Piecewise.computePiece c yi0 yi1 d t)+      (Piecewise.splitDurations $ map Piecewise.pieceDur xs)+      xs + type T sig a =-   Piecewise.Piece a a-      (SigG.LazySize -> a {- fractional start time -} -> sig a)+   Piecewise.Piece a a (a {- fractional start time -} -> sig a)   {-# INLINE step #-}-step :: (SigG.Write sig a) => T sig a+step :: (SigG.Produce sig a) => T sig a step =-   Piecewise.pieceFromFunction $ \ y0 _y1 _d lazySize _t0 ->-      Ctrl.constant lazySize y0+   Piecewise.pieceFromFunction $ \ y0 _y1 _d _t0 ->+      Ctrl.constant y0  {-# INLINE linear #-}-linear :: (Field.C a, SigG.Write sig a) => T sig a+linear :: (Field.C a, SigG.Produce sig a) => T sig a linear =-   Piecewise.pieceFromFunction $ \ y0 y1 d lazySize t0 ->+   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->       let s = (y1-y0)/d-      in  Ctrl.linear lazySize s (y0-t0*s)+      in  Ctrl.linear s (y0-t0*s)  {-# INLINE exponential #-}-exponential :: (Trans.C a, SigG.Write sig a) => a -> T sig a+exponential :: (Trans.C a, SigG.Produce sig a) => a -> T sig a exponential saturation =-   Piecewise.pieceFromFunction $ \ y0 y1 d lazySize t0 ->+   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->       let y0' = y0-saturation           y1' = y1-saturation           yd  = y0'/y1'       in  raise saturation-             (Ctrl.exponential lazySize (d / log yd) (y0' * yd**(t0/d)))+             (Ctrl.exponential (d / log yd) (y0' * yd**(t0/d)))  {-# INLINE cosine #-}-cosine :: (Trans.C a, SigG.Write sig a) => T sig a+cosine :: (Trans.C a, SigG.Produce sig a) => T sig a cosine =-   Piecewise.pieceFromFunction $ \ y0 y1 d lazySize t0 ->+   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->       SigG.map          (\y -> ((1+y)*y0+(1-y)*y1)/2)-         (Ctrl.cosine lazySize t0 (t0+d))+         (Ctrl.cosine t0 (t0+d))   {- | > Graphics.Gnuplot.Simple.plotList [] $ Sig.toList $ run $ 1 |# (10.9, halfSine FlatRight) #| 2 -} {-# INLINE halfSine #-}-halfSine :: (Trans.C a, SigG.Write sig a) => FlatPosition -> T sig a+halfSine :: (Trans.C a, SigG.Produce sig a) => FlatPosition -> T sig a halfSine FlatLeft =-   Piecewise.pieceFromFunction $ \ y0 y1 d lazySize t0 ->+   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->       SigG.map          (\y -> y*y0 + (1-y)*y1)-         (Ctrl.cosine lazySize t0 (t0+2*d))+         (Ctrl.cosine t0 (t0+2*d)) halfSine FlatRight =-   Piecewise.pieceFromFunction $ \ y0 y1 d lazySize t0 ->+   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->       SigG.map          (\y -> (1+y)*y0 - y*y1)-         (Ctrl.cosine lazySize (t0-d) (t0+d))+         (Ctrl.cosine (t0-d) (t0+d))   {-# INLINE cubic #-}-cubic :: (Field.C a, SigG.Write sig a) => a -> a -> T sig a+cubic :: (Field.C a, SigG.Produce sig a) => a -> a -> T sig a cubic yd0 yd1 =-   Piecewise.pieceFromFunction $ \ y0 y1 d lazySize t0 ->-      Ctrl.cubicHermite lazySize (t0,(y0,yd0)) (t0+d,(y1,yd1))+   Piecewise.pieceFromFunction $ \ y0 y1 d t0 ->+      Ctrl.cubicHermite (t0,(y0,yd0)) (t0+d,(y1,yd1))

@@ -2,7 +2,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE RankNTypes #-} {- |@@ -38,6 +37,7 @@ import qualified Synthesizer.Plain.Signal as Sig import qualified Synthesizer.State.Signal as SigS import qualified Synthesizer.Storable.Signal as SigSt+import qualified Data.StorableVector.Lazy.Typed as SVT import qualified Data.StorableVector.Lazy as SVL import qualified Data.StorableVector as SV @@ -51,39 +51,35 @@ import qualified Data.List as List import Data.Function (fix, ) import Data.Tuple.HT (mapPair, mapFst, fst3, snd3, thd3, )+import Data.Bool.HT (if') import Data.Monoid (Monoid, mappend, mempty, )-import Data.Semigroup (Semigroup, (<>), ) -import qualified Algebra.ToInteger    as ToInteger-import qualified Algebra.ToRational   as ToRational-import qualified Algebra.Absolute     as Absolute-import qualified Algebra.RealIntegral as RealIntegral-import qualified Algebra.IntegralDomain as Integral-import qualified Algebra.NonNegative  as NonNeg-import qualified Algebra.ZeroTestable as ZeroTestable- import qualified Algebra.Module   as Module-import qualified Algebra.Ring     as Ring import qualified Algebra.Additive as Additive-import qualified Algebra.Monoid   as Monoid-import Algebra.Additive ((+), (-), )  import qualified Data.EventList.Relative.BodyTime as EventList  import qualified Numeric.NonNegative.Class as NonNeg98 -import qualified Test.QuickCheck as QC- import qualified Prelude as P import Prelude    (Bool, Int, Maybe(Just), maybe, fst, snd,-    (==), (<), (>), (<=), (>=), compare, Ordering(..),+    (==), (<), (>), (<=), (>=), compare, min, Ordering(..),     flip, uncurry, const, (.), ($), (&&), id, (++),-    fmap, return, error, show,-    Eq, Ord, Show, min, max, )+    fmap, return, error, show, )  +{- $setup+>>> import qualified Synthesizer.Storable.Signal as SigSt+>>> import Synthesizer.Generic.Signal (delay, delayLoopOverlap)+>>> import Synthesizer.Generic.Filter.NonRecursive (amplify)+>>> import qualified Algebra.Additive as Additive+>>> import Data.Function (fix)+>>> import qualified Test.QuickCheck as QC+-} ++ class Storage signal where     data Constraints signal :: *@@ -91,7 +87,7 @@    constraints :: signal -> Constraints signal  -class Read0 sig where+class Consume0 sig where    toList :: Storage (sig y) => sig y -> [y]    toState :: Storage (sig y) => sig y -> SigS.T y --   toState :: Storage (sig y) => StateT (sig y) Maybe y@@ -99,9 +95,9 @@    foldR :: Storage (sig y) => (y -> s -> s) -> s -> sig y -> s    index :: Storage (sig y) => sig y -> Int -> y -class (Cut.Read (sig y), Read0 sig, Storage (sig y)) => Read sig y where+class (Cut.Consume (sig y), Consume0 sig, Storage (sig y)) => Consume sig y where -class (Read0 sig) => Transform0 sig where+class (Consume0 sig) => Transform0 sig where    cons :: Storage (sig y) => y -> sig y -> sig y    takeWhile :: Storage (sig y) => (y -> Bool) -> sig y -> sig y    dropWhile :: Storage (sig y) => (y -> Bool) -> sig y -> sig y@@ -118,7 +114,6 @@     zipWithAppend :: Storage (sig y) => (y -> y -> y) -> sig y -> sig y -> sig y -   -- functions from Transform2 that are oftenly used with only one type variable    map ::       (Storage (sig y0), Storage (sig y1)) =>       (y0 -> y1) -> (sig y0 -> sig y1)@@ -129,187 +124,165 @@       (Storage (sig y0), Storage (sig y1)) =>       (y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1 -class (Cut.Transform (sig y), Transform0 sig, Read sig y) => Transform sig y where+class (Cut.Transform (sig y), Transform0 sig, Consume sig y) => Transform sig y where  -{- |-This type is used for specification of the maximum size of strict packets.-Packets can be smaller, can have different sizes in one signal.-In some kinds of streams, like lists and stateful generators,-the packet size is always 1.-The packet size is not just a burden caused by efficiency,-but we need control over packet size in applications with feedback. -ToDo: Make the element type of the corresponding signal a type parameter.-This helps to distinguish chunk sizes of scalar and vectorised signals.+{- |+We could provide the 'LazySize' by a Reader monad,+but we don't do that because we expect that the choice of the lazy size+is more local than say the choice of the sample rate.+E.g. there is no need to have the same laziness coarseness+for multiple signal processors. -}-newtype LazySize = LazySize Int-   deriving (Eq, Ord, Show,-             Additive.C, Ring.C, ZeroTestable.C,-             ToInteger.C, ToRational.C, Absolute.C,-             RealIntegral.C, Integral.C)+class Transform0 sig => Produce0 sig where+   fromList :: Storage (sig y) => [y] -> sig y+   repeat :: Storage (sig y) => y -> sig y+   replicate :: Storage (sig y) => Int -> y -> sig y+   iterate :: Storage (sig y) => (y -> y) -> y -> sig y+   iterateAssociative :: Storage (sig y) => (y -> y -> y) -> y -> sig y+   unfoldR :: Storage (sig y) => (s -> Maybe (y,s)) -> s -> sig y -instance Semigroup LazySize where-   LazySize a <> LazySize b = LazySize (a + b)+class (Produce0 sig, Transform sig y) => Produce sig y where -instance Monoid LazySize where-   mempty = LazySize 0-   mappend = (<>) -instance Monoid.C LazySize where-   idt = LazySize 0-   LazySize a <*> LazySize b = LazySize (a + b)+instance (Storable y) => Storage (SVT.Vector size y) where+   data Constraints (SVT.Vector size y) = Storable y => StorableTypedConstraints+   constraints _ = StorableTypedConstraints -instance NonNeg.C LazySize where-   split = NonNeg.splitDefault (\(LazySize n) -> n) LazySize -instance QC.Arbitrary LazySize where-   arbitrary =-      case defaultLazySize of-         LazySize n -> fmap LazySize (QC.choose (1, 2 P.* n))+consumeSVT ::+   (Storable a => SVT.Vector size a -> b) ->+   (Storage (SVT.Vector size a) => SVT.Vector size a -> b)+consumeSVT f x = case constraints x of StorableTypedConstraints -> f x -instance Cut.Read LazySize where-   null (LazySize n) = n==0-   length (LazySize n) = n+produceSVT ::+   (Storable a => SVT.Vector size a) ->+   (Storage (SVT.Vector size a) => SVT.Vector size a)+produceSVT x =+   let z = case constraints z of StorableTypedConstraints -> x+   in  z -instance Cut.Transform LazySize where-   {-# INLINE take #-}-   take m (LazySize n) = LazySize $ min (max 0 m) n-   {-# INLINE drop #-}-   drop m (LazySize n) = LazySize $ max 0 $ n - max 0 m-   {-# INLINE splitAt #-}-   splitAt m x =-      let y = Cut.take m x-      in  (y, x-y)-   {-# INLINE dropMarginRem #-}-   dropMarginRem n m x@(LazySize xs) =-      let d = min m $ max 0 $ xs - n-      in  (m-d, Cut.drop d x)-   {-# INLINE reverse #-}-   reverse = id+instance (SVT.Size size, Storable y) => Consume (SVT.Vector size) y where+-- instance Storable y => Consume SigSt.T y where +instance (SVT.Size size) => Consume0 (SVT.Vector size) where+   {-# INLINE toList #-}+   toList = consumeSVT SVT.unpack+   {-# INLINE toState #-}+   toState = consumeSVT (SigS.fromStorableSignal . SVT.toVectorLazy)+   {-# INLINE foldL #-}+   foldL f x = consumeSVT (SVT.foldl f x)+   {-# INLINE foldR #-}+   foldR f x = consumeSVT (SVT.foldr f x)+   {-# INLINE index #-}+   index = consumeSVT SVT.index -{- |-This can be used for internal signals-that have no observable effect on laziness.-E.g. when you construct a list-by @repeat defaultLazySize zero@-we assume that 'zero' is defined for all Additive types.--}-defaultLazySize :: LazySize-defaultLazySize =-   let (SVL.ChunkSize size) = SVL.defaultChunkSize-   in  LazySize size -{- |-We could provide the 'LazySize' by a Reader monad,-but we don't do that because we expect that the choice of the lazy size-is more local than say the choice of the sample rate.-E.g. there is no need to have the same laziness coarseness-for multiple signal processors.--}-class Transform0 sig => Write0 sig where-   fromList :: Storage (sig y) => LazySize -> [y] -> sig y---   fromState :: Storage (sig y) => LazySize -> SigS.T y -> sig y---   fromState :: Storage (sig y) => LazySize -> StateT s Maybe y -> s -> sig y-   repeat :: Storage (sig y) => LazySize -> y -> sig y-   replicate :: Storage (sig y) => LazySize -> Int -> y -> sig y-   iterate :: Storage (sig y) => LazySize -> (y -> y) -> y -> sig y-   iterateAssociative :: Storage (sig y) => LazySize -> (y -> y -> y) -> y -> sig y-   unfoldR :: Storage (sig y) => LazySize -> (s -> Maybe (y,s)) -> s -> sig y+instance (SVT.Size size, Storable y) => Transform (SVT.Vector size) y where -class (Write0 sig, Transform sig y) => Write sig y where+instance (SVT.Size size) => Transform0 (SVT.Vector size) where+   {-# INLINE cons #-}+   cons x = consumeSVT (SVT.cons x)+   {-# INLINE takeWhile #-}+   takeWhile p = consumeSVT (SVT.takeWhile p)+   {-# INLINE dropWhile #-}+   dropWhile p = consumeSVT (SVT.dropWhile p)+   {-# INLINE span #-}+   span p = consumeSVT (SVT.span p) +   {-# INLINE viewL #-}+   viewL = consumeSVT SVT.viewL+   {-# INLINE viewR #-}+   viewR = consumeSVT SVT.viewR +   {-# INLINE map #-}+   map f x = produceSVT (consumeSVT (SVT.map f) x)+   {-# INLINE scanL #-}+   scanL f a x = produceSVT (consumeSVT (SVT.scanl f a) x)+   {-# INLINE crochetL #-}+   crochetL f a x = produceSVT (consumeSVT (SVT.crochetL f a) x)+   {-# INLINE zipWithAppend #-}+   zipWithAppend f = consumeSVT (SVT.zipWithAppend f)++++instance (SVT.Size size, Storable y) => Produce (SVT.Vector size) y where++instance (SVT.Size size) => Produce0 (SVT.Vector size) where+   {-# INLINE fromList #-}+   fromList = \x -> produceSVT (SVT.pack x)+   {-# INLINE repeat #-}+   repeat = \x -> produceSVT (SVT.repeat x)+   {-# INLINE replicate #-}+   replicate = \n x -> produceSVT (SVT.replicate n x)+   {-# INLINE iterate #-}+   iterate = \f x -> produceSVT (SVT.iterate f x)+   {-# INLINE unfoldR #-}+   unfoldR = \f x -> produceSVT (SVT.unfoldr f x)+   {-# INLINE iterateAssociative #-}+   iterateAssociative = \op x -> produceSVT (SVT.iterate (op x) x) -- should be optimized+++ instance (Storable y) => Storage (SVL.Vector y) where    data Constraints (SVL.Vector y) = Storable y => StorableLazyConstraints    constraints _ = StorableLazyConstraints  -readSVL ::+consumeSVL ::    (Storable a => SVL.Vector a -> b) ->    (Storage (SVL.Vector a) => SVL.Vector a -> b)-readSVL f x = case constraints x of StorableLazyConstraints -> f x+consumeSVL f x = case constraints x of StorableLazyConstraints -> f x -writeSVL ::+produceSVL ::    (Storable a => SVL.Vector a) ->    (Storage (SVL.Vector a) => SVL.Vector a)-writeSVL x =+produceSVL x =    let z = case constraints z of StorableLazyConstraints -> x    in  z -{--getSVL ::-   Storable a =>-   (Storage SVL.Vector a => SVL.Vector a) ->-   (SVL.Vector a)-getSVL x = case constraints x of StorableLazyConstraints -> x--}--instance Storable y => Read SVL.Vector y where+instance Storable y => Consume SVL.Vector y where+-- instance Storable y => Consume SigSt.T y where --- instance Storable y => Read SigSt.T y where-instance Read0 SVL.Vector where+instance Consume0 SVL.Vector where    {-# INLINE toList #-}-   toList = readSVL SVL.unpack+   toList = consumeSVL SVL.unpack    {-# INLINE toState #-}-   toState = readSVL SigS.fromStorableSignal+   toState = consumeSVL SigS.fromStorableSignal    {-# INLINE foldL #-}-   foldL f x = readSVL (SVL.foldl f x)+   foldL f x = consumeSVL (SVL.foldl f x)    {-# INLINE foldR #-}-   foldR f x = readSVL (SVL.foldr f x)+   foldR f x = consumeSVL (SVL.foldr f x)    {-# INLINE index #-}-   index = readSVL SVL.index+   index = consumeSVL SVL.index   instance Storable y => Transform SVL.Vector y where  instance Transform0 SVL.Vector where    {-# INLINE cons #-}-   cons x = readSVL (SVL.cons x)+   cons x = consumeSVL (SVL.cons x)    {-# INLINE takeWhile #-}-   takeWhile p = readSVL (SVL.takeWhile p)+   takeWhile p = consumeSVL (SVL.takeWhile p)    {-# INLINE dropWhile #-}-   dropWhile p = readSVL (SVL.dropWhile p)+   dropWhile p = consumeSVL (SVL.dropWhile p)    {-# INLINE span #-}-   span p = readSVL (SVL.span p)+   span p = consumeSVL (SVL.span p)     {-# INLINE viewL #-}-   viewL = readSVL SVL.viewL+   viewL = consumeSVL SVL.viewL    {-# INLINE viewR #-}-   viewR = readSVL SVL.viewR+   viewR = consumeSVL SVL.viewR     {-# INLINE map #-}-   map f x = writeSVL (readSVL (SVL.map f) x)+   map f x = produceSVL (consumeSVL (SVL.map f) x)    {-# INLINE scanL #-}-   scanL f a x = writeSVL (readSVL (SVL.scanl f a) x)+   scanL f a x = produceSVL (consumeSVL (SVL.scanl f a) x)    {-# INLINE crochetL #-}-   crochetL f a x = writeSVL (readSVL (SVL.crochetL f a) x)+   crochetL f a x = produceSVL (consumeSVL (SVL.crochetL f a) x)    {-# INLINE zipWithAppend #-}-   zipWithAppend f = readSVL (SigSt.zipWithAppend f)----withStorableContext ::-   (SVL.ChunkSize -> a) -> (LazySize -> a)-withStorableContext f =-   \(LazySize size) -> f (SVL.ChunkSize size)--instance Storable y => Write SVL.Vector y where--instance Write0 SVL.Vector where-   {-# INLINE fromList #-}-   fromList = withStorableContext $ \size x -> writeSVL (SVL.pack size x)-   {-# INLINE repeat #-}-   repeat = withStorableContext $ \size x -> writeSVL (SVL.repeat size x)-   {-# INLINE replicate #-}-   replicate = withStorableContext $ \size n x -> writeSVL (SVL.replicate size n x)-   {-# INLINE iterate #-}-   iterate = withStorableContext $ \size f x -> writeSVL (SVL.iterate size f x)-   {-# INLINE unfoldR #-}-   unfoldR = withStorableContext $ \size f x -> writeSVL (SVL.unfoldr size f x)-   {-# INLINE iterateAssociative #-}-   iterateAssociative = withStorableContext $ \size op x -> writeSVL (SVL.iterate size (op x) x) -- should be optimized+   zipWithAppend f = consumeSVL (SigSt.zipWithAppend f)   @@ -317,61 +290,61 @@    data Constraints (SV.Vector y) = Storable y => StorableConstraints    constraints _ = StorableConstraints -readSV ::+consumeSV ::    (Storable a => SV.Vector a -> b) ->    (Storage (SV.Vector a) => SV.Vector a -> b)-readSV f x = case constraints x of StorableConstraints -> f x+consumeSV f x = case constraints x of StorableConstraints -> f x -writeSV ::+produceSV ::    (Storable a => SV.Vector a) ->    (Storage (SV.Vector a) => SV.Vector a)-writeSV x =+produceSV x =    let z = case constraints z of StorableConstraints -> x    in  z  -instance Storable y => Read SV.Vector y where+instance Storable y => Consume SV.Vector y where -instance Read0 SV.Vector where+instance Consume0 SV.Vector where    {-# INLINE toList #-}-   toList = readSV SV.unpack+   toList = consumeSV SV.unpack    {-# INLINE toState #-}-   toState = readSV SigS.fromStrictStorableSignal+   toState = consumeSV SigS.fromStrictStorableSignal    {-# INLINE foldL #-}-   foldL f x = readSV (SV.foldl f x)+   foldL f x = consumeSV (SV.foldl f x)    {-# INLINE foldR #-}-   foldR f x = readSV (SV.foldr f x)+   foldR f x = consumeSV (SV.foldr f x)    {-# INLINE index #-}-   index = readSV SV.index+   index = consumeSV SV.index  instance Storable y => Transform SV.Vector y where  instance Transform0 SV.Vector where    {-# INLINE cons #-}-   cons x = readSV (SV.cons x)+   cons x = consumeSV (SV.cons x)    {-# INLINE takeWhile #-}-   takeWhile p = readSV (SV.takeWhile p)+   takeWhile p = consumeSV (SV.takeWhile p)    {-# INLINE dropWhile #-}-   dropWhile p = readSV (SV.dropWhile p)+   dropWhile p = consumeSV (SV.dropWhile p)    {-# INLINE span #-}-   span p = readSV (SV.span p)+   span p = consumeSV (SV.span p)     {-# INLINE viewL #-}-   viewL = readSV SV.viewL+   viewL = consumeSV SV.viewL    {-# INLINE viewR #-}-   viewR = readSV SV.viewR+   viewR = consumeSV SV.viewR     {-# INLINE map #-}-   map f x = writeSV (readSV (SV.map f) x)+   map f x = produceSV (consumeSV (SV.map f) x)    {-# INLINE scanL #-}-   scanL f a x = writeSV (readSV (SV.scanl f a) x)+   scanL f a x = produceSV (consumeSV (SV.scanl f a) x)    {-# INLINE crochetL #-}    crochetL f a x =-      writeSV (fst (readSV (SV.crochetLResult f a) x))+      produceSV (fst (consumeSV (SV.crochetLResult f a) x))       -- fst . SV.crochetContL f acc    {-# INLINE zipWithAppend #-}    zipWithAppend f =-      readSV (\xs ys ->+      consumeSV (\xs ys ->          case compare (SV.length xs) (SV.length ys) of             EQ -> SV.zipWith f xs ys             LT -> SV.append (SV.zipWith f xs ys) (SV.drop (SV.length xs) ys)@@ -383,9 +356,9 @@    data Constraints [y] = ListConstraints    constraints _ = ListConstraints -instance Read [] y where+instance Consume [] y where -instance Read0 [] where+instance Consume0 [] where    {-# INLINE toList #-}    toList = id    {-# INLINE toState #-}@@ -425,21 +398,21 @@    zipWithAppend = Sig.zipWithAppend  -instance Write [] y where+instance Produce [] y where -instance Write0 [] where+instance Produce0 [] where    {-# INLINE fromList #-}-   fromList _ = id+   fromList = id    {-# INLINE repeat #-}-   repeat _ = List.repeat+   repeat = List.repeat    {-# INLINE replicate #-}-   replicate _ = List.replicate+   replicate = List.replicate    {-# INLINE iterate #-}-   iterate _ = List.iterate+   iterate = List.iterate    {-# INLINE unfoldR #-}-   unfoldR _ = List.unfoldr+   unfoldR = List.unfoldr    {-# INLINE iterateAssociative #-}-   iterateAssociative _ = ListHT.iterateAssociative+   iterateAssociative = ListHT.iterateAssociative   @@ -447,9 +420,9 @@    data Constraints (SigS.T y) = StateConstraints    constraints _ = StateConstraints -instance Read SigS.T y+instance Consume SigS.T y -instance Read0 SigS.T where+instance Consume0 SigS.T where    {-# INLINE toList #-}    toList = SigS.toList    {-# INLINE toState #-}@@ -495,21 +468,21 @@    zipWithAppend = SigS.zipWithAppend  -instance Write SigS.T y+instance Produce SigS.T y -instance Write0 SigS.T where+instance Produce0 SigS.T where    {-# INLINE fromList #-}-   fromList _ = SigS.fromList+   fromList = SigS.fromList    {-# INLINE repeat #-}-   repeat _ = SigS.repeat+   repeat = SigS.repeat    {-# INLINE replicate #-}-   replicate _ = SigS.replicate+   replicate = SigS.replicate    {-# INLINE iterate #-}-   iterate _ = SigS.iterate+   iterate = SigS.iterate    {-# INLINE unfoldR #-}-   unfoldR _ = SigS.unfoldR+   unfoldR = SigS.unfoldR    {-# INLINE iterateAssociative #-}-   iterateAssociative _ = SigS.iterateAssociative+   iterateAssociative = SigS.iterateAssociative   instance Storage (EventList.T time y) where@@ -517,10 +490,10 @@    constraints _ = EventListConstraints  instance (NonNeg98.C time, P.Integral time) =>-      Read (EventList.T time) y where+      Consume (EventList.T time) y where  instance (NonNeg98.C time, P.Integral time) =>-      Read0 (EventList.T time) where+      Consume0 (EventList.T time) where    {-# INLINE toList #-}    toList =       List.concatMap (uncurry (flip List.genericReplicate)) .@@ -602,11 +575,9 @@    {-# INLINE map #-}    map = fmap    {-# INLINE scanL #-}-   scanL f x =-      fromState (LazySize 1) . SigS.scanL f x . toState+   scanL f x = eventListFromList . toList . SigS.scanL f x . toState    {-# INLINE crochetL #-}-   crochetL f x =-      fromState (LazySize 1) . SigS.crochetL f x . toState+   crochetL f x = eventListFromList . toList . SigS.crochetL f x . toState    {-# INLINE zipWithAppend #-}    zipWithAppend f =       let recourse xs ys =@@ -623,11 +594,16 @@                     (drop_ y yn ys0)       in  recourse +eventListFromList ::+   (NonNeg98.C time, P.Integral time) => [y] -> EventList.T time y+eventListFromList =+   EventList.fromPairList . List.map (flip (,) (P.fromInteger 1))  -instance (NonNeg98.C time, P.Integral time) => Write (EventList.T time) y where+{-+instance (NonNeg98.C time, P.Integral time) => Produce (EventList.T time) y where -instance (NonNeg98.C time, P.Integral time) => Write0 (EventList.T time) where+instance (NonNeg98.C time, P.Integral time) => Produce0 (EventList.T time) where    {-# INLINE fromList #-}    fromList _ =       EventList.fromPairList .@@ -651,6 +627,7 @@       in  recourse    {-# INLINE iterateAssociative #-}    iterateAssociative size f x = iterate size (f x) x+-}   {-# INLINE switchL #-}@@ -667,7 +644,7 @@  {-# INLINE runViewL #-} runViewL ::-   (Read sig y) =>+   (Consume sig y) =>    sig y ->    (forall s. (s -> Maybe (y, s)) -> s -> x) ->    x@@ -676,7 +653,7 @@  {-# INLINE runSwitchL #-} runSwitchL ::-   (Read sig y) =>+   (Consume sig y) =>    sig y ->    (forall s. (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x) ->    x@@ -694,17 +671,17 @@ mix = zipWithAppend (Additive.+)  {-# INLINE zip #-}-zip :: (Read sig a, Transform sig b, Transform sig (a,b)) =>+zip :: (Consume sig a, Transform sig b, Transform sig (a,b)) =>    sig a -> sig b -> sig (a,b) zip = zipWith (,)  {-# INLINE zipWith #-}-zipWith :: (Read sig a, Transform sig b, Transform sig c) =>+zipWith :: (Consume sig a, Transform sig b, Transform sig c) =>    (a -> b -> c) -> (sig a -> sig b -> sig c) zipWith h = zipWithState h . toState  {-# INLINE zipWith3 #-}-zipWith3 :: (Read sig a, Read sig b, Transform sig c) =>+zipWith3 :: (Consume sig a, Consume sig b, Transform sig c) =>    (a -> b -> c -> c) -> (sig a -> sig b -> sig c -> sig c) zipWith3 h as bs = zipWithState3 h (toState as) (toState bs) @@ -752,10 +729,8 @@   {-# INLINE delay #-}-delay :: (Write sig y) =>-   LazySize -> y -> Int -> sig y -> sig y-delay size z n =-   append (replicate size n z)+delay :: (Produce sig y) => y -> Int -> sig y -> sig y+delay z n = append (replicate n z)  {-# INLINE delayLoop #-} delayLoop ::@@ -768,9 +743,44 @@    fix (append prefix . proc)  +{- |+Inefficient for @State.Signal@.++>>> delayLoopOverlap 5 (amplify 0.5) [1::Float]+[1.0]+>>> delayLoopOverlap 5 (amplify 0.5) [1,0,0,0,0::Float]+[1.0,0.0,0.0,0.0,0.0]+>>> delayLoopOverlap 5 (amplify 0.5) [1,0,0,0,0,0::Float]+[1.0,0.0,0.0,0.0,0.0,0.5]+>>> delayLoopOverlap 5 (amplify 0.5) [1,0,0,0,0,0,0,0,0::Float]+[1.0,0.0,0.0,0.0,0.0,0.5,0.0,0.0,0.0]++prop> :{+   QC.forAll (QC.choose (1,10)) $ \time ->+   QC.forAll (QC.choose (1,10)) $ \cs ->+   QC.forAll (QC.choose (0.5,1.0::Float)) $ \gain ->+   \xs ->+   delayLoopOverlap time (amplify gain) xs+   ==+   (SigSt.toList $+    delayLoopOverlap time (amplify gain) $+    SigSt.fromList (SigSt.chunkSize cs) xs)+:}++prop> :{+   let delayLoopOverlapProduce time proc xs =+         fix (zipWith (Additive.+) xs . delay Additive.zero time . proc)+   in QC.forAll (QC.choose (1,10)) $ \time ->+      QC.forAll (QC.choose (0.5,1.0)) $ \gain ->+      \xs ->+      delayLoopOverlap time (amplify gain) xs+      ==+      delayLoopOverlapProduce time (amplify gain) (xs :: [Float])+:}+-} {-# INLINE delayLoopOverlap #-} delayLoopOverlap ::-   (Additive.C y, Write sig y) =>+   (Additive.C y, Transform sig y) =>       Int    -> (sig y -> sig y)             {- ^ Processor that shall be run in a feedback loop.@@ -782,17 +792,18 @@    -> sig y -- ^ input    -> sig y -- ^ output has the same length as the input delayLoopOverlap time proc xs =-   fix (zipWith (Additive.+) xs .-        delay defaultLazySize Additive.zero time . proc)+   if' (Cut.null xs) mempty $+   let (prefix, suffix) = Cut.splitAt time xs+   in fix (mappend prefix . zipWith (Additive.+) suffix . proc)    {-# INLINE sum #-}-sum :: (Additive.C a, Read sig a) => sig a -> a+sum :: (Additive.C a, Consume sig a) => sig a -> a sum = foldL (Additive.+) Additive.zero  {-# INLINE sum1 #-}-sum1 :: (Additive.C a, Read sig a) => sig a -> a+sum1 :: (Additive.C a, Consume sig a) => sig a -> a sum1 = SigS.foldL1 (Additive.+) . toState {- sum1 :: (Additive.C a, Transform sig a) => sig a -> a@@ -804,12 +815,12 @@   {-# INLINE foldMap #-}-foldMap :: (Read sig a, Monoid m) => (a -> m) -> sig a -> m+foldMap :: (Consume sig a, Monoid m) => (a -> m) -> sig a -> m foldMap f = foldR (mappend . f) mempty  {-# DEPRECATED monoidConcatMap "Use foldMap instead." #-} {-# INLINE monoidConcatMap #-}-monoidConcatMap :: (Read sig a, Monoid m) => (a -> m) -> sig a -> m+monoidConcatMap :: (Consume sig a, Monoid m) => (a -> m) -> sig a -> m monoidConcatMap = foldMap  @@ -827,7 +838,7 @@    switchL xs (flip const) xs  {-# INLINE mapAdjacent #-}-mapAdjacent :: (Read sig a, Transform sig a) =>+mapAdjacent :: (Consume sig a, Transform sig a) =>    (a -> a -> a) -> sig a -> sig a mapAdjacent f xs0 =    let xs1 = maybe xs0 snd (viewL xs0)@@ -841,7 +852,7 @@  {-| Here the control may vary over the time. -} {-# INLINE modifyModulated #-}-modifyModulated :: (Transform sig a, Transform sig b, Read sig ctrl) =>+modifyModulated :: (Transform sig a, Transform sig b, Consume sig ctrl) =>    Modifier.Simple s ctrl a b -> sig ctrl -> sig a -> sig b modifyModulated (Modifier.Simple state proc) control =    runViewL control (\next c0 ->@@ -861,24 +872,21 @@ -- cf. Module.linearComb {-# INLINE linearComb #-} linearComb ::-   (Module.C t y, Read sig t, Read sig y) =>+   (Module.C t y, Consume sig t, Consume sig y) =>    sig t -> sig y -> y linearComb ts ys =    SigS.sum (SigS.zipWith (Module.*>) (toState ts) (toState ys))  -fromState :: (Write sig y) =>-   LazySize -> SigS.T y -> sig y-fromState size (SigS.Cons f x) =-   unfoldR size (runStateT f) x+fromState :: (Produce sig y) => SigS.T y -> sig y+fromState (SigS.Cons f x) = unfoldR (runStateT f) x  {-# INLINE extendConstant #-}-extendConstant :: (Write sig y) =>-   LazySize -> sig y -> sig y-extendConstant size xt =+extendConstant :: (Produce sig y) => sig y -> sig y+extendConstant xt =    maybe       xt-      (append xt . repeat size . snd)+      (append xt . repeat . snd)       (viewR xt)  snoc :: (Transform sig y) => sig y -> y -> sig y@@ -901,10 +909,9 @@ Thus we prefer crochetL, although we do not consume single elements of the input signal. -} mapTailsAlt ::-   (Transform sig a, Write sig b) =>-   LazySize -> (sig a -> b) -> sig a -> sig b-mapTailsAlt size f =-   unfoldR size (\xs ->+   (Transform sig a, Produce sig b) => (sig a -> b) -> sig a -> sig b+mapTailsAlt f =+   unfoldR (\xs ->       do (_,ys) <- viewL xs          Just (f xs, ys)) @@ -912,7 +919,7 @@ Only non-empty suffixes are processed. More oftenly we might need -> zipWithTails :: (Read sig b, Transform2 sig a) =>+> zipWithTails :: (Consume sig b, Transform sig a) => >    (b -> sig a -> a) -> sig b -> sig a -> sig a  this would preserve the chunk structure of @sig a@,

@@ -16,7 +16,6 @@ import qualified Sound.Sox.Write as Write import qualified Sound.Sox.Option.Format as SoxOpt import qualified Synthesizer.Basic.Binary as BinSmp-import qualified Synthesizer.Storable.Signal as SigSt import qualified Synthesizer.Generic.Signal as SigG import qualified Synthesizer.State.Signal as Sig import qualified Synthesizer.Causal.Process as Causal@@ -33,12 +32,17 @@ import qualified Synthesizer.State.Control as CtrlS import qualified Synthesizer.State.Oscillator as OsciS +import qualified Data.StorableVector.Lazy.Typed as SVT+import Data.Int (Int16, )+ import System.Exit (ExitCode, ) import NumericPrelude.Numeric import NumericPrelude.Base import Prelude ()  +type Signal = SVT.Vector SVT.DefaultChunkSize+ {- | First, we define a play routine for lazy storable vectors. Storable lazy vectors are lazy lists of low-level arrays.@@ -48,11 +52,12 @@ This means that elements must have fixed size and advanced data types like functions cannot be used. -}-play :: SigSt.T Double -> IO ExitCode-play =-   Play.simple SigSt.hPut SoxOpt.none 44100 .-   SigSt.map BinSmp.int16FromDouble+play :: Signal Double -> IO ExitCode+play = playInt16 . SigG.map BinSmp.int16FromDouble +playInt16 :: Signal Int16 -> IO ExitCode+playInt16 = Play.simple SVT.hPut SoxOpt.none 44100+ {- | Here is a simple oscillator generated as lazy storable vector. An oscillator is a signal generator,@@ -63,16 +68,16 @@ -} oscillator :: IO ExitCode oscillator =-   play (Osci.static SigG.defaultLazySize Wave.sine zero (0.01::Double))+   play (Osci.static Wave.sine zero (0.01::Double))   {- | A routine just for the case that we want to post-process a signal somewhere else. -}-write :: FilePath -> SigSt.T Double -> IO ExitCode+write :: FilePath -> Signal Double -> IO ExitCode write name =-   Write.simple SigSt.hPut SoxOpt.none name 44100 .-   SigSt.map BinSmp.int16FromDouble+   Write.simple SVT.hPut SoxOpt.none name 44100 .+   SigG.map BinSmp.int16FromDouble  {- | The simple brass sound demonstrates@@ -85,11 +90,11 @@ --   write "brass.aiff" $    play $    Filt.envelope-      (Piece.run SigG.defaultLazySize $+      (Piece.run $        0    |# ( 3000, Piece.cubic 0.002 0) #|-        0.7 -|# (50000, Piece.step) #|-        0.7 -|# (10000, Piece.exponential 0) #| (0.01::Double)) $-   SigG.fromState SigG.defaultLazySize $+   SigG.fromState $    Filt.amplify 0.5 $    SigG.mix       (OsciS.static Wave.saw zero (0.00499::Double))@@ -104,12 +109,12 @@ can be used in the addressed signal type. -} filterSawSig ::-   (SigG.Write sig Double,+   (SigG.Produce sig Double,     SigG.Transform sig (UniFilter.Result Double),     SigG.Transform sig (UniFilter.Parameter Double)) =>    sig Double filterSawSig =-   SigG.map UniFilter.lowpass $ SigG.modifyModulated UniFilter.modifier (SigG.map (\f -> UniFilter.parameter $ FiltRec.Pole 10 (0.04+0.02*f)) $ Osci.static SigG.defaultLazySize Wave.sine zero (0.00001::Double)) $ Osci.static SigG.defaultLazySize Wave.saw zero (0.002::Double)+   SigG.map UniFilter.lowpass $ SigG.modifyModulated UniFilter.modifier (SigG.map (\f -> UniFilter.parameter $ FiltRec.Pole 10 (0.04+0.02*f)) $ Osci.static Wave.sine zero (0.00001::Double)) $ Osci.static Wave.saw zero (0.002::Double)  {- | Here we instantiate 'filterSawSig' for storable vectors and play it.@@ -141,10 +146,7 @@ that generates the storable vector to be played in one go. -} playState :: Sig.T Double -> IO ExitCode-playState =-   Play.simple SigSt.hPut SoxOpt.none 44100 .-   SigG.fromState SigG.defaultLazySize .-   Sig.map BinSmp.int16FromDouble+playState = playInt16 . SigG.fromState . Sig.map BinSmp.int16FromDouble  {- | We demonstrate the stateful signal generator using the known 'filterSaw' example.

@@ -18,27 +18,26 @@   replicateLong ::-   (SigG.Write sig y) =>+   (SigG.Produce sig y) =>    StrictTime -> y -> sig y replicateLong tl y =    CutG.concat $    map (\t ->       SigG.replicate --         (SigG.LazySize $ fromIntegral $ maxBound::Int)-         SigG.defaultLazySize          (NonNegW.toNumber t) y) $    PC.chopLongTime tl  {-# INLINE toSignal #-}-toSignal :: (SigG.Write sig y) => EventListBT.T StrictTime y -> sig y+toSignal :: (SigG.Produce sig y) => EventListBT.T StrictTime y -> sig y toSignal = PC.toSignal replicateLong  {-# INLINE toSignalInit #-}-toSignalInit :: (SigG.Write sig y) => y -> EventList.T StrictTime y -> sig y+toSignalInit :: (SigG.Produce sig y) => y -> EventList.T StrictTime y -> sig y toSignalInit = PC.toSignalInit replicateLong  {-# INLINE toSignalInitWith #-} toSignalInitWith ::-   (SigG.Write sig c) =>+   (SigG.Produce sig c) =>    (y -> c) -> c -> EventList.T StrictTime [y] -> sig c toSignalInitWith = PC.toSignalInitWith replicateLong

@@ -33,6 +33,19 @@ import NumericPrelude.Base  +{- $setup+>>> import qualified Synthesizer.Plain.Oscillator as Osci+>>> import qualified Synthesizer.Basic.Wave       as Wave+>>>+>>> import qualified Test.QuickCheck as QC+>>>+>>> import qualified Number.Ratio as Ratio+>>> import NumericPrelude.Numeric+>>> import NumericPrelude.Base+>>> import Prelude ()+-}++ type Phase a = a  @@ -56,7 +69,21 @@     map (Wave.apply wave) $     zipWith Phase.increment phases (iterate (Phase.increment freq) zero) -{- | oscillator with modulated shape -}+{- | oscillator with modulated shape++prop> :{+   let waves =+         ("saw", Wave.saw) :+         ("square", Wave.square) :+         ("triangle", Wave.triangle) :+         [] in+   QC.forAllShow (QC.elements waves) fst $+   \(_,wave) freq phases0 ->+   let phases = map (% Ratio.denominator (freq::Rational)) phases0+   in Osci.phaseMod wave freq phases ==+      Osci.shapeMod (Wave.phaseOffset wave) zero freq phases+:}+-} shapeMod ::     (RealRing.C a) => (c -> Wave.T a b) -> (Phase a) -> a -> Sig.T c -> Sig.T b shapeMod wave phase freq parameters =

@@ -434,34 +434,20 @@       (runStateT f a0)  {- iterated 'cons' is very inefficient+we could use an interim list+ viewR :: T a -> Maybe (T a, a) viewR =    foldR (\x mxs -> Just (maybe (empty,x) (mapFst (cons x)) mxs)) Nothing -} -{-# INLINE viewR #-}-viewR :: Storable a => T a -> Maybe (T a, a)-viewR = viewRSize SigSt.defaultChunkSize -{-# INLINE viewRSize #-}-viewRSize :: Storable a => SigSt.ChunkSize -> T a -> Maybe (T a, a)-viewRSize size =-   fmap (mapFst fromStorableSignal) .-   SigSt.viewR .-   toStorableSignal size-- {-# INLINE switchL #-} switchL :: b -> (a -> T a -> b) -> T a -> b switchL n j =    maybe n (uncurry j) . viewL -{-# INLINE switchR #-}-switchR :: Storable a => b -> (T a -> a -> b) -> T a -> b-switchR n j =-   maybe n (uncurry j) . viewR - {- | This implementation requires that the input generator has to check repeatedly whether it is finished.@@ -529,23 +515,8 @@    switchL (error $ "State.Signal: index " ++ show n ++ " too large") const . drop n  -{- splitAt :: Int -> T a -> (T a, T a)-splitAt n = mapPair (Cons, Cons) . List.splitAt n . decons--}--{-# INLINE splitAt #-}-splitAt :: Storable a =>-   Int -> T a -> (T a, T a)-splitAt = splitAtSize SigSt.defaultChunkSize--{-# INLINE splitAtSize #-}-splitAtSize :: Storable a =>-   SigSt.ChunkSize -> Int -> T a -> (T a, T a)-splitAtSize size n =-   mapPair (fromStorableSignal, fromStorableSignal) .-   SigSt.splitAt n .-   toStorableSignal size+splitAt n = mapPair (fromList, fromList) . List.splitAt n . toList   {-# INLINE dropWhile #-}@@ -560,23 +531,8 @@    switchL empty (\ x xs -> if p x then dropWhile p xs else xt) xt -} -{- span :: (a -> Bool) -> T a -> (T a, T a)-span p = mapPair (Cons, Cons) . List.span p . decons--}--{-# INLINE span #-}-span :: Storable a =>-   (a -> Bool) -> T a -> (T a, T a)-span = spanSize SigSt.defaultChunkSize--{-# INLINE spanSize #-}-spanSize :: Storable a =>-   SigSt.ChunkSize -> (a -> Bool) -> T a -> (T a, T a)-spanSize size p =-   mapPair (fromStorableSignal, fromStorableSignal) .-   SigSt.span p .-   toStorableSignal size+span p = mapPair (fromList, fromList) . List.span p . toList   {-# INLINE cycle #-}@@ -635,20 +591,6 @@                 (fmap (mapSnd ((,) True)) $ viewL ys)))       (False,xs) -{-# INLINE appendStored #-}-appendStored :: Storable a =>-   T a -> T a -> T a-appendStored = appendStoredSize SigSt.defaultChunkSize--{-# INLINE appendStoredSize #-}-appendStoredSize :: Storable a =>-   SigSt.ChunkSize -> T a -> T a -> T a-appendStoredSize size xs ys =-   fromStorableSignal $-   SigSt.append-      (toStorableSignal size xs)-      (toStorableSignal size ys)- {-# INLINE concat #-} -- | certainly inefficient because of frequent list deconstruction concat :: [T a] -> T a@@ -662,19 +604,6 @@        List.init . List.tails)  -{-# INLINE concatStored #-}-concatStored :: Storable a =>-   [T a] -> T a-concatStored = concatStoredSize SigSt.defaultChunkSize--{-# INLINE concatStoredSize #-}-concatStoredSize :: Storable a =>-   SigSt.ChunkSize -> [T a] -> T a-concatStoredSize size =-   fromStorableSignal .-   SigSt.concat .-   List.map (toStorableSignal size)- {- This should be faster than Monad.ap if an empty signal as second operand is detected.@@ -695,19 +624,6 @@    T a -> T a reverse =    fromList . List.reverse . toList--{-# INLINE reverseStored #-}-reverseStored :: Storable a =>-   T a -> T a-reverseStored = reverseStoredSize SigSt.defaultChunkSize--{-# INLINE reverseStoredSize #-}-reverseStoredSize :: Storable a =>-   SigSt.ChunkSize -> T a -> T a-reverseStoredSize size =-   fromStorableSignal .-   SigSt.reverse .-   toStorableSignal size   {-# INLINE sum #-}

@@ -0,0 +1,88 @@+{- |+Variants of functions from "Synthesizer.State.Signal"+that use a 'StorableVector' for interim storage.+-}+module Synthesizer.State.Storable where++import Synthesizer.State.Signal (T, fromStorableSignal, toStorableSignal)++import qualified Synthesizer.Storable.Signal as SigSt+import Foreign.Storable (Storable)++import Data.Tuple.HT (mapFst, mapPair)+++{-# INLINE viewR #-}+viewR :: Storable a => T a -> Maybe (T a, a)+viewR = viewRSize SigSt.defaultChunkSize++{-# INLINE viewRSize #-}+viewRSize :: Storable a => SigSt.ChunkSize -> T a -> Maybe (T a, a)+viewRSize size =+   fmap (mapFst fromStorableSignal) . SigSt.viewR . toStorableSignal size++{-# INLINE switchR #-}+switchR :: Storable a => b -> (T a -> a -> b) -> T a -> b+switchR n j =+   maybe n (uncurry j) . viewR+++{-# INLINE splitAt #-}+splitAt :: Storable a => Int -> T a -> (T a, T a)+splitAt = splitAtSize SigSt.defaultChunkSize++{-# INLINE splitAtSize #-}+splitAtSize :: Storable a => SigSt.ChunkSize -> Int -> T a -> (T a, T a)+splitAtSize size n =+   mapPair (fromStorableSignal, fromStorableSignal) .+   SigSt.splitAt n .+   toStorableSignal size+++{-# INLINE span #-}+span :: Storable a => (a -> Bool) -> T a -> (T a, T a)+span = spanSize SigSt.defaultChunkSize++{-# INLINE spanSize #-}+spanSize :: Storable a => SigSt.ChunkSize -> (a -> Bool) -> T a -> (T a, T a)+spanSize size p =+   mapPair (fromStorableSignal, fromStorableSignal) .+   SigSt.span p .+   toStorableSignal size+++infixr 5 `append`++{-# INLINE append #-}+append :: Storable a =>+   T a -> T a -> T a+append = appendSize SigSt.defaultChunkSize++{-# INLINE appendSize #-}+appendSize :: Storable a => SigSt.ChunkSize -> T a -> T a -> T a+appendSize size xs ys =+   fromStorableSignal $+   SigSt.append+      (toStorableSignal size xs)+      (toStorableSignal size ys)+++{-# INLINE concat #-}+concat :: Storable a => [T a] -> T a+concat = concatSize SigSt.defaultChunkSize++{-# INLINE concatSize #-}+concatSize :: Storable a => SigSt.ChunkSize -> [T a] -> T a+concatSize size =+   fromStorableSignal . SigSt.concat . map (toStorableSignal size)+++{-# INLINE reverse #-}+reverse :: Storable a =>+   T a -> T a+reverse = reverseSize SigSt.defaultChunkSize++{-# INLINE reverseSize #-}+reverseSize :: Storable a => SigSt.ChunkSize -> T a -> T a+reverseSize size =+   fromStorableSignal . SigSt.reverse . toStorableSignal size

@@ -48,7 +48,7 @@ -} {-# INLINE interpolateCell #-} interpolateCell ::-   (SigG.Read sig y) =>+   (SigG.Consume sig y) =>    Interpolation.T a y ->    Interpolation.T b y ->    (a, b) ->@@ -72,7 +72,7 @@   makePrototype ::-   (RealField.C a, SigG.Read sig v) =>+   (RealField.C a, SigG.Consume sig v) =>    Interpolation.Margin ->    Interpolation.Margin ->    a -> sig v -> Prototype sig a v

@@ -33,6 +33,43 @@ import Prelude ()  +{- $setup+>>> import qualified Synthesizer.Storable.Cut as CutSt+>>> import qualified Synthesizer.Storable.Signal as SigSt+>>>+>>> import qualified Synthesizer.Plain.Cut as Cut+>>> import qualified Synthesizer.Plain.Signal as Sig+>>>+>>> import qualified Data.EventList.Relative.TimeBody  as EventList+>>> import qualified Data.List.HT as ListHT+>>>+>>> import qualified Number.NonNegative as NonNeg+>>>+>>> import qualified Test.QuickCheck as QC+>>>+>>> import NumericPrelude.Numeric+>>> import NumericPrelude.Base+>>> import Prelude ()+>>>+>>>+>>> genEventList :: QC.Gen (EventList.T NonNeg.Int (Sig.T Int))+>>> genEventList = fmap (EventList.mapTime (flip mod 1000)) QC.arbitrary+-}+++{- |+prop> :{+   \chunkSize ->+   QC.forAll genEventList $ \evs ->+   let sevs = EventList.mapBody (SigSt.fromList chunkSize) evs+   in  ListHT.allEqual $+       SigSt.fromList chunkSize (Cut.arrange evs) :+       CutSt.arrangeAdaptive chunkSize sevs :+       CutSt.arrangeList chunkSize sevs :+       CutSt.arrangeEquidist chunkSize sevs :+       []+:}+-} {-# INLINE arrange #-} arrange :: (Storable v, Additive.C v) =>        Sig.ChunkSize

@@ -19,7 +19,7 @@    convolveDownsample2,    inverseFrequencyModulationFloor,    sumsPosModulatedPyramid,-   accumulatePosModulatedPyramid,+   accumulatePosModulatedFromPyramid,    accumulateBinPosModulatedPyramid,    movingAverageModulatedPyramid,    movingAccumulateModulatedPyramid,@@ -223,12 +223,12 @@ since it generates strict blocks and not one-block chunky signals. -}-accumulatePosModulatedPyramid ::+accumulatePosModulatedFromPyramid ::    (Storable v) =>    ([SigSt.T v] -> (Int,Int) -> v) ->    ([Int], [SigSt.T v]) ->    SigSt.T (Int,Int) -> SigSt.T v-accumulatePosModulatedPyramid accumulate (sizes,pyr0) ctrl =+accumulatePosModulatedFromPyramid accumulate (sizes,pyr0) ctrl =    let blockSize = head sizes        pyrStarts = iterate (zipWith SigSt.drop sizes) pyr0        ctrlBlocks = SigS.toList $ SigG.sliceVertical blockSize ctrl@@ -245,7 +245,7 @@    (Additive.C v, Storable v) =>    Int -> SigSt.T (Int,Int) -> SigSt.T v -> SigSt.T v sumsPosModulatedPyramid height ctrl xs =-   accumulatePosModulatedPyramid+   accumulatePosModulatedFromPyramid       FiltG.sumRangeFromPyramid       (addSizes $ pyramid (+) height xs)       ctrl@@ -255,7 +255,7 @@    (v -> v -> v) ->    Int -> SigSt.T (Int,Int) -> SigSt.T v -> SigSt.T v accumulateBinPosModulatedPyramid acc height ctrl xs =-   accumulatePosModulatedPyramid+   accumulatePosModulatedFromPyramid       (\pyr ->          fromMaybe (error "accumulateBinPosModulatedPyramid: empty window") .          FiltG.maybeAccumulateRangeFromPyramid acc pyr)@@ -322,7 +322,7 @@ -} {-# INLINE inverseFrequencyModulationFloor #-} inverseFrequencyModulationFloor ::-   (Storable v, SigG.Read sig t, Ring.C t, Ord t) =>+   (Storable v, SigG.Consume sig t, Ring.C t, Ord t) =>    SigSt.ChunkSize ->    sig t -> SigSt.T v -> SigSt.T v inverseFrequencyModulationFloor chunkSize ctrl =

@@ -19,7 +19,7 @@ It is a checked error if their lengths differ. -} consChecked ::-   (CutG.Read a, CutG.Read b) =>+   (CutG.Consume a, CutG.Consume b) =>    String -> a -> b -> T a b consChecked name a b =    let lenA = CutG.length a@@ -118,7 +118,7 @@    mappend (Cons a0 b0) (Cons a1 b1) =       Cons (mappend a0 a1) (mappend b0 b1) -instance (CutG.Read a, CutG.Read b) => CutG.Read (T a b) where+instance (CutG.Consume a, CutG.Consume b) => CutG.Consume (T a b) where    {-# INLINE null #-}    null (Cons a b) =       case (CutG.null a, CutG.null b) of@@ -138,7 +138,7 @@ where the combined signal has the length of the shorter member. This is like in zipWith. -instance (CutG.Read a, CutG.Read b) => CutG.Read (Parallel a b) where+instance (CutG.Consume a, CutG.Consume b) => CutG.Consume (Parallel a b) where    null (Parallel a b) = CutG.null a || CutG.null b    length (Parallel a b) = min (CutG.length a) (CutG.length b) -}

@@ -1,5 +1,5 @@ Name:           synthesizer-core-Version:        0.8.4+Version:        0.9 License:        GPL License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de>@@ -34,11 +34,12 @@  Flag optimizeAdvanced   description: Enable advanced optimizations. They slow down compilation considerably.-  default:     True+  manual:      True+  default:     False   Source-Repository this-  Tag:         0.8.4+  Tag:         0.9   Type:        darcs   Location:    http://code.haskell.org/synthesizer/core/ @@ -52,34 +53,34 @@     sox >=0.1 && <0.3,     transformers >=0.2 && <0.7,     non-empty >=0.2 && <0.4,-    semigroups >=0.1 && <1.0,+    semigroups >=0.1 && <1,     event-list >=0.1 && <0.2,     non-negative >=0.1 && <0.2,     explicit-exception >=0.1.6 && <0.3,     numeric-prelude >=0.4.2 && <0.5,     numeric-quest >=0.1 && <0.3,     utility-ht >=0.0.14 && <0.1,-    filepath >=1.1 && <1.5,+    filepath >=1.1 && <1.6,     bytestring >=0.9 && <0.13,     binary >=0.1 && <1,-    deepseq >=1.1 && <1.6,-    storablevector >=0.2.5 && <0.3,+    deepseq >=1.1 && <1.7,+    storablevector >=0.2.12 && <0.3,     storable-record >=0.0.1 && <0.1,     storable-tuple >=0.0.1 && <0.2,     QuickCheck >=1 && <3,     array >=0.1 && <0.6,-    containers >=0.1 && <0.8,-    random >=1.0 && <2.0,+    containers >=0.1 && <0.9,+    random >=1.0 && <1.4,     process >=1.0 && <1.7,-    base >= 4 && <5+    base >=4 && <5    If impl(ghc>=7.0) -- also warns about NumericPrelude import:  -fwarn-missing-import-lists     GHC-Options: -fwarn-unused-do-bind     CPP-Options: -DNoImplicitPrelude=RebindableSyntax-    Default-Language: Haskell2010     Default-Extensions: CPP +  Default-Language: Haskell2010   GHC-Options:    -Wall   Hs-source-dirs: src, private   Exposed-modules:@@ -171,6 +172,7 @@     Synthesizer.State.Oscillator     Synthesizer.State.Piece     Synthesizer.State.Signal+    Synthesizer.State.Storable     Synthesizer.State.ToneModulation     Synthesizer.Causal.Process     Synthesizer.Causal.Class@@ -239,17 +241,19 @@     non-negative,     utility-ht,     numeric-prelude,+    doctest-exitcode-stdio >=0.0 && <0.1,+    doctest-lib >=0.1.1 && <0.1.2,     QuickCheck,     random,     containers,-    base+    base >=4 && <5+  Default-Language: Haskell2010   GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates   Hs-Source-Dirs: test, private    If impl(ghc>=7.0)     GHC-Options: -fwarn-unused-do-bind     CPP-Options: -DNoImplicitPrelude=RebindableSyntax-    Default-Language: Haskell2010     Default-Extensions: CPP    Other-Modules:@@ -262,9 +266,7 @@     Test.Sound.Synthesizer.Plain.Filter.FirstOrder     Test.Sound.Synthesizer.Plain.Interpolation     Test.Sound.Synthesizer.Plain.NonEmpty-    Test.Sound.Synthesizer.Plain.Oscillator     Test.Sound.Synthesizer.Plain.ToneModulation-    Test.Sound.Synthesizer.Plain.Wave     Test.Sound.Synthesizer.Basic.ToneModulation     Test.Sound.Synthesizer.Basic.NumberTheory     Test.Sound.Synthesizer.Generic.Cut@@ -273,10 +275,14 @@     Test.Sound.Synthesizer.Generic.Fourier     Test.Sound.Synthesizer.Generic.FourierInteger     Test.Sound.Synthesizer.Generic.Filter-    Test.Sound.Synthesizer.Storable.Cut-    Test.Sound.Synthesizer.Causal.Analysis     Synthesizer.Basic.NumberTheory     Synthesizer.Generic.Permutation+    DocTest.Main+    DocTest.Synthesizer.Basic.Wave+    DocTest.Synthesizer.Storable.Cut+    DocTest.Synthesizer.Plain.Oscillator+    DocTest.Synthesizer.Generic.Signal+    DocTest.Synthesizer.Causal.Analysis   Main-Is: Test/Main.hs  @@ -294,9 +300,9 @@   If impl(ghc>=7.0)     GHC-Options: -fwarn-unused-do-bind     CPP-Options: -DNoImplicitPrelude=RebindableSyntax-    Default-Language: Haskell2010     Default-Extensions: CPP +  Default-Language: Haskell2010   GHC-Options:      -Wall   GHC-Prof-Options: -auto-all   Hs-Source-Dirs: speedtest@@ -312,14 +318,14 @@     binary,     bytestring,     utility-ht,-    base+    base >=4 && <5    If impl(ghc>=7.0)     GHC-Options: -fwarn-unused-do-bind     CPP-Options: -DNoImplicitPrelude=RebindableSyntax-    Default-Language: Haskell2010     Default-Extensions: CPP +  Default-Language: Haskell2010   GHC-Options: -Wall -fexcess-precision   If flag(optimizeAdvanced)     GHC-Options: -optc-ffast-math -optc-O3@@ -338,14 +344,14 @@     binary,     bytestring,     array,-    base+    base >=4 && <5    If impl(ghc>=7.0)     GHC-Options: -fwarn-unused-do-bind     CPP-Options: -DNoImplicitPrelude=RebindableSyntax-    Default-Language: Haskell2010     Default-Extensions: CPP +  Default-Language: Haskell2010   GHC-Options: -Wall -fexcess-precision   Hs-Source-Dirs: speedtest   Main-Is: SpeedTestExp.hs@@ -357,14 +363,14 @@     binary,     bytestring,     old-time,-    base+    base >=4 && <5    If impl(ghc>=7.0)     GHC-Options: -fwarn-unused-do-bind     CPP-Options: -DNoImplicitPrelude=RebindableSyntax-    Default-Language: Haskell2010     Default-Extensions: CPP +  Default-Language: Haskell2010   GHC-Options: -Wall   Hs-Source-Dirs: speedtest   Main-Is: SpeedTestSimple.hs

@@ -0,0 +1,18 @@+-- Do not edit! Automatically created with doctest-extract.+module DocTest.Main where++import qualified DocTest.Synthesizer.Basic.Wave+import qualified DocTest.Synthesizer.Storable.Cut+import qualified DocTest.Synthesizer.Plain.Oscillator+import qualified DocTest.Synthesizer.Generic.Signal+import qualified DocTest.Synthesizer.Causal.Analysis++import qualified Test.DocTest.Driver as DocTest++main :: DocTest.T ()+main = do+    DocTest.Synthesizer.Basic.Wave.test+    DocTest.Synthesizer.Storable.Cut.test+    DocTest.Synthesizer.Plain.Oscillator.test+    DocTest.Synthesizer.Generic.Signal.test+    DocTest.Synthesizer.Causal.Analysis.test

@@ -0,0 +1,102 @@+-- Do not edit! Automatically created with doctest-extract from src/Synthesizer/Basic/Wave.hs+{-# LINE 110 "src/Synthesizer/Basic/Wave.hs" #-}++module DocTest.Synthesizer.Basic.Wave where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 111 "src/Synthesizer/Basic/Wave.hs" #-}+import     qualified Synthesizer.Basic.Wave  as Wave+import     qualified Synthesizer.Basic.Phase as Phase++import     qualified Test.QuickCheck as QC++import     NumericPrelude.Numeric+import     NumericPrelude.Base+import     Prelude ()++zeroDCOffset     :: Wave.T Double Double -> QC.Property+zeroDCOffset     wave =+       QC.forAll (QC.choose (100,600)) $ \periodInt ->+       let period = fromIntegral periodInt+           xs = take periodInt $ map Phase.fromRepresentative $+                map (/period) $ iterate (1+) 0.5+       in  abs (sum (map (Wave.apply wave) xs))  <  period / fromInteger 100++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Synthesizer.Basic.Wave:215: "+{-# LINE 215 "src/Synthesizer/Basic/Wave.hs" #-}+ DocTest.property(+{-# LINE 215 "src/Synthesizer/Basic/Wave.hs" #-}+      zeroDCOffset Wave.sine+  )+ DocTest.printPrefix "Synthesizer.Basic.Wave:224: "+{-# LINE 224 "src/Synthesizer/Basic/Wave.hs" #-}+ DocTest.property(+{-# LINE 224 "src/Synthesizer/Basic/Wave.hs" #-}+      zeroDCOffset Wave.cosine+  )+ DocTest.printPrefix "Synthesizer.Basic.Wave:239: "+{-# LINE 239 "src/Synthesizer/Basic/Wave.hs" #-}+ DocTest.property(+{-# LINE 239 "src/Synthesizer/Basic/Wave.hs" #-}+      zeroDCOffset Wave.fastSine2+  )+ DocTest.printPrefix "Synthesizer.Basic.Wave:261: "+{-# LINE 261 "src/Synthesizer/Basic/Wave.hs" #-}+ DocTest.property(+{-# LINE 261 "src/Synthesizer/Basic/Wave.hs" #-}+      zeroDCOffset Wave.fastSine3+  )+ DocTest.printPrefix "Synthesizer.Basic.Wave:283: "+{-# LINE 283 "src/Synthesizer/Basic/Wave.hs" #-}+ DocTest.property(+{-# LINE 283 "src/Synthesizer/Basic/Wave.hs" #-}+      zeroDCOffset Wave.fastSine4+  )+ DocTest.printPrefix "Synthesizer.Basic.Wave:417: "+{-# LINE 417 "src/Synthesizer/Basic/Wave.hs" #-}+ DocTest.property(+{-# LINE 417 "src/Synthesizer/Basic/Wave.hs" #-}+      zeroDCOffset Wave.saw+  )+ DocTest.printPrefix "Synthesizer.Basic.Wave:430: "+{-# LINE 430 "src/Synthesizer/Basic/Wave.hs" #-}+ DocTest.property(+{-# LINE 430 "src/Synthesizer/Basic/Wave.hs" #-}+      zeroDCOffset Wave.sawCos+  )+ DocTest.printPrefix "Synthesizer.Basic.Wave:535: "+{-# LINE 535 "src/Synthesizer/Basic/Wave.hs" #-}+ DocTest.property(+{-# LINE 535 "src/Synthesizer/Basic/Wave.hs" #-}+      zeroDCOffset Wave.square+  )+ DocTest.printPrefix "Synthesizer.Basic.Wave:594: "+{-# LINE 594 "src/Synthesizer/Basic/Wave.hs" #-}+ DocTest.property(+{-# LINE 594 "src/Synthesizer/Basic/Wave.hs" #-}+      zeroDCOffset Wave.triangle+  )+ DocTest.printPrefix "Synthesizer.Basic.Wave:1003: "+{-# LINE 1003 "src/Synthesizer/Basic/Wave.hs" #-}+ DocTest.property(+{-# LINE 1003 "src/Synthesizer/Basic/Wave.hs" #-}+      QC.forAll (QC.choose (-1,1)) $ zeroDCOffset . Wave.squareBalanced+  )+ DocTest.printPrefix "Synthesizer.Basic.Wave:1030: "+{-# LINE 1030 "src/Synthesizer/Basic/Wave.hs" #-}+ DocTest.property(+{-# LINE 1030 "src/Synthesizer/Basic/Wave.hs" #-}+      QC.forAll (QC.choose (0,1)) $ zeroDCOffset . Wave.trapezoid+  )+ DocTest.printPrefix "Synthesizer.Basic.Wave:1078: "+{-# LINE 1078 "src/Synthesizer/Basic/Wave.hs" #-}+ DocTest.property(+{-# LINE 1078 "src/Synthesizer/Basic/Wave.hs" #-}+        +   QC.forAll (QC.choose (0,1)) $ \w ->+   QC.forAll (QC.choose (-1,1)) $ \r ->+   zeroDCOffset $ Wave.trapezoidBalanced w r+  )

@@ -0,0 +1,66 @@+-- Do not edit! Automatically created with doctest-extract from src/Synthesizer/Causal/Analysis.hs+{-# LINE 19 "src/Synthesizer/Causal/Analysis.hs" #-}++module DocTest.Synthesizer.Causal.Analysis where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 20 "src/Synthesizer/Causal/Analysis.hs" #-}+import     qualified Synthesizer.Causal.Analysis as AnaC+import     qualified Synthesizer.Causal.Process as Causal+import     qualified Synthesizer.Plain.Analysis as Ana++import     Control.Arrow ((<<<))++import     qualified Data.NonEmpty.Class as NonEmptyC+import     qualified Data.NonEmpty as NonEmpty+import     qualified Data.List.Match as Match+import     qualified Data.List as List++import     qualified Test.QuickCheck as QC++import     NumericPrelude.Numeric+import     NumericPrelude.Base+import     Prelude ()++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Synthesizer.Causal.Analysis:44: "+{-# LINE 44 "src/Synthesizer/Causal/Analysis.hs" #-}+ DocTest.property(+{-# LINE 44 "src/Synthesizer/Causal/Analysis.hs" #-}+        +   \xs ->+      Match.take xs (Ana.deltaSigmaModulation xs)+      ==+      Causal.apply AnaC.deltaSigmaModulation (xs::[Rational])+  )+ DocTest.printPrefix "Synthesizer.Causal.Analysis:61: "+{-# LINE 61 "src/Synthesizer/Causal/Analysis.hs" #-}+ DocTest.property(+{-# LINE 61 "src/Synthesizer/Causal/Analysis.hs" #-}+        +   \threshold xs ->+      Match.take xs (Ana.deltaSigmaModulationPositive threshold xs)+      ==+      Causal.apply+         (AnaC.deltaSigmaModulationPositive <<<+          Causal.feedConstFst threshold)+         (xs::[Rational])+  )+ DocTest.printPrefix "Synthesizer.Causal.Analysis:86: "+{-# LINE 86 "src/Synthesizer/Causal/Analysis.hs" #-}+ DocTest.property(+{-# LINE 86 "src/Synthesizer/Causal/Analysis.hs" #-}+        +   let movingMedian :: (Ord a) => Int -> [a] -> [a]+       movingMedian n =+         map (\xs -> List.sort xs !! div (length xs) 2) . NonEmpty.tail .+         NonEmptyC.zipWith (drop . max 0) (NonEmptyC.iterate succ (negate n)) .+         NonEmpty.inits++   in QC.forAll (QC.choose (1,20)) $ \n xs ->+         movingMedian n xs+         ==+         Causal.apply (AnaC.movingMedian n) (xs::[Char])+  )

@@ -0,0 +1,75 @@+-- Do not edit! Automatically created with doctest-extract from src/Synthesizer/Generic/Signal.hs+{-# LINE 72 "src/Synthesizer/Generic/Signal.hs" #-}++module DocTest.Synthesizer.Generic.Signal where++import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 73 "src/Synthesizer/Generic/Signal.hs" #-}+import     qualified Synthesizer.Storable.Signal as SigSt+import     Synthesizer.Generic.Signal (delay, delayLoopOverlap)+import     Synthesizer.Generic.Filter.NonRecursive (amplify)+import     qualified Algebra.Additive as Additive+import     Data.Function (fix)+import     qualified Test.QuickCheck as QC++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Synthesizer.Generic.Signal:749: "+{-# LINE 749 "src/Synthesizer/Generic/Signal.hs" #-}+ DocTest.example(+{-# LINE 749 "src/Synthesizer/Generic/Signal.hs" #-}+    delayLoopOverlap 5 (amplify 0.5) [1::Float]+  )+  [ExpectedLine [LineChunk "[1.0]"]]+ DocTest.printPrefix "Synthesizer.Generic.Signal:751: "+{-# LINE 751 "src/Synthesizer/Generic/Signal.hs" #-}+ DocTest.example(+{-# LINE 751 "src/Synthesizer/Generic/Signal.hs" #-}+    delayLoopOverlap 5 (amplify 0.5) [1,0,0,0,0::Float]+  )+  [ExpectedLine [LineChunk "[1.0,0.0,0.0,0.0,0.0]"]]+ DocTest.printPrefix "Synthesizer.Generic.Signal:753: "+{-# LINE 753 "src/Synthesizer/Generic/Signal.hs" #-}+ DocTest.example(+{-# LINE 753 "src/Synthesizer/Generic/Signal.hs" #-}+    delayLoopOverlap 5 (amplify 0.5) [1,0,0,0,0,0::Float]+  )+  [ExpectedLine [LineChunk "[1.0,0.0,0.0,0.0,0.0,0.5]"]]+ DocTest.printPrefix "Synthesizer.Generic.Signal:755: "+{-# LINE 755 "src/Synthesizer/Generic/Signal.hs" #-}+ DocTest.example(+{-# LINE 755 "src/Synthesizer/Generic/Signal.hs" #-}+    delayLoopOverlap 5 (amplify 0.5) [1,0,0,0,0,0,0,0,0::Float]+  )+  [ExpectedLine [LineChunk "[1.0,0.0,0.0,0.0,0.0,0.5,0.0,0.0,0.0]"]]+ DocTest.printPrefix "Synthesizer.Generic.Signal:758: "+{-# LINE 758 "src/Synthesizer/Generic/Signal.hs" #-}+ DocTest.property(+{-# LINE 758 "src/Synthesizer/Generic/Signal.hs" #-}+        +   QC.forAll (QC.choose (1,10)) $ \time ->+   QC.forAll (QC.choose (1,10)) $ \cs ->+   QC.forAll (QC.choose (0.5,1.0::Float)) $ \gain ->+   \xs ->+   delayLoopOverlap time (amplify gain) xs+   ==+   (SigSt.toList $+    delayLoopOverlap time (amplify gain) $+    SigSt.fromList (SigSt.chunkSize cs) xs)+  )+ DocTest.printPrefix "Synthesizer.Generic.Signal:770: "+{-# LINE 770 "src/Synthesizer/Generic/Signal.hs" #-}+ DocTest.property(+{-# LINE 770 "src/Synthesizer/Generic/Signal.hs" #-}+        +   let delayLoopOverlapProduce time proc xs =+         fix (zipWith (Additive.+) xs . delay Additive.zero time . proc)+   in QC.forAll (QC.choose (1,10)) $ \time ->+      QC.forAll (QC.choose (0.5,1.0)) $ \gain ->+      \xs ->+      delayLoopOverlap time (amplify gain) xs+      ==+      delayLoopOverlapProduce time (amplify gain) (xs :: [Float])+  )

@@ -0,0 +1,36 @@+-- Do not edit! Automatically created with doctest-extract from src/Synthesizer/Plain/Oscillator.hs+{-# LINE 36 "src/Synthesizer/Plain/Oscillator.hs" #-}++module DocTest.Synthesizer.Plain.Oscillator where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 37 "src/Synthesizer/Plain/Oscillator.hs" #-}+import     qualified Synthesizer.Plain.Oscillator as Osci+import     qualified Synthesizer.Basic.Wave       as Wave++import     qualified Test.QuickCheck as QC++import     qualified Number.Ratio as Ratio+import     NumericPrelude.Numeric+import     NumericPrelude.Base+import     Prelude ()++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Synthesizer.Plain.Oscillator:74: "+{-# LINE 74 "src/Synthesizer/Plain/Oscillator.hs" #-}+ DocTest.property(+{-# LINE 74 "src/Synthesizer/Plain/Oscillator.hs" #-}+        +   let waves =+         ("saw", Wave.saw) :+         ("square", Wave.square) :+         ("triangle", Wave.triangle) :+         [] in+   QC.forAllShow (QC.elements waves) fst $+   \(_,wave) freq phases0 ->+   let phases = map (% Ratio.denominator (freq::Rational)) phases0+   in Osci.phaseMod wave freq phases ==+      Osci.shapeMod (Wave.phaseOffset wave) zero freq phases+  )

@@ -0,0 +1,46 @@+-- Do not edit! Automatically created with doctest-extract from src/Synthesizer/Storable/Cut.hs+{-# LINE 36 "src/Synthesizer/Storable/Cut.hs" #-}++module DocTest.Synthesizer.Storable.Cut where++import qualified Test.DocTest.Driver as DocTest++{-# LINE 37 "src/Synthesizer/Storable/Cut.hs" #-}+import     qualified Synthesizer.Storable.Cut as CutSt+import     qualified Synthesizer.Storable.Signal as SigSt++import     qualified Synthesizer.Plain.Cut as Cut+import     qualified Synthesizer.Plain.Signal as Sig++import     qualified Data.EventList.Relative.TimeBody  as EventList+import     qualified Data.List.HT as ListHT++import     qualified Number.NonNegative as NonNeg++import     qualified Test.QuickCheck as QC++import     NumericPrelude.Numeric+import     NumericPrelude.Base+import     Prelude ()+++genEventList     :: QC.Gen (EventList.T NonNeg.Int (Sig.T Int))+genEventList     = fmap (EventList.mapTime (flip mod 1000)) QC.arbitrary++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Synthesizer.Storable.Cut:61: "+{-# LINE 61 "src/Synthesizer/Storable/Cut.hs" #-}+ DocTest.property(+{-# LINE 61 "src/Synthesizer/Storable/Cut.hs" #-}+        +   \chunkSize ->+   QC.forAll genEventList $ \evs ->+   let sevs = EventList.mapBody (SigSt.fromList chunkSize) evs+   in  ListHT.allEqual $+       SigSt.fromList chunkSize (Cut.arrange evs) :+       CutSt.arrangeAdaptive chunkSize sevs :+       CutSt.arrangeList chunkSize sevs :+       CutSt.arrangeEquidist chunkSize sevs :+       []+  )

@@ -1,12 +1,12 @@ module Main where +import qualified DocTest.Main+ import qualified Test.Sound.Synthesizer.Plain.Analysis       as Analysis import qualified Test.Sound.Synthesizer.Plain.Control        as Control import qualified Test.Sound.Synthesizer.Plain.Filter         as Filter import qualified Test.Sound.Synthesizer.Plain.Filter.FirstOrder as Filt1 import qualified Test.Sound.Synthesizer.Plain.Interpolation  as Interpolation-import qualified Test.Sound.Synthesizer.Plain.Oscillator     as Oscillator-import qualified Test.Sound.Synthesizer.Plain.Wave           as Wave import qualified Test.Sound.Synthesizer.Basic.NumberTheory   as NumberTheory import qualified Test.Sound.Synthesizer.Basic.ToneModulation as ToneModulation import qualified Test.Sound.Synthesizer.Plain.ToneModulation as ToneModulationL@@ -16,28 +16,28 @@ import qualified Test.Sound.Synthesizer.Generic.FourierInteger as FourierInteger import qualified Test.Sound.Synthesizer.Generic.Filter  as FilterG import qualified Test.Sound.Synthesizer.Generic.Cut  as CutG-import qualified Test.Sound.Synthesizer.Causal.Analysis as AnalysisC-import qualified Test.Sound.Synthesizer.Storable.Cut as Cut  import Data.Tuple.HT (mapFst, ) +import qualified Test.QuickCheck as QC+import qualified Test.DocTest.Driver as DocTest -prefix :: String -> [(String, IO ())] -> [(String, IO ())]++prefix :: String -> [(String, QC.Property)] -> [(String, QC.Property)] prefix msg =    map (mapFst (\str -> msg ++ "." ++ str))  main :: IO () main =-   mapM_ (\(msg,io) -> putStr (msg++": ") >> io) $+   DocTest.run $+   (DocTest.Main.main >>) $+   mapM_ (\(msg,io) -> DocTest.printPrefix (msg++": ") >> DocTest.property io) $    concat $       prefix "Plain.Analysis"       Analysis.tests :       prefix "Plain.Control"        Control.tests :       prefix "Plain.Filter.FirstOrder" Filt1.tests :       prefix "Plain.Filter"         Filter.tests :       prefix "Plain.Interpolation"  Interpolation.tests :-      prefix "Plain.Oscillator"     Oscillator.tests :-      prefix "Plain.Wave"           Wave.tests :-      prefix "Storable.Cut"         Cut.tests :       prefix "Generic.Cut"          CutG.tests :       prefix "Basic.ToneModulation" ToneModulation.tests :       prefix "Plain.ToneModulation" ToneModulationL.tests :@@ -47,5 +47,4 @@       prefix "Basic.NumberTheory"     NumberTheory.tests :       prefix "Generic.FourierInteger" FourierInteger.tests :       prefix "Generic.Filter"         FilterG.tests :-      prefix "Causal.Analysis"        AnalysisC.tests :       []

@@ -11,7 +11,7 @@ import qualified Data.Bits as Bit  import qualified Test.QuickCheck as QC-import Test.QuickCheck (Testable, Arbitrary, arbitrary, quickCheck, )+import Test.QuickCheck (Testable, Arbitrary, arbitrary, property, )  import qualified Algebra.Absolute              as Absolute @@ -55,16 +55,13 @@  simple ::    (Testable t, Arbitrary (wrapper Integer), Show (wrapper Integer)) =>-   (wrapper Integer -> t) -> IO ()-simple = quickCheck--singleArgs :: QC.Args-singleArgs = QC.stdArgs {QC.maxSuccess = 1}+   (wrapper Integer -> t) -> QC.Property+simple = property -tests :: [(String, IO ())]+tests :: [(String, QC.Property)] tests =    ("multiplicativeGenerator set vs. divisor",-      quickCheck $ \(Prime n) ->+      property $ \(Prime n) ->          NT.multiplicativeGeneratorSet n          ==          NT.multiplicativeGeneratorDivisors n) :@@ -96,7 +93,7 @@          let g = length . NT.rootsOfUnityPower m          in  g (Order $ lcm a b) == lcm (g ao) (g bo)) :    ("ringsWithPrimitiveRootsOfUnityAndUnits: minimal modulus",-      quickCheck $ \order@(Order expo) ->+      property $ \order@(Order expo) ->          {-          Often equality holds, but not always.          Smallest counter-example: expo=80.@@ -106,7 +103,7 @@          (head $ NT.ringsWithPrimitiveRootsOfUnityAndUnitsNaive             [order] [expo])) :    ("combine two rings with primitive roots of certain orders",-      quickCheck $ \m n ->+      property $ \m n ->          let r = lcm                    (head (NT.ringsWithPrimitiveRootOfUnityAndUnit m))                    (head (NT.ringsWithPrimitiveRootOfUnityAndUnit n))@@ -114,7 +111,7 @@              &&              NT.hasPrimitiveRootOfUnityInteger r n) :    ("combine many rings with primitive roots of certain orders",-      quickCheck $ QC.forAll (take 3 <$> QC.listOf1 (QC.choose (1,10))) $ \ns ->+      property $ QC.forAll (take 3 <$> QC.listOf1 (QC.choose (1,10))) $ \ns ->          let order = NT.lcmMulti ns          in  take 3 (NT.ringsWithPrimitiveRootsOfUnityAndUnitsNaive                        (map Order ns) ns)@@ -131,20 +128,20 @@    But in Z_{3·7} the number 3 is no unit.     ("combine rings with certain units",-      quickCheck $ \(Positive m) (Positive n) ->+      property $ \(Positive m) (Positive n) ->          let r = fromIntegral $ lcm                 (head (NT.ringsWithPrimitiveRootOfUnityAndUnit m))                 (head (NT.ringsWithPrimitiveRootOfUnityAndUnit n))          in  PID.coprime r m && PID.coprime r n) : -}    ("number of roots of unity lcm",-      quickCheck $ \(Positive n) (Positive k) (Positive l) ->+      property $ \(Positive n) (Positive k) (Positive l) ->          let orders = NT.ordersOfRootsOfUnityInteger !! (n-1)          in  lcm (orders!!(k-1)) (orders!!(l-1))              ==              orders !! (lcm k l - 1)) :    ("number of roots of unity vs. primitive roots",-      quickCheck $ \(Positive n) (Positive k) ->+      property $ \(Positive n) (Positive k) ->          (sum $ map snd $           filter (flip divides k . fst) $           zip@@ -153,41 +150,41 @@          ==          NT.ordersOfRootsOfUnityInteger !! (n-1) !! (k-1)) :    ("divideByMaximumPower",-      QC.quickCheck $+      QC.property $          QC.forAll (QC.choose (2,10::Integer)) $ \b (Positive n) ->          NT.divideByMaximumPower b n == NT.divideByMaximumPowerRecursive b n) :    ("numbers3Smooth",-      QC.quickCheckWith singleArgs $ ListHT.allEqual $ map (take 10000) $+      QC.property $ ListHT.allEqual $ map (take 10000) $          [NT.numbers3SmoothCorec, NT.numbers3SmoothFoldr, NT.numbers3SmoothSet]) :    ("numbers5Smooth",-      QC.quickCheckWith singleArgs $ ListHT.allEqual $ map (take 10000) $+      QC.property $ ListHT.allEqual $ map (take 10000) $          [NT.numbers5SmoothCorec, NT.numbers5SmoothFoldr, NT.numbers5SmoothSet]) :    ("ceiling3Smooth vs. is3Smooth",-      quickCheck $ \(Positive n) -> NT.is3Smooth $ NT.ceiling3Smooth n) :+      property $ \(Positive n) -> NT.is3Smooth $ NT.ceiling3Smooth n) :    ("ceiling5Smooth vs. is5Smooth",-      quickCheck $ \(Positive n) -> NT.is5Smooth $ NT.ceiling5Smooth n) :+      property $ \(Positive n) -> NT.is5Smooth $ NT.ceiling5Smooth n) :    ("ceiling3Smooth vs. numbers3Smooth",-      quickCheck $ QC.forAll (QC.choose (0,500)) $ \k ->+      property $ QC.forAll (QC.choose (0,500)) $ \k ->          let (n0:n1:_) = drop k NT.numbers3Smooth          in  NT.ceiling3Smooth n0 == n0              &&              NT.ceiling3Smooth (n0+1) == n1) :    ("ceiling5Smooth vs. numbers5Smooth",-      quickCheck $ QC.forAll (QC.choose (0,500)) $ \k ->+      property $ QC.forAll (QC.choose (0,500)) $ \k ->          let (n0:n1:_) = drop k NT.numbers5Smooth          in  NT.ceiling5Smooth n0 == n0              &&              NT.ceiling5Smooth (n0+1) == n1) :    ("ceiling3Smooth naive vs. trace",-      quickCheck $ \(Positive n) ->+      property $ \(Positive n) ->          NT.ceiling3SmoothNaive n == NT.ceiling3SmoothTrace n) :    ("ceiling5Smooth naive vs. trace",-      quickCheck $ \(Positive n) ->+      property $ \(Positive n) ->          NT.ceiling5SmoothNaive n == NT.ceiling5SmoothTrace n) :    ("ceiling3Smooth scan vs. trace",-      quickCheck $ \(Big n) ->+      property $ \(Big n) ->          NT.ceiling3SmoothScan n == NT.ceiling3SmoothTrace n) :    ("ceiling5Smooth scan vs. trace",-      quickCheck $ \(Big n) ->+      property $ \(Big n) ->          NT.ceiling5SmoothScan n == NT.ceiling5SmoothTrace n) :    []

@@ -8,7 +8,7 @@  import qualified Test.Sound.Synthesizer.Plain.Interpolation as InterpolationTest -import Test.QuickCheck (quickCheck, Property, (==>), Testable, )+import Test.QuickCheck (Property, property, Testable, (==>))  import qualified Number.NonNegative       as NonNeg @@ -36,7 +36,7 @@       ToneMod.flattenShapePhaseAnalytic periodInt period c  --- * auxiliary quickCheck functions+-- * auxiliary property functions  {- Although that looks like a too small value, it is actually right,@@ -72,21 +72,22 @@   -testRationalLineIp :: Testable quickCheck =>-   (InterpolationTest.LinePreserving Rational Rational -> quickCheck) -> IO ()-testRationalLineIp f  =  quickCheck f+testRationalLineIp :: Testable property =>+   (InterpolationTest.LinePreserving Rational Rational -> property) ->+   Property+testRationalLineIp f  =  property f -testRationalIp :: Testable quickCheck =>-   (InterpolationTest.T Rational Rational -> quickCheck) -> IO ()-testRationalIp f  =  quickCheck f+testRationalIp :: Testable property =>+   (InterpolationTest.T Rational Rational -> property) -> Property+testRationalIp f  =  property f  -tests :: [(String, IO ())]+tests :: [(String, Property)] tests =    ("untangleShapePhase",-      quickCheck $ \periodInt period ->+      property $ \periodInt period ->          untangleShapePhase periodInt (period :: Rational)) :    ("flattenShapePhase",-      quickCheck $ \periodInt period ->+      property $ \periodInt period ->          flattenShapePhase periodInt (period :: Rational)) :    []

@@ -1,49 +0,0 @@-module Test.Sound.Synthesizer.Causal.Analysis (tests) where--import qualified Synthesizer.Causal.Analysis as AnaC-import qualified Synthesizer.Causal.Process as Causal-import qualified Synthesizer.Plain.Analysis as Ana--import Control.Arrow ((<<<), )--import qualified Data.NonEmpty.Class as NonEmptyC-import qualified Data.NonEmpty as NonEmpty-import qualified Data.List.Match as Match-import qualified Data.List as List--import qualified Test.QuickCheck as QC-import Test.QuickCheck (quickCheck, )--import NumericPrelude.Numeric-import NumericPrelude.Base-import Prelude ()---movingMedian :: (Ord a) => Int -> [a] -> [a]-movingMedian n =-   map (\xs -> List.sort xs !! div (length xs) 2) . NonEmpty.tail .-   NonEmptyC.zipWith (drop . max 0) (NonEmptyC.iterate succ (negate n)) .-   NonEmpty.inits---tests :: [(String, IO ())]-tests =-   ("deltaSigmaModulation",-      quickCheck $ \xs ->-         Match.take xs (Ana.deltaSigmaModulation xs)-         ==-         Causal.apply AnaC.deltaSigmaModulation (xs::[Rational])) :-   ("deltaSigmaModulationPositive",-      quickCheck $ \threshold xs ->-         Match.take xs (Ana.deltaSigmaModulationPositive threshold xs)-         ==-         Causal.apply-            (AnaC.deltaSigmaModulationPositive <<<-             Causal.feedConstFst threshold) (xs::[Rational])) :-   ("movingMedian",-      quickCheck $-      QC.forAll (QC.choose (1,20)) $ \n xs ->-         movingMedian n xs-         ==-         Causal.apply (AnaC.movingMedian n) (xs::[Char])) :-   []

@@ -22,7 +22,7 @@  import Data.Tuple.HT (mapSnd, ) -import Test.QuickCheck (quickCheck, )+import Test.QuickCheck (Property, property)  import NumericPrelude.Numeric import NumericPrelude.Base@@ -85,20 +85,20 @@        ==        mapSnd           (Chunky.fromChunks .-           map (\size -> SigG.LazySize $ NonNeg98.toNumber size) .+           map (\size -> ChunkySize.LazySize $ NonNeg98.toNumber size) .            EventList.getTimes)           (CutG.dropMarginRem n m              (EventList.fromPairList $ map ((,) x) $-              map (\(SigG.LazySize size) -> NonNeg98.fromNumber size) $+              map (\(ChunkySize.LazySize size) -> NonNeg98.fromNumber size) $               Chunky.toChunks pat))  -tests :: [(String, IO ())]+tests :: [(String, Property)] tests =-   ("dropMarginRemLength", quickCheck dropMarginRemLength) :-   ("dropMarginRemState", quickCheck dropMarginRemState) :-   ("dropMarginRemSV", quickCheck dropMarginRemSV) :-   ("dropMarginRemSVL", quickCheck dropMarginRemSVL) :-   ("dropMarginRemChunkySize", quickCheck dropMarginRemChunkySize) :-   ("dropMarginRemPiecewise", quickCheck dropMarginRemPiecewise) :+   ("dropMarginRemLength", property dropMarginRemLength) :+   ("dropMarginRemState", property dropMarginRemState) :+   ("dropMarginRemSV", property dropMarginRemSV) :+   ("dropMarginRemSVL", property dropMarginRemSVL) :+   ("dropMarginRemChunkySize", property dropMarginRemChunkySize) :+   ("dropMarginRemPiecewise", property dropMarginRemPiecewise) :    []

@@ -9,9 +9,9 @@  import qualified Test.Sound.Synthesizer.Plain.NonEmpty as NonEmpty -import Test.QuickCheck (Testable, quickCheck, )+import Test.QuickCheck (Testable, Property, property) -import qualified Algebra.Laws                  as Law+import qualified Algebra.Laws as Law  import NumericPrelude.Numeric import NumericPrelude.Base@@ -19,8 +19,8 @@  simple ::    (Testable t) =>-   (Sig.T Int -> t) -> IO ()-simple = quickCheck+   (Sig.T Int -> t) -> Property+simple = property  (=|=) ::    (Eq sig, CutG.Transform sig) =>@@ -28,7 +28,7 @@ x =|= y =    CutG.take 100 x == CutG.take 100 y -tests :: [(String, IO ())]+tests :: [(String, Property)] tests =    ("identity",       simple $ Law.identity FiltNRG.generic $ SigG.singleton one) :@@ -51,12 +51,12 @@          case NonEmpty.toInfiniteList yn of             y -> FiltNRG.generic x y =|= FiltNRG.karatsubaInfinite (*) x y) :    ("convolve triple",-      quickCheck $ \x y ->+      property $ \x y ->          Cyclic.sumAndConvolveTriple x y ==          Cyclic.sumAndConvolveTripleAlt x (y :: Cyclic.Triple Integer)) :    ("periodic summation",       simple $ \x y n ->-         let periodic = Cyclic.fromSignal SigG.defaultLazySize (1 + abs n)+         let periodic = Cyclic.fromSignal (1 + abs n)          in  Cyclic.convolve (periodic x) (periodic y) ==              periodic (FiltNRG.generic x y)) :    []

@@ -10,8 +10,9 @@ import qualified Synthesizer.Storable.Signal as SigSt import qualified Synthesizer.State.Signal as SigS -import Test.QuickCheck (Testable, Arbitrary, arbitrary, quickCheck, )-import Test.Utility (approxEqualAbs, approxEqualComplexAbs, )+import qualified Test.QuickCheck as QC+import Test.QuickCheck (Testable, Arbitrary, arbitrary, property)+import Test.Utility (approxEqualAbs, approxEqualComplexAbs)  import qualified Number.Complex as Complex @@ -67,7 +68,7 @@    conjugate = Complex.conjugate  scalarProduct ::-   (SigG.Read sig y, Ring.C y, Complex y) =>+   (SigG.Consume sig y, Ring.C y, Complex y) =>    sig y -> sig y -> y scalarProduct xs ys =    SigS.sum $@@ -86,35 +87,35 @@  simple ::    (Testable t) =>-   (SigSt.T (Complex.T Double) -> t) -> IO ()-simple = quickCheck+   (SigSt.T (Complex.T Double) -> t) -> QC.Property+simple = property -tests :: [(String, IO ())]+tests :: [(String, QC.Property)] tests =    ("fourier inverse",-      quickCheck $ \(Normed x) ->+      property $ \(Normed x) ->          x =~=          (FiltNRG.amplify (recip $ fromIntegral $ SigG.length x) $           Fourier.transformBackward $ Fourier.transformForward x)) :    ("double fourier = reverse",-      quickCheck $ \(Normed x) ->+      property $ \(Normed x) ->          x =~=          (Cyclic.reverse $           FiltNRG.amplify (recip $ fromIntegral $ SigG.length x) $           Fourier.transformForward $           Fourier.transformForward x)) :    ("fourier of reverse",-      quickCheck $ \(Normed x) ->+      property $ \(Normed x) ->          Cyclic.reverse (Fourier.transformForward x) =~=          Fourier.transformForward (Cyclic.reverse x)) :    ("fourier of conjugate",-      quickCheck $ \(Normed x) ->+      property $ \(Normed x) ->          (SigG.map Complex.conjugate $ Fourier.transformForward x)          =~=          (Fourier.transformForward $           SigG.map Complex.conjugate $ Cyclic.reverse x)) :    ("additivity",-      quickCheck $ \(Normed2 x y) ->+      property $ \(Normed2 x y) ->          SigG.mix (Fourier.transformForward x) (Fourier.transformForward y)          =~=          Fourier.transformForward (SigG.mix x y)) :@@ -126,25 +127,25 @@                 (fromIntegral (SigG.length x) *                  AnaG.volumeVectorEuclideanSqr x)) :    ("unitarity",-      quickCheck $ \(Normed2 x y) ->+      property $ \(Normed2 x y) ->          approxEqualComplexAbs tolerance             (scalarProduct                (Fourier.transformForward x) (Fourier.transformForward y))             (fromIntegral (SigG.length x) * scalarProduct x y)) :    ("convolution",-      quickCheck $ \(Normed2 x y) ->+      property $ \(Normed2 x y) ->          SigG.zipWith (*)             (Fourier.transformForward x)             (Fourier.transformForward y)          =~=          Fourier.transformForward (Cyclic.convolve x y)) :    ("convolution cyclic",-      quickCheck $ \(Normed2 x y) ->+      property $ \(Normed2 x y) ->          Fourier.convolveCyclic x y          =~=          Cyclic.convolve x y) :    ("convolution long",-      quickCheck $ \(Normed x) (Normed y) ->+      property $ \(Normed x) (Normed y) ->          FiltNRG.karatsubaFinite (*) x y          =~=          Fourier.convolveWithWindow (Fourier.window x) y) :

@@ -9,7 +9,7 @@ import qualified Synthesizer.State.Signal as SigS import qualified Synthesizer.Plain.Signal as Sig -import Test.QuickCheck (Testable, Arbitrary, arbitrary, quickCheck, )+import Test.QuickCheck (Testable, Arbitrary, arbitrary, Property, property)  import qualified Synthesizer.Basic.NumberTheory as NT @@ -86,36 +86,36 @@  simple ::    (Testable t) =>-   (Sig.T Integer -> t) -> IO ()-simple = quickCheck+   (Sig.T Integer -> t) -> Property+simple = property -tests :: [(String, IO ())]+tests :: [(String, Property)] tests =    ("fourier inverse",-      quickCheck $ \(ModularSignal m x) ->+      property $ \(ModularSignal m x) ->          (Fourier.transformBackward $ Fourier.transformForward x)          ==          FiltNRG.amplify (modular m $ length x) x) :    ("double fourier = reverse",-      quickCheck $ \(ModularSignal m x) ->+      property $ \(ModularSignal m x) ->          (Cyclic.reverse $           Fourier.transformForward $           Fourier.transformForward x)          ==          FiltNRG.amplify (modular m $ length x) x) :    ("fourier of reverse",-      quickCheck $ \(ModularSignal _m x) ->+      property $ \(ModularSignal _m x) ->          Cyclic.reverse (Fourier.transformForward x) ==          Fourier.transformForward (Cyclic.reverse x)) :    ("homogenity",-      quickCheck $ \(ModularSignal m x) y ->+      property $ \(ModularSignal m x) y ->          (FiltNRG.amplify (modular m (y::Integer)) $           Fourier.transformForward x)          ==          (Fourier.transformForward $           FiltNRG.amplify (modular m y) x)) :    ("additivity",-      quickCheck $ \(ModularSignal2 _m x y) ->+      property $ \(ModularSignal2 _m x y) ->          SigG.mix (Fourier.transformForward x) (Fourier.transformForward y)          ==          Fourier.transformForward (SigG.mix x y)) :@@ -129,7 +129,7 @@               AnaG.volumeVectorEuclideanSqr x)) : -}    ("unitarity",-      quickCheck $ \(ModularSignal2 m x y) ->+      property $ \(ModularSignal2 m x y) ->          {-          since there is no equivalent of a complex conjugate          we have to take the scalar product with the backwards transform.@@ -139,14 +139,14 @@          ==          modular m (length x) * scalarProduct m x y) :    ("convolution",-      quickCheck $ \(ModularSignal2 _m x y) ->+      property $ \(ModularSignal2 _m x y) ->          SigG.zipWith (*)             (Fourier.transformForward x)             (Fourier.transformForward y)          ==          Fourier.transformForward (Cyclic.convolve x y)) :    ("convolution cyclic",-      quickCheck $ \(ModularSignal2 _m x y) ->+      property $ \(ModularSignal2 _m x y) ->          Fourier.convolveCyclic x y          ==          Cyclic.convolve x y) :

@@ -8,7 +8,7 @@ import qualified Synthesizer.Generic.Permutation as Permutation  import qualified Test.QuickCheck as QC-import Test.QuickCheck (quickCheck, )+import Test.QuickCheck (property)  import NumericPrelude.Numeric import NumericPrelude.Base@@ -21,23 +21,23 @@    let g = gcd n0 m0    return $ if g==0 then (0,0) else (abs (div n0 g), abs (div m0 g)) -tests :: [(String, IO ())]+tests :: [(String, QC.Property)] tests =    ("inverse transposition",-      quickCheck $+      property $       QC.forAll (QC.choose (0,100)) $ \n ->       QC.forAll (QC.choose (0,100)) $ \m ->          Permutation.inverse (Permutation.transposition n m)          ==          Permutation.transposition m n) :    ("inverse skewGrid",-      quickCheck $+      property $       QC.forAll genRelPrime $ \(n,m) ->          Permutation.inverse (Permutation.skewGrid n m)          ==          Permutation.skewGridInv n m) :    ("inverse skewGridCRT",-      quickCheck $+      property $       QC.forAll genRelPrime $ \(n,m) ->          Permutation.inverse (Permutation.skewGridCRT n m)          ==

@@ -29,7 +29,7 @@ import qualified Test.Sound.Synthesizer.Plain.NonEmpty as NonEmpty import qualified Test.Sound.Synthesizer.Plain.Interpolation as InterpolationTest -import Test.QuickCheck (quickCheck, Property, (==>), )+import Test.QuickCheck (Property, property, (==>)) import Test.Utility (ArbChar, )  import qualified Number.NonNegative       as NonNeg@@ -277,21 +277,21 @@   -tests :: [(String, IO ())]+tests :: [(String, Property)] tests =-   ("limitMinRelativeValues", quickCheck limitMinRelativeValues) :+   ("limitMinRelativeValues", property limitMinRelativeValues) :    ("integrateFractional",-      quickCheck (\period -> integrateFractional (period :: NonNeg.Rational))) :+      property (\period -> integrateFractional (period :: NonNeg.Rational))) :    ("oscillatorCellSize",-      quickCheck (\ml ms periodInt period ext ixs ->+      property (\ml ms periodInt period ext ixs ->                oscillatorCellSize ml ms periodInt (period :: NonNeg.Rational)                   ext (ixs :: NonEmpty.T ArbChar))) :    ("oscillatorSuffixes",-      quickCheck (\ml ms periodInt period ext ixs ->+      property (\ml ms periodInt period ext ixs ->                oscillatorSuffixes ml ms periodInt (period :: NonNeg.Rational)                   ext (ixs :: NonEmpty.T ArbChar))) :    ("oscillatorCells",-      quickCheck (\ml ms periodInt period ext ixs ->+      property (\ml ms periodInt period ext ixs ->                oscillatorCells ml ms periodInt (period :: NonNeg.Rational)                   ext (ixs :: NonEmpty.T ArbChar))) :    ("sampledTone",

@@ -17,7 +17,7 @@ import Data.List (genericLength)  import qualified Test.QuickCheck as QC-import Test.QuickCheck (quickCheck, Property, (==>))+import Test.QuickCheck (Property, property, (==>)) import Test.Utility (approxEqual)  import NumericPrelude.Numeric@@ -126,7 +126,7 @@ centroid xs =    sum xs /= zero ==>       Analysis.centroid xs == Analysis.centroidAlt xs--- Test.QuickCheck.quickCheck (\xs -> sum xs /= 0 Test.QuickCheck.==> propCentroid (xs::[Rational]))+-- Test.QuickCheck.property (\xs -> sum xs /= 0 Test.QuickCheck.==> propCentroid (xs::[Rational]))  histogramDCOffset :: NonEmpty.T (NonEmpty.T []) Int -> Property histogramDCOffset xs =@@ -147,22 +147,22 @@ forAllSmall = QC.forAll genSmall  -tests :: [(String, IO ())]+tests :: [(String, Property)] tests =-   ("volumeVectorMaximum", quickCheck (volumeVectorMaximum :: [Rational] -> Bool)) :-   -- quickCheck may fail due to rounding errors, but so far the computation is exactly the same-   ("volumeVectorEuclidean", quickCheck (volumeVectorEuclidean :: NonEmpty.T [] Double -> Bool)) :-   ("volumeVectorEuclideanSqr", quickCheck (volumeVectorEuclideanSqr :: NonEmpty.T [] Rational -> Bool)) :-   ("volumeVectorSum", quickCheck (volumeVectorSum :: NonEmpty.T [] Rational -> Bool)) :-   ("bounds", quickCheck (bounds :: NonEmpty.T [] Rational -> Bool)) :-   ("spread", quickCheck (spread :: (Rational,Rational) -> Bool)) :-   ("histogramDiscrete", quickCheck (forAllSmall histogramDiscrete)) :-   ("histogramDiscreteLength", quickCheck (forAllSmall histogramDiscreteLength)) :+   ("volumeVectorMaximum", property (volumeVectorMaximum :: [Rational] -> Bool)) :+   -- property may fail due to rounding errors, but so far the computation is exactly the same+   ("volumeVectorEuclidean", property (volumeVectorEuclidean :: NonEmpty.T [] Double -> Bool)) :+   ("volumeVectorEuclideanSqr", property (volumeVectorEuclideanSqr :: NonEmpty.T [] Rational -> Bool)) :+   ("volumeVectorSum", property (volumeVectorSum :: NonEmpty.T [] Rational -> Bool)) :+   ("bounds", property (bounds :: NonEmpty.T [] Rational -> Bool)) :+   ("spread", property (spread :: (Rational,Rational) -> Bool)) :+   ("histogramDiscrete", property (forAllSmall histogramDiscrete)) :+   ("histogramDiscreteLength", property (forAllSmall histogramDiscreteLength)) :    ("histogramDiscreteConcat",-      quickCheck $ forAllSmall $ \x -> forAllSmall $ \y ->+      property $ forAllSmall $ \x -> forAllSmall $ \y ->          histogramDiscreteConcat x y) :-   ("histogramLinear", quickCheck (forAllSmall histogramLinear)) :-   ("histogramLinearLength", quickCheck (forAllSmall histogramLinearLength)) :-   ("centroid", quickCheck (centroid :: [Rational] -> Property)) :-   ("histogramDCOffset", quickCheck (forAllSmall histogramDCOffset)) :+   ("histogramLinear", property (forAllSmall histogramLinear)) :+   ("histogramLinearLength", property (forAllSmall histogramLinearLength)) :+   ("centroid", property (centroid :: [Rational] -> Property)) :+   ("histogramDCOffset", property (forAllSmall histogramDCOffset)) :    []

@@ -3,7 +3,7 @@ import qualified Synthesizer.Plain.Control as Control  import qualified Test.QuickCheck as QC-import Test.QuickCheck (Property, quickCheck, (==>))+import Test.QuickCheck (Property, property, (==>)) import Test.Utility (approxEqualListAbs, approxEqualListRel)  import qualified Data.List.HT as ListHT@@ -84,13 +84,13 @@   -tests :: [(String, IO ())]+tests :: [(String, Property)] tests =-   ("linearRing", quickCheck linearRing) :-   ("linearApprox", quickCheck linearApprox) :-   ("linearExact", quickCheck linearExact) :-   ("exponential", quickCheck exponential) :-   ("exponential2", quickCheck exponential2) :-   ("cosine", quickCheck cosine) :-   ("cubic", quickCheck cubic) :+   ("linearRing", property linearRing) :+   ("linearApprox", property linearApprox) :+   ("linearExact", property linearExact) :+   ("exponential", property exponential) :+   ("exponential2", property exponential2) :+   ("cosine", property cosine) :+   ("cubic", property cubic) :    []

@@ -11,22 +11,20 @@ import qualified Synthesizer.Causal.Process as Causal import qualified Synthesizer.Frame.Stereo as Stereo -import qualified Data.StorableVector.Lazy.Pattern as VP+import qualified Data.StorableVector.Lazy.Typed as SVT  import Foreign.Storable.Tuple ()  import qualified Test.Sound.Synthesizer.Plain.NonEmpty as NonEmpty  import qualified Test.QuickCheck as QC-import Test.QuickCheck (Property, arbitrary, quickCheck, )+import Test.QuickCheck (Property, arbitrary, property, ) import Test.Utility (ArbChar)  import qualified Number.GaloisField2p32m5 as GF import qualified Number.NonNegative       as NonNeg -import qualified Numeric.NonNegative.Chunky as Chunky--import Control.Applicative (liftA2, (<$>), )+import Control.Applicative ((<$>), )  import qualified Data.List.HT as ListHT import qualified Data.List as List@@ -101,10 +99,9 @@        FiltNR.sumsPosModulatedPyramid height ctrl xs :        FiltNRG.sumsPosModulatedPyramid height ctrl xs :        SigSt.toList-          (FiltNRG.sumsPosModulatedPyramid-             height-             (SigSt.fromList SigSt.defaultChunkSize ctrl)-             (SigSt.fromList SigSt.defaultChunkSize xs)) :+          (vectorLazyFromTyped+             (FiltNRG.sumsPosModulatedPyramid+                height (SVT.pack ctrl) (SVT.pack xs))) :        SigSt.toList           (FiltNRSt.sumsPosModulatedPyramid              height@@ -136,27 +133,27 @@        []  -genChunkyVector :: QC.Gen (VP.Vector Int)-genChunkyVector =-   liftA2 VP.pack-      (Chunky.fromChunks <$> arbitrary)-      (NonEmpty.toInfiniteList <$> arbitrary)+genChunkyVector :: QC.Gen (SVT.DefaultVector Int)+genChunkyVector = SVT.fromChunks <$> arbitrary +vectorLazyFromTyped :: SVT.DefaultVector a -> SigSt.T a+vectorLazyFromTyped = SVT.toVectorLazy+ downSample2 :: Property downSample2 =    QC.forAll genChunkyVector $ \xs ->    ListHT.allEqual $-      FiltNRG.downsample2 SigG.defaultLazySize xs :-      FiltNRSt.downsample2 xs :+      vectorLazyFromTyped (FiltNRG.downsample2 xs) :+      FiltNRSt.downsample2 (vectorLazyFromTyped xs) :       []  sumsDownSample2 :: Property sumsDownSample2 =    QC.forAll genChunkyVector $ \xs ->    ListHT.allEqual $-      FiltNRG.sumsDownsample2 SigG.defaultLazySize xs :-      FiltNRSt.sumsDownsample2 xs :-      FiltNRSt.sumsDownsample2Alt xs :+      vectorLazyFromTyped (FiltNRG.sumsDownsample2 xs) :+      FiltNRSt.sumsDownsample2 (vectorLazyFromTyped xs) :+      FiltNRSt.sumsDownsample2Alt (vectorLazyFromTyped xs) :       []  {-@@ -184,21 +181,22 @@    in  ListHT.allEqual $        pack (FiltNR.movingAverageModulatedPyramid onegf           height maxC ctrl (cycle xs)) :-       FiltNRG.movingAverageModulatedPyramid onegf-          height maxC (pack ctrl) (SigG.cycle $ pack xs) :+       vectorLazyFromTyped+          (FiltNRG.movingAverageModulatedPyramid onegf+             height maxC (SVT.pack ctrl) (SigG.cycle $ SVT.pack xs)) :        FiltNRSt.movingAverageModulatedPyramid onegf           height maxC (pack ctrl) (SigG.cycle $ pack xs) :        []  -tests :: [(String, IO ())]+tests :: [(String, QC.Property)] tests =-   ("sums", quickCheck sums) :-   ("sumRange", quickCheck sumRange) :-   ("getRange", quickCheck getRange) :-   ("sumsPosModulated", quickCheck sumsPosModulated) :-   ("minPosModulated", quickCheck minPosModulated):-   ("downSample2", quickCheck downSample2) :-   ("sumsDownSample2", quickCheck sumsDownSample2) :-   ("movingAverageModulatedPyramid", quickCheck movingAverageModulatedPyramid) :+   ("sums", property sums) :+   ("sumRange", property sumRange) :+   ("getRange", property getRange) :+   ("sumsPosModulated", property sumsPosModulated) :+   ("minPosModulated", property minPosModulated):+   ("downSample2", property downSample2) :+   ("sumsDownSample2", property sumsDownSample2) :+   ("movingAverageModulatedPyramid", property movingAverageModulatedPyramid) :    []

@@ -5,9 +5,7 @@  import qualified Number.NonNegative as NonNeg --- import qualified Test.Sound.Synthesizer.Plain.NonEmpty as NonEmpty--import Test.QuickCheck (quickCheck, {- Property, (==>) -})+import Test.QuickCheck (Property, property)  import qualified Data.List.HT as ListHT @@ -50,8 +48,8 @@        Allpass.cascadeIterative n ps xs  -tests :: [(String, IO ())]+tests :: [(String, Property)] tests =-   ("cascadeStep", quickCheck cascadeStep) :-   ("cascade", quickCheck cascade) :+   ("cascadeStep", property cascadeStep) :+   ("cascade", property cascade) :    []

@@ -4,7 +4,7 @@ import qualified Synthesizer.Plain.Signal as Sig import qualified Synthesizer.Causal.Process as Causal -import Test.QuickCheck (quickCheck, )+import Test.QuickCheck (Property, property)  import qualified Number.GaloisField2p32m5 as GF @@ -59,15 +59,15 @@    Filt1.highpassInit x0 ps xs == Filt1.highpassInitAlt x0 ps xs  -tests :: [(String, IO ())]+tests :: [(String, Property)] tests =-   ("addLowHighpass", quickCheck addLowHighpass) :-   ("combineLowHighpass", quickCheck combineLowHighpass) :-   ("lowpassId", quickCheck lowpassId) :-   ("lowpassZero", quickCheck lowpassZero) :-   ("highpassId", quickCheck highpassId) :-   ("highpassZero", quickCheck highpassZero) :-   ("lowpassConst", quickCheck lowpassConst) :-   ("highpassConst", quickCheck highpassConst) :-   ("highpassInitAlt", quickCheck highpassInitAlt) :+   ("addLowHighpass", property addLowHighpass) :+   ("combineLowHighpass", property combineLowHighpass) :+   ("lowpassId", property lowpassId) :+   ("lowpassZero", property lowpassZero) :+   ("highpassId", property highpassId) :+   ("highpassZero", property highpassZero) :+   ("lowpassConst", property lowpassConst) :+   ("highpassConst", property highpassConst) :+   ("highpassInitAlt", property highpassInitAlt) :    []

@@ -8,15 +8,9 @@  import qualified Test.Sound.Synthesizer.Plain.NonEmpty as NonEmpty -import Test.QuickCheck (quickCheck, {- Property, (==>) -})---- import qualified Algebra.Module                as Module--- import qualified Algebra.RealField             as RealField--- import qualified Algebra.Ring                  as Ring--- import qualified Algebra.Additive              as Additive--- import qualified Number.Complex as Complex+import Test.QuickCheck (Property, property) -import Data.Tuple.HT (mapPair, )+import Data.Tuple.HT (mapPair)  import NumericPrelude.Numeric import NumericPrelude.Base@@ -35,7 +29,7 @@ -}  -tests :: [(String, IO ())]+tests :: [(String, Property)] tests =-   ("hilbert", quickCheck cascade) :+   ("hilbert", property cascade) :    []

@@ -18,14 +18,14 @@ import qualified Synthesizer.Causal.Interpolation as InterpolC import qualified Synthesizer.Causal.Process as Causal import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG-import qualified Synthesizer.Generic.Signal as SigG import qualified Synthesizer.State.Filter.NonRecursive as FiltS import qualified Synthesizer.State.Signal as SigS  import qualified Synthesizer.Storable.Filter.NonRecursive as FiltSt import qualified Synthesizer.Storable.Signal as SigSt -import Test.QuickCheck (quickCheck, Arbitrary(arbitrary), elements, Testable, )+import Test.QuickCheck+         (Property, property, Arbitrary(arbitrary), elements, Testable)  import Foreign.Storable (Storable, ) @@ -232,8 +232,7 @@    SigS.toList       (FiltS.inverseFrequencyModulationFloor          (SigS.fromList cs) (SigS.fromList xs))-    == FiltG.inverseFrequencyModulationFloor-          SigG.defaultLazySize cs xs+    == FiltG.inverseFrequencyModulationFloor cs xs   {-@@ -279,8 +278,7 @@    [t] -> [v] ->    ([v], SigSt.T v) frequencyModulationStorableCompare size xsize cs xs =-   (FiltG.inverseFrequencyModulationFloor-       SigG.defaultLazySize cs xs,+   (FiltG.inverseFrequencyModulationFloor cs xs,     FiltSt.inverseFrequencyModulationFloor size cs        (SigSt.fromList xsize xs)) @@ -288,15 +286,15 @@  testRational ::    (Testable t) =>-   (Rational -> Rational -> t) -> IO ()-testRational = quickCheck+   (Rational -> Rational -> t) -> Property+testRational = property  testFM ::    (Testable t, Arbitrary (sigX ArbChar), Show (sigX ArbChar)) =>-   ([Rational] -> sigX ArbChar -> t) -> IO ()-testFM = quickCheck+   ([Rational] -> sigX ArbChar -> t) -> Property+testFM = property -tests :: [(String, IO ())]+tests :: [(String, Property)] tests =    ("constant", testRational constant) :    ("linear",   testRational linear  ) :@@ -306,11 +304,11 @@    ("frequencyModulationBack",    testFM frequencyModulationBack) :    ("frequencyModulationGeneric", testFM frequencyModulationGeneric) :    ("frequencyModulationStorableChunkSize",-      quickCheck (\size0 size1 xsize0 xsize1 cs xs ->+      property (\size0 size1 xsize0 xsize1 cs xs ->          frequencyModulationStorableChunkSize size0 size1 xsize0 xsize1             (cs::[Rational]) (unpackArbString xs))) :    ("frequencyModulationStorable",-      quickCheck (\size xsize cs xs ->+      property (\size xsize cs xs ->          frequencyModulationStorable size xsize             (cs::[Rational]) (unpackArbString xs))) :    []

@@ -1,36 +0,0 @@-module Test.Sound.Synthesizer.Plain.Oscillator (tests) where--import qualified Synthesizer.Plain.Oscillator as Osci-import qualified Synthesizer.Basic.Wave       as Wave--import qualified Test.Sound.Synthesizer.Plain.Wave as WaveTest--import Test.QuickCheck (quickCheck, )--import qualified Algebra.RealField             as RealField--import NumericPrelude.Numeric-import NumericPrelude.Base-import Prelude ()----phaseShapeMod :: (RealField.C a, Eq b) => (Wave.T a b) -> a -> [a] -> Bool-phaseShapeMod wave freq phases =-   Osci.phaseMod wave freq phases ==-   Osci.shapeMod (Wave.phaseOffset wave) zero freq phases--phaseShapeModRational ::-   WaveTest.Ring Rational -> Integer -> Integer -> [Integer] -> Bool-phaseShapeModRational w denom0 freq0 phases0 =-   let denom  = 1 + abs denom0-       freq   = freq0 % denom-       phases = map (% denom) phases0-   in  phaseShapeMod (WaveTest.ringWave w) freq phases----tests :: [(String, IO ())]-tests =-   ("phaseShapeModRational",  quickCheck phaseShapeModRational) :-   []

@@ -21,7 +21,7 @@ import qualified Test.Sound.Synthesizer.Plain.Interpolation as InterpolationTest  import qualified Test.QuickCheck as QC-import Test.QuickCheck (quickCheck, Property, (==>), )+import Test.QuickCheck (Property, property, (==>)) import Test.Utility (ArbChar, )  import qualified Number.NonNegative       as NonNeg@@ -426,27 +426,27 @@           and (drop n0 (take (succ n1) (zipWith (==) resampledTone tone)))  -tests :: [(String, IO ())]+tests :: [(String, Property)] tests =-   ("limitMinRelativeValues", quickCheck limitMinRelativeValues) :-   ("limitMaxRelativeValues", quickCheck limitMaxRelativeValues) :+   ("limitMinRelativeValues", property limitMinRelativeValues) :+   ("limitMaxRelativeValues", property limitMaxRelativeValues) :    ("limitMaxRelativeValuesNonNeg",-                              quickCheck limitMaxRelativeValuesNonNeg) :+                              property limitMaxRelativeValuesNonNeg) :    ("limitMinRelativeValuesIdentity",-                              quickCheck limitMinRelativeValuesIdentity) :+                              property limitMinRelativeValuesIdentity) :    ("limitMaxRelativeValuesIdentity",-                              quickCheck limitMaxRelativeValuesIdentity) :+                              property limitMaxRelativeValuesIdentity) :    ("limitMaxRelativeValuesNonNegIdentity",-                              quickCheck limitMaxRelativeValuesNonNegIdentity) :+                              property limitMaxRelativeValuesNonNegIdentity) :    ("limitMaxRelativeValuesInfinity",-                              quickCheck limitMaxRelativeValuesInfinity) :+                              property limitMaxRelativeValuesInfinity) :    ("limitMaxRelativeValuesNonNegInfinity",-                              quickCheck limitMaxRelativeValuesNonNegInfinity) :-   ("dropRem",                quickCheck (dropRem :: NonNeg.Int -> [ArbChar] -> Bool)) :+                              property limitMaxRelativeValuesNonNegInfinity) :+   ("dropRem",                property (dropRem :: NonNeg.Int -> [ArbChar] -> Bool)) :    ("sampledToneSine",-      quickCheck (\ext phase0 -> sampledToneSine ext (phase0 :: Double))) :+      property (\ext phase0 -> sampledToneSine ext (phase0 :: Double))) :    ("sampledToneSineList",-      quickCheck (\ext phase0 -> sampledToneSineList ext (phase0 :: Double))) :+      property (\ext phase0 -> sampledToneSineList ext (phase0 :: Double))) :    ("sampledToneLinear",       testRationalLineIp sampledToneLinear) :    ("sampledToneStair",@@ -458,15 +458,15 @@    ("sampledToneStatic",       testRationalIp sampledToneStatic) :    ("shapeFreqModFromSampledToneLimitIdentity",-      quickCheck (\ml ms p ixs (t,ts) ->+      property (\ml ms p ixs (t,ts) ->           shapeFreqModFromSampledToneLimitIdentity ml ms p              (ixs::NonEmpty.T Rational) (t::Rational,ts))) :    ("oscillatorCoords",-      quickCheck (\periodInt period ->+      property (\periodInt period ->                oscillatorCoords                   periodInt (period :: NonNeg.Rational))) :    ("shapeFreqModFromSampledToneCoordsIdentity",-      quickCheck (\periodInt period ->+      property (\periodInt period ->                shapeFreqModFromSampledToneCoordsIdentity                   periodInt (period :: NonNeg.Rational))) :    ("shapeFreqModFromSampledTone",@@ -474,7 +474,7 @@    ("shapePhaseFreqModFromSampledTone",       testRationalIp shapePhaseFreqModFromSampledTone) :    ("oscillatorCells",-      quickCheck (\ml ms periodInt period ext ixs ->+      property (\ml ms periodInt period ext ixs ->                oscillatorCells ml ms periodInt (period :: NonNeg.Rational)                   ext (ixs :: NonEmpty.T ArbChar))) :    ("shapeFreqModFromSampledToneIdentity",

@@ -1,74 +0,0 @@-module Test.Sound.Synthesizer.Plain.Wave (Ring, ringWave, tests) where--import qualified Synthesizer.Basic.Wave       as Wave-import qualified Synthesizer.Basic.Phase      as Phase--import qualified Test.QuickCheck as QC-import Test.QuickCheck-         (quickCheck, Arbitrary(arbitrary), elements, oneof, choose, )--import qualified Algebra.RealTranscendental    as RealTrans-import qualified Algebra.Ring                  as Ring--import Control.Monad (liftM, liftM2, )-import System.Random (Random)---import NumericPrelude.Numeric-import NumericPrelude.Base-import Prelude ()-----data Ring a = Ring {ringName :: String, ringWave :: Wave.T a a}--instance Show (Ring a) where-   show = ringName--instance (Ord a, Ring.C a) => Arbitrary (Ring a) where-   arbitrary = elements $-      Ring "saw"      Wave.saw :-      Ring "square"   Wave.square :-      Ring "triangle" Wave.triangle :-      []-----data ZeroDCOffset a = ZeroDCOffset {zdcName :: String, zdcWave :: Wave.T a a}--instance Show (ZeroDCOffset a) where-   show = zdcName--instance (RealTrans.C a, Random a) => Arbitrary (ZeroDCOffset a) where-   arbitrary =-      let cons n w = return (ZeroDCOffset n w)-      in  oneof $-            cons "sine"     Wave.sine :-            cons "saw"      Wave.saw :-            cons "square"   Wave.square :-            cons "triangle" Wave.triangle :-            liftM-               (ZeroDCOffset "squareBalanced" . Wave.squareBalanced)-               (choose (negate one, one)) :-            liftM2-               (\w r -> ZeroDCOffset "trapezoidBalanced" (Wave.trapezoidBalanced w r))-               (choose (zero, one))-               (choose (negate one, one)) :-            []---zeroDCOffset :: ZeroDCOffset Double -> QC.Property-zeroDCOffset w =-   QC.forAll (QC.choose (100,600)) $ \periodInt ->-   let period    = fromIntegral periodInt-       xs = take periodInt $ map Phase.fromRepresentative $-            map (/period) $ iterate (1+) 0.5-   in  abs (sum (map (Wave.apply (zdcWave w)) xs))  <  period / fromInteger 100---tests :: [(String, IO ())]-tests =-   ("zeroDCOffset",  quickCheck zeroDCOffset) :-   []

@@ -1,40 +0,0 @@-module Test.Sound.Synthesizer.Storable.Cut (tests) where--import qualified Synthesizer.Storable.Cut as CutSt-import qualified Synthesizer.Storable.Signal as SigSt--import qualified Synthesizer.Plain.Cut as Cut-import qualified Synthesizer.Plain.Signal as Sig--import qualified Data.EventList.Relative.TimeBody  as EventList-import qualified Data.List.HT as ListHT--import qualified Number.NonNegative as NonNeg--import qualified Test.QuickCheck as QC-import Test.QuickCheck (quickCheck, )--import NumericPrelude.Numeric-import NumericPrelude.Base-import Prelude ()---genEventList :: QC.Gen (EventList.T NonNeg.Int (Sig.T Int))-genEventList = fmap (EventList.mapTime (flip mod 1000)) QC.arbitrary--arrange :: SigSt.ChunkSize -> QC.Property-arrange chunkSize =-   QC.forAll genEventList $ \evs ->-   let sevs = EventList.mapBody (SigSt.fromList chunkSize) evs-   in  ListHT.allEqual $-       SigSt.fromList chunkSize (Cut.arrange evs) :-       CutSt.arrangeAdaptive chunkSize sevs :-       CutSt.arrangeList chunkSize sevs :-       CutSt.arrangeEquidist chunkSize sevs :-       []---tests :: [(String, IO ())]-tests =-   ("arrange", quickCheck arrange) :-   []

@@ -6,9 +6,8 @@  import qualified Number.Complex as Complex -import qualified Algebra.RealRing              as RealRing+import qualified Algebra.RealRing as RealRing -import qualified Data.List.HT as ListHT import qualified Data.Char as Char  import NumericPrelude.Base