packages feed

synthesizer-core 0.4.2 → 0.5

raw patch · 35 files changed

+599/−300 lines, 35 filesdep ~directorydep ~filepathdep ~numeric-prelude

Dependency ranges changed: directory, filepath, numeric-prelude, process

Files

speedtest/Fourier.hs view
@@ -4,13 +4,13 @@ import qualified Synthesizer.Generic.Fourier as Fourier import qualified Synthesizer.Generic.Noise as NoiseG import qualified Synthesizer.Generic.Signal as SigG-import qualified Synthesizer.Generic.Cut as CutG+-- import qualified Synthesizer.Generic.Cut as CutG import qualified Synthesizer.State.Noise as NoiseS import qualified Synthesizer.State.Signal as SigS  import qualified Data.StorableVector as SV -import qualified Algebra.Ring as Ring+-- import qualified Algebra.Ring as Ring import qualified Number.Complex as NPComplex  import System.TimeIt (timeIt, )
speedtest/SpeedTest.hs view
@@ -143,8 +143,8 @@ doubleToInt :: Double -> Int doubleToInt x = roundDouble (32767 * clip (-1) 1 x) -doubleToInt16 :: Double -> Int16-doubleToInt16 = P98.fromIntegral . doubleToInt+_doubleToInt16 :: Double -> Int16+_doubleToInt16 = P98.fromIntegral . doubleToInt   @@ -200,8 +200,8 @@    do cnt <- foldM (\n x -> pokeElemOff p n x >> return (n+1)) 0 xs       hPutBuf h p (int16size * cnt) -putIntBlockSlow :: Handle -> Ptr Int16 -> [Int16] -> IO ()-putIntBlockSlow h p xs =+_putIntBlockSlow :: Handle -> Ptr Int16 -> [Int16] -> IO ()+_putIntBlockSlow h p xs =    do zipWithM_ (pokeElemOff p) [0..] xs       hPutBuf h p (int16size * length xs) @@ -309,7 +309,7 @@  main :: IO () main =-   do mapM (\(label, fileName, action) ->+   do mapM_ (\(label, fileName, action) ->               measureTime label (action fileName))            tests
speedtest/SpeedTestExp.hs view
@@ -45,11 +45,11 @@ doubleToInt16 :: Double -> Int16 doubleToInt16 x = round (32767 * x) -doubleToInt16' :: Double -> Int16-doubleToInt16' x = round' (32767 * x)+_doubleToInt16 :: Double -> Int16+_doubleToInt16 x = round' (32767 * x) -doubleToInt16'' :: Double -> Int16-doubleToInt16'' x = seq x 0+_doubleToInt16' :: Double -> Int16+_doubleToInt16' x = seq x 0   exponential2 :: Double -> Double -> [Double]
src-4/Synthesizer/Causal/Process.hs view
@@ -324,22 +324,22 @@ {-# INLINE feed #-} feed :: (SigG.Read sig a) =>    sig a -> T () a-feed =-   flip runViewL (\getNext ->+feed proc =+   runViewL proc (\getNext ->       fromStateMaybe (const getNext))  {-# INLINE feedFst #-} feedFst :: (SigG.Read sig a) =>    sig a -> T b (a,b)-feedFst =-   flip runViewL (\getNext ->+feedFst proc =+   runViewL proc (\getNext ->       fromStateMaybe (\b -> fmap (flip (,) b) getNext))  {-# INLINE feedSnd #-} feedSnd :: (SigG.Read sig a) =>    sig a -> T b (b,a)-feedSnd =-   flip runViewL (\getNext ->+feedSnd proc =+   runViewL proc (\getNext ->       fromStateMaybe (\b -> fmap ((,) b) getNext))  {-# INLINE feedConstFst #-}
src/Synthesizer/Basic/Distortion.hs view
@@ -22,10 +22,10 @@ import Data.Ord.HT (limit, )  import Data.List.HT (mapAdjacent, )-import Data.List ((!!), map, iterate, take, foldl, {- tail, (++), zipWith, -} )+-- import Data.List ((!!), map, iterate, take, foldl, )  -- import qualified Prelude as P--- import NumericPrelude.Base+import NumericPrelude.Base import NumericPrelude.Numeric
src/Synthesizer/Basic/Wave.hs view
@@ -20,6 +20,7 @@  import qualified Algebra.RealTranscendental    as RealTrans import qualified Algebra.Transcendental        as Trans+import qualified Algebra.ZeroTestable          as ZeroTestable import qualified Algebra.RealField             as RealField import qualified Algebra.Algebraic             as Algebraic import qualified Algebra.Module                as Module@@ -341,7 +342,7 @@ -} {-# INLINE sawComplex #-} sawComplex ::-   (Complex.Power a, RealTrans.C a) =>+   (Complex.Power a, RealTrans.C a, ZeroTestable.C a) =>    T a (Complex.T a) sawComplex = fromFunction $ \x -> log (1 + Complex.cis (-pi*(1-2*x))) * (-2/pi) {-@@ -389,7 +390,7 @@ -} {-# INLINE squareComplex #-} squareComplex ::-   (Complex.Power a, RealTrans.C a) =>+   (Complex.Power a, RealTrans.C a, ZeroTestable.C a) =>    T a (Complex.T a) squareComplex = fromFunction $ \x -> {- these formulas are equivalent but wrong
+ src/Synthesizer/CausalIO/Gate.hs view
@@ -0,0 +1,148 @@+module Synthesizer.CausalIO.Gate (+   Chunk(Chunk), chunk,+   allToStorableVector,+   toStorableVector,+   allToChunkySize,+   toChunkySize,+   shorten,+   ) where++import qualified Synthesizer.CausalIO.Process as PIO+import qualified Synthesizer.Zip as Zip++import Synthesizer.PiecewiseConstant.Signal (StrictTime, )+import qualified Synthesizer.Generic.Cut as CutG+import qualified Synthesizer.Generic.Signal as SigG++import qualified Data.StorableVector as SV++import qualified Control.Monad.Trans.State as MS++import Control.Arrow (Arrow, arr, (^<<), )+import Control.Monad (when, )+import Data.Maybe.HT (toMaybe, )+import qualified Data.Monoid as Mn++import qualified Numeric.NonNegative.Class as NonNeg+import qualified Numeric.NonNegative.Wrapper as NonNegW++import NumericPrelude.Numeric+import NumericPrelude.Base+import Prelude ()+++{- |+Chunk represents a chunk of a Gate signal.++It means (Chunk chunkDuration sustainDuration).++sustainDuration means:+Just (t,a) -+   key is released at time t with attribute a,+   e.g. the note-off-velocity,+   t must be smaller than chunkDuration!+Nothing - key is in pressed or released state over the whole chunk+-}+data Chunk a = Chunk StrictTime (Maybe (StrictTime, a))+   deriving (Show)++-- | smart constructor that checks the time constraints+chunk :: StrictTime -> Maybe (StrictTime, a) -> Chunk a+chunk dur mrel =+   if maybe True (\(rel,_attr) -> rel<dur) mrel+     then Chunk dur mrel+     else error "release time must be strictly before chunk end"+++instance CutG.Read (Chunk a) where+   null (Chunk dur _) = isZero dur+   length (Chunk dur _) = fromIntegral dur++instance CutG.NormalForm (Chunk a) where+   evaluateHead (Chunk dur rel) =+      dur `seq` rel `seq` ()++instance Mn.Monoid (Chunk a) where+   mempty = error "Gate.mempty cannot be defined"+   mappend = error "Gate.mappend cannot be defined"++instance CutG.Transform (Chunk a) where+   take n (Chunk dur mrel) =+      let nn = NonNegW.fromNumberClip $ fromIntegral n+      in  Chunk (min nn dur) $+          mrel >>= \rel -> toMaybe (fst rel < nn) rel+   drop n (Chunk dur mrel) =+      let nn = NonNegW.fromNumberClip $ fromIntegral n+      in  Chunk (dur NonNeg.-| nn) $+          mrel >>= \(rel,attr) -> toMaybe (nn <= rel) (rel-nn, attr)+   splitAt n c = (CutG.take n c, CutG.drop n c)+   dropMarginRem = error "Gate.dropMarginRem is not defined"+   reverse = error "Gate.reverse cannot be defined"+++allToStorableVector ::+   (Arrow arrow) =>+   arrow (Chunk a) (SV.Vector ())+allToStorableVector = arr $+   (\(SigG.LazySize n) -> SV.replicate n ())+   ^<<+   allToChunkySize++toStorableVector ::+   PIO.T (Chunk a) (SV.Vector ())+toStorableVector =+   (\(SigG.LazySize n) -> SV.replicate n ())+   ^<<+   toChunkySize+++allToChunkySize ::+   (Arrow arrow) =>+   arrow (Chunk a) SigG.LazySize+allToChunkySize = arr $+   \(Chunk time _) -> SigG.LazySize (fromIntegral time)++toChunkySize ::+   PIO.T (Chunk a) SigG.LazySize+toChunkySize =+   PIO.traverse True $+   \(Chunk time mRelease) -> do+      running <- MS.get+      if not running+        then return $ SigG.LazySize 0+        else+          case mRelease of+             Nothing ->+                return $ SigG.LazySize (fromIntegral time)+             Just (relTime, _) -> do+                MS.put False+                return $ SigG.LazySize (fromIntegral relTime)+++{- |+Pass the second signal while the gate is open.++For completeness we would need a data type analogously to ChunkySize,+that measures signal duration in CausalIO processes.+'shorten' could then be written as++> shorten = Zip.second ^<< Zip.arrowFirstShort Gate.toChunkySize+-}+shorten ::+   (CutG.Transform signal) =>+   PIO.T (Zip.T (Chunk a) signal) signal+shorten =+   PIO.traverse True $+   \(Zip.Cons (Chunk time mRelease) sig) -> do+      when (NonNegW.toNumber time /= fromIntegral (CutG.length sig))+         (error "Gate.shorten: durations mismatch")+      running <- MS.get+      if not running+        then return CutG.empty+        else+          case mRelease of+             Nothing ->+                return $ sig+             Just (relTime, _) -> do+                MS.put False+                return $ CutG.take (fromIntegral relTime) sig
src/Synthesizer/CausalIO/Process.hs view
@@ -6,8 +6,20 @@ You may also combine several of these types using the Zip type constructor.  We may substitute IO by ST in the future, but I am uncertain about that.+On the one hand, the admissible IO functionality is very restricted,+only memory manipulation is allowed,+on the other hand we use ForeignPtrs that are not part of ST framework. -}-module Synthesizer.CausalIO.Process where+module Synthesizer.CausalIO.Process (+   T(Cons),+   fromCausal,+   mapAccum,+   traverse,+   runStorableChunkyCont,+   zip,+   continue,+   continueChunk,+   ) where  import qualified Synthesizer.Causal.Process as Causal @@ -20,7 +32,7 @@  import Foreign.Storable (Storable, ) -import Control.Monad.Trans.State (runStateT, )+import qualified Control.Monad.Trans.State as MS  import qualified Control.Arrow    as Arr import qualified Control.Category as Cat@@ -30,13 +42,23 @@  import Data.Monoid (Monoid, mempty, mappend, ) -import Data.Tuple.HT (mapSnd, )- import System.IO.Unsafe (unsafePerformIO, unsafeInterleaveIO, ) +import Prelude hiding (zip, ) -data T p a b =-   forall state context.++{-+Like the Causal arrow but unlike the Causal arrow from @synthesizer-llvm@,+we are not using a parameter type @p@.+In order to parameterize the process,+you simply use a plain Haskell function, i.e. @p -> T a b@.+This way, we do not need the Parameter type from @synthesizer-llvm@.+However, the internal state type can depend+on the value of parameters.+This may be an advantage or a disadvantage, I do not know.+-}+data T a b =+   forall state.    Cons       {-       If the transition function returns a chunk@@ -45,7 +67,7 @@       This way we do not need a MaybeT IO.       -}       (a -> state -> IO (b, state))-      (p -> IO state)+      (IO state)       {-       The delete function must not do anything serious,       e.g. close files,@@ -55,7 +77,7 @@       (state -> IO ())  -instance Cat.Category (T p) where+instance Cat.Category T where    id = Arr.arr id    (Cons nextB createB deleteB) .           (Cons nextA createA deleteA) = Cons@@ -63,17 +85,17 @@          (b,sa1) <- nextA a sa0          (c,sb1) <- nextB b sb0          return (c,(sa1,sb1)))-      (\p -> do-         sa <- createA p-         sb <- createB p+      (do+         sa <- createA+         sb <- createB          return (sa,sb))       (\(sa,sb) ->          deleteA sa >> deleteB sb) -instance Arr.Arrow (T p) where+instance Arr.Arrow T where    arr f = Cons       (\ a () -> return (f a, ()))-      (\ _p -> return ())+      (return ())       (\ () -> return ())    first (Cons next create delete) = Cons       (\(b,d) sa0 ->@@ -84,39 +106,60 @@  fromCausal ::    (Monoid b) =>-   Causal.T a b -> T p a b+   Causal.T a b -> T a b fromCausal (Causal.Cons next start) = Cons    (\a s0 ->       return $-      case runStateT (next a) s0 of+      case MS.runStateT (next a) s0 of          Nothing -> (mempty, s0)          Just (b,s1) -> (b,s1))-   (\ _p -> return $ start)+   (return $ start)    (\ _ -> return ())  mapAccum ::-   (p -> a -> state -> (b, state)) ->-   (p -> state) ->-   T p a b+   (a -> state -> (b, state)) ->+   state ->+   T a b mapAccum next start =    Cons-      (\a (p,s) -> return $ mapSnd ((,) p) $ next p a s)-      (\p -> return (p, start p))-      (\ _p -> return ())+      (\a s -> return $ next a s)+      (return start)+      (\ _ -> return ()) +{-+The parameter order is chosen this way,+because the 'next' function definition might be large+and can be separated with a ($).+-}+traverse ::+   state ->+   (a -> MS.State state b) ->+   T a b+traverse start next =+   Cons+      (\a s -> return $ MS.runState (next a) s)+      (return start)+      (\ _ -> return ()) ++{- |+This function converts a process+into a function on lazy storable vectors.+To this end it must call unsafePerformIO,+that is, the effects of all functions called in the process+must not be observable.++I am not sure, we need this function at all.+-} runStorableChunkyCont ::    (Storable a, Storable b) =>-   T p (SV.Vector a) (SV.Vector b) ->+   T (SV.Vector a) (SV.Vector b) ->    IO ((SVL.Vector a -> SVL.Vector b) ->-       p ->        SVL.Vector a -> SVL.Vector b) runStorableChunkyCont (Cons next create delete) =    return $-      \ procRest p sig ->+      \ procRest sig ->       SVL.fromChunks $ unsafePerformIO $ do-         state <- create p-          let go xt s0 =                unsafeInterleaveIO $                case xt of@@ -131,7 +174,7 @@                                 procRest $ SVL.fromChunks $                                 SV.drop (SV.length y) x : xs                            else go xs s1)-         go (SVL.chunks sig) state+         go (SVL.chunks sig) =<< create   zip ::@@ -146,72 +189,126 @@ 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 p a b) where+instance (CutG.Transform a, CutG.Read b, Monoid b) => Monoid (T a b) where    mempty = Cons       (\ _a () -> return (mempty, ()))-      (\ _p -> return ())+      (return ())       (\() -> return ())    mappend-         (Cons nextB createB deleteB)-         (Cons nextA createA deleteA) = Cons+         (Cons nextX createX deleteX)+         (Cons nextY createY deleteY) = Cons       (\a s ->          case s of-            Left (p,s0) -> do-               (b1,s1) <- nextA a s0+            Left s0 -> do+               (b1,s1) <- nextX a s0                let lenA = CutG.length a                    lenB = CutG.length b1                case compare lenA lenB of                   LT -> error "CausalIO.Process.mappend: output chunk is larger than input chunk"-                  EQ -> return (b1, Left (p,s1))+                  EQ -> return (b1, Left s1)                   GT -> do-                     deleteA s1-                     s2 <- createB p-                     (b3,s3) <- nextB (CutG.drop lenB a) s2-                     return (b3, Right s3)+                     deleteX s1+                     (b2,s2) <- nextY (CutG.drop lenB a) =<< createY+                     return (mappend b1 b2, Right s2)             Right s0 -> do-               (b1,s1) <- nextB a s0+               (b1,s1) <- nextY a s0                return (b1, Right s1))-      (\p -> do-         sa <- createA p-         return (Left (p,sa)))-      (\s ->-         case s of-            Left (_p,s0) -> deleteA s0-            Right s0 -> deleteB s0)+      (fmap Left createX)+      (either deleteX deleteY)  +data State a b =+   forall state.+   State+      (a -> state -> IO (b, state))+      (state -> IO ())+      state -- the only difference to (T a b) is the IO+++forceMaybe :: (Maybe a -> b) -> Maybe a -> b+forceMaybe f ma =+   case ma of+      Nothing -> f Nothing+      Just a -> f $ Just a++{- |+If the first process does not produce any output,+then the continuing process will not be started.+-} continue ::    (CutG.Transform a, SigG.Transform sig b) =>-   T p a (sig b) -> T (p,b) a (sig b) -> T p a (sig b)-continue-      (Cons nextA createA deleteA)-      (Cons nextB createB deleteB) = Cons+   T a (sig b) -> (b -> T a (sig b)) -> T a (sig b)+continue (Cons nextX createX deleteX) procY = Cons    (\a s ->       case s of-         Left (p, lastB0, s0) -> do-            (b1,s1) <- nextA a s0+         Left (lastB0, s0) -> do+            (b1,s1) <- nextX a s0             let lenA = CutG.length a                 lenB = CutG.length b1                 lastB1 =                    mplus (fmap snd $ SigG.viewR b1) lastB0+                cont lastB = (b1, Left (lastB,s1))             case compare lenA lenB of-               LT -> error "CausalIO.Process.mappend: output chunk is larger than input chunk"-               EQ -> return (b1, Left (p,lastB1,s1))+               LT -> error "CausalIO.Process.continue: output chunk is larger than input chunk"+               EQ -> return $ forceMaybe cont lastB1                GT ->                   case lastB1 of-                     Nothing -> return (mempty, Left (p,lastB1,s1))-                     Just lastB -> do-                        deleteA s1-                        s2 <- createB (p, lastB)-                        (b3,s3) <- nextB (CutG.drop lenB a) s2-                        return (b3, Right s3)-         Right s0 -> do-            (b1,s1) <- nextB a s0-            return (b1, Right s1))-   (\p -> do-      sa <- createA p-      return (Left (p, Nothing, sa)))+                     Nothing -> return (mempty, Left (lastB1,s1))+                     Just lastB ->+                        case procY lastB of+                           Cons nextY createY deleteY -> do+                              deleteX s1+                              (b2,s2) <- nextY (CutG.drop lenB a) =<< createY+                              return (mappend b1 b2, Right (State nextY deleteY s2))+         Right (State nextY deleteY s0) -> do+            (b1,s1) <- nextY a s0+            return (b1, Right (State nextY deleteY s1)))+   (do+      sa <- createX+      return (Left (Nothing, sa)))    (\s ->       case s of-         Left (_p,_lastB,s0) -> deleteA s0-         Right s0 -> deleteB s0)+         Left (_lastB,s0) -> deleteX s0+         Right (State _ deleteY s0) -> deleteY s0)++{- |+Pass the last non-empty output chunk+as parameter to the continuing process.+This breaks the abstraction from the chunk sizes,+but we need it for implementing vectorized processing.+-}+continueChunk ::+   (CutG.Transform a, CutG.Transform b) =>+   T a b -> (b -> T a b) -> T a b+continueChunk (Cons nextX createX deleteX) procY = Cons+   (\a s ->+      case s of+         Left (lastB0, s0) -> do+            (b1,s1) <- nextX a s0+            let lenA = CutG.length a+                lenB = CutG.length b1+                cont lastB = (b1, Left (lastB,s1))+            case compare lenA lenB of+               LT -> error "CausalIO.Process.continueChunk: output chunk is larger than input chunk"+               EQ ->+                  -- force the decision on lenB, otherwise thunks will accumulate+                  return $ if lenB==0 then cont lastB0 else cont b1+               GT ->+                  if lenB==0+                    then return $ cont lastB0+                    else+                       case procY b1 of+                          Cons nextY createY deleteY -> do+                             deleteX s1+                             (b2,s2) <- nextY (CutG.drop lenB a) =<< createY+                             return (mappend b1 b2, Right (State nextY deleteY s2))+         Right (State nextY deleteY s0) -> do+            (b1,s1) <- nextY a s0+            return (b1, Right (State nextY deleteY s1)))+   (do+      sa <- createX+      return (Left (mempty, sa)))+   (\s ->+      case s of+         Left (_lastB,s0) -> deleteX s0+         Right (State _ deleteY s0) -> deleteY s0)
src/Synthesizer/Generic/Cut.hs view
@@ -226,7 +226,7 @@   {- |-We use event lists for efficient representation of piecewise constant signals.+We abuse event lists for efficient representation of piecewise constant signals. -} instance (P.Integral t) => Read (EventList.T t y) where    null = EventList.null@@ -235,6 +235,17 @@ instance (P.Integral t, NFData y) => NormalForm (EventList.T t y) where    evaluateHead = EventList.switchL () (\x _ _ -> rnf x) ++-- cf. StorableVector.Lazy.dropMarginRem+dropMarginRemChunky ::+   (Transform sig) =>+   (sig -> [Int]) -> Int -> Int -> sig -> (Int, sig)+dropMarginRemChunky getTimes n m xs =+   List.foldl'+      (\(mi,xsi) k -> (mi-k, drop k xsi))+      (m, xs)+      (getTimes $ take m $ drop n xs)+ {- | The function defined here are based on the interpretation of event lists as piecewise constant signals.@@ -243,6 +254,11 @@ and it is also not clear, whether dropping the first chunk shall leave a chunk of length zero or remove that chunk completely.++However, sometimes we also need lists of events.+In this case the 'reverse' method would be different.+For an event-oriented instance of EventList.TimeTime+see NoteOffList in synthesizer-alsa package. -} instance (P.Integral t, NonNeg98.C t) => Transform (EventList.T t y) where    take n xs =@@ -266,12 +282,8 @@                    else EventList.cons b d xs       in  recourse . P.fromIntegral -   -- cf. ChunkySize.dropMarginRem-   dropMarginRem n m xs =-      List.foldl'-         (\(mi,xsi) k -> (mi-k, drop k xsi))-         (m, xs)-         (P.map P.fromIntegral $ EventList.getTimes $ take m $ drop n xs)+   dropMarginRem =+      dropMarginRemChunky (P.map P.fromIntegral . EventList.getTimes)     -- cf. StorableVector.Lazy.splitAt    splitAt =
src/Synthesizer/Generic/Signal.hs view
@@ -116,6 +116,9 @@ 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,@@ -135,7 +138,11 @@       case defaultLazySize of          LazySize n -> fmap LazySize (QC.choose (1, 2 P.* n)) +instance Cut.Read LazySize where+   null (LazySize n) = n==0+   length (LazySize n) = n + {- | This can be used for internal signals that have no observable effect on laziness.@@ -562,8 +569,8 @@ {-# INLINE zipWithState #-} zipWithState :: (Transform sig b) =>    (a -> b -> b) -> SigS.T a -> sig b -> sig b-zipWithState f =-   flip SigS.runViewL (\next ->+zipWithState f sig =+   SigS.runViewL sig (\next ->    crochetL (\b as0 ->       do (a,as1) <- next as0          Just (f a b, as1)))
src/Synthesizer/Generic/Signal2.hs view
@@ -194,8 +194,8 @@ {-# INLINE zipWithState #-} zipWithState :: (Transform sig b c) =>    (a -> b -> c) -> SigS.T a -> sig b -> sig c-zipWithState f =-   flip SigS.runViewL (\next ->+zipWithState f sig =+   SigS.runViewL sig (\next ->    crochetL (\b as0 ->       do (a,as1) <- next as0          Just (f a b, as1)))
src/Synthesizer/Plain/Filter/Recursive.hs view
@@ -14,9 +14,6 @@ import qualified Algebra.Module                as Module import qualified Algebra.Additive              as Additive -import Algebra.Additive((+), (-), negate, )-import Algebra.Module((*>))- import NumericPrelude.Base import NumericPrelude.Numeric
src/Synthesizer/Plain/Filter/Recursive/Allpass.hs view
@@ -28,6 +28,7 @@ import qualified Algebra.Transcendental        as Trans import qualified Algebra.Field                 as Field import qualified Algebra.Ring                  as Ring+import qualified Algebra.ZeroTestable          as ZeroTestable  import qualified Number.Complex as Complex import Data.Tuple.HT (mapSnd, )@@ -36,7 +37,6 @@  import qualified Control.Monad.Trans.State as MS -import qualified Prelude as P import NumericPrelude.Base import NumericPrelude.Numeric @@ -179,7 +179,7 @@ Compute phase shift of an allpass at a given frequency. -} {-# INLINE makePhase #-}-makePhase :: RealTrans.C a => Parameter a -> a -> a+makePhase :: (RealTrans.C a, ZeroTestable.C a) => Parameter a -> a -> a makePhase (Parameter k) frequency =    let cis = Complex.cis (- 2*pi * frequency)    in  Complex.phase (Complex.fromReal k + cis) / pi + frequency
src/Synthesizer/Plain/Filter/Recursive/AllpassPoly.hs view
@@ -18,6 +18,7 @@ import qualified Algebra.RealTranscendental    as RealTrans import qualified Algebra.Transcendental        as Trans import qualified Algebra.Field                 as Field+import qualified Algebra.ZeroTestable          as ZeroTestable  import Number.Complex (cis,(+:),real,imag) import qualified Number.Complex as Complex@@ -50,7 +51,7 @@ {-   GNUPlot.plotFunc (GNUPlot.linearScale 500 (0,1)) ((fwrap (-pi,pi)).(makePhase (shiftParam 6 (-6) (-pi/2::Double)))) -}-makePhase :: RealTrans.C a => Parameter a -> a -> a+makePhase :: (RealTrans.C a, ZeroTestable.C a) => Parameter a -> a -> a makePhase (Parameter ks) frequency =     let omega  = 2*pi * frequency         omegas = iterate (omega+) omega
src/Synthesizer/Plain/Filter/Recursive/FirstOrder.hs view
@@ -33,10 +33,6 @@ import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import Algebra.Module((*>))---- import qualified Number.Complex as Complex- import Control.Monad.Trans.State (State, state, )  import NumericPrelude.Base
src/Synthesizer/Plain/Filter/Recursive/Moog.hs view
@@ -35,7 +35,6 @@ import qualified Control.Monad.Trans.State as MS import Control.Arrow ((&&&), (>>^), (^>>), ) -import qualified Prelude as P import NumericPrelude.Base import NumericPrelude.Numeric
src/Synthesizer/Plain/Filter/Recursive/SecondOrder.hs view
@@ -41,7 +41,6 @@ import Foreign.Storable (Storable(..)) import qualified Foreign.Storable.Record as Store -import qualified Prelude as P import NumericPrelude.Base import NumericPrelude.Numeric
src/Synthesizer/Plain/Filter/Recursive/Universal.hs view
@@ -34,11 +34,8 @@ import qualified Algebra.Ring                  as Ring import qualified Algebra.Additive              as Additive -import Algebra.Module((*>))- import qualified Control.Monad.Trans.State as MS -import qualified Prelude as P import NumericPrelude.Base import NumericPrelude.Numeric
− src/Synthesizer/Plain/Miscellaneous.hs 
@@ -1,26 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-module Synthesizer.Plain.Miscellaneous-   {-# DEPRECATED "Use Synthesizer.Causal.Spatial instead" #-} where--import qualified Synthesizer.Causal.Spatial as Spatial-import qualified Synthesizer.Causal.Process as Causal--import qualified Algebra.NormedSpace.Euclidean as Euc-import qualified Algebra.Field                 as Field--import NumericPrelude.Base--- import NumericPrelude.Numeric---{- * Spatial effects -}--{-|-simulate an moving sounding object--convert the way of the object through 3D space-into a delay and attenuation information,-sonicDelay is the reciprocal of the sonic velocity--}-receive3Dsound :: (Field.C a, Euc.C a v) => a -> a -> v -> [v] -> ([a],[a])-receive3Dsound att sonicDelay ear =-   unzip . Causal.apply (Spatial.moveAround att sonicDelay ear)
src/Synthesizer/Plain/Signal.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS_GHC -fglasgow-exts #-}-{- glasgow-exts are for the rules -} {- | Copyright   :  (c) Henning Thielemann 2008-2011 License     :  GPL
− src/Synthesizer/State/Miscellaneous.hs 
@@ -1,31 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-module Synthesizer.State.Miscellaneous-   {-# DEPRECATED "Use Synthesizer.Causal.Spatial instead" #-} where--import qualified Synthesizer.State.Signal as Signal--import qualified Algebra.NormedSpace.Euclidean as Euc--- import qualified Algebra.Module                as Module--- import qualified Algebra.Transcendental        as Trans-import qualified Algebra.Field                 as Field--- import qualified Algebra.Ring                  as Ring--- import qualified Algebra.Additive              as Additive---- import qualified Prelude as P--- import NumericPrelude.Base-import NumericPrelude.Numeric--{- * Spatial effects -}--{-| simulate an moving sounding object-   convert the way of the object through 3D space-   into a delay and attenuation information,-   sonicDelay is the reciprocal of the sonic velocity -}-{-# INLINE receive3Dsound #-}-receive3Dsound :: (Field.C a, Euc.C a v) =>-   a -> a -> v -> Signal.T v -> (Signal.T a,Signal.T a)-receive3Dsound att sonicDelay ear way =-   let dists   = Signal.map Euc.norm (Signal.map (subtract ear) way)-       phase   = Signal.map (sonicDelay*) dists-       volumes = Signal.map (\x -> 1/(att+x)^2) dists-   in  (phase, volumes)
src/Synthesizer/State/Signal.hs view
@@ -47,6 +47,7 @@ import Data.Tuple.HT (mapFst, mapSnd, mapPair, fst3, snd3, thd3, ) import Data.Function.HT (nest, ) import Data.Maybe.HT (toMaybe, )+import Data.Bool.HT (if', ) import NumericPrelude.Numeric (Float, Double, fromInteger, )  import Text.Show (Show(showsPrec), show, showParen, showString, )@@ -192,9 +193,9 @@ fromPiecewiseConstant xs0 =    generate       (let go ((x,n),xs) =-             if n == P.fromInteger 0-               then go =<< EventList.viewL xs-               else Just (x, ((x, n -| P.fromInteger 1), xs))+             if' (n == P.fromInteger 0)+               (go =<< EventList.viewL xs)+               (Just (x, ((x, n -| P.fromInteger 1), xs)))        in  go)       ((error "if counter is zero, the sample value is invalid", P.fromInteger 0), xs0) @@ -336,8 +337,8 @@  {-# INLINE foldL' #-} foldL' :: (x -> acc -> acc) -> acc -> T x -> acc-foldL' g b0 =-   flip runSwitchL (\next s0 ->+foldL' g b0 sig =+   runSwitchL sig (\next s0 ->       let recurse b s =              seq b (next b (\x -> recurse (g x b)) s)       in  recurse b0 s0)@@ -379,8 +380,8 @@ {- * functions based on 'foldR' -}  foldR :: (x -> acc -> acc) -> acc -> T x -> acc-foldR g b =-   flip runSwitchL (\next s0 ->+foldR g b sig =+   runSwitchL sig (\next s0 ->       let recurse =              next b (\ x xs -> g x (recurse xs))       in  recurse s0)@@ -464,8 +465,8 @@ -} {-# INLINE extendConstant #-} extendConstant :: T a -> T a-extendConstant =-   flip runSwitchL (\switch s0 ->+extendConstant sig =+   runSwitchL sig (\switch s0 ->    switch       empty       (\ x0 _ ->@@ -548,7 +549,7 @@ dropWhile :: (a -> Bool) -> T a -> T a dropWhile p (Cons f s0) =    let recurse s =-          maybe empty (\(x,s1) -> if p x then recurse s1 else Cons f s) $+          maybe empty (\(x,s1) -> if' (p x) (recurse s1) (Cons f s)) $           runStateT f s    in  recurse s0 {-@@ -577,8 +578,8 @@  {-# INLINE cycle #-} cycle :: T a -> T a-cycle =-   flip runViewL+cycle sig =+   runViewL sig       (\next s ->           maybe              (error "StateSignal.cycle: empty input")@@ -627,9 +628,8 @@       (\(b,xys) ->           mplus              (fmap (mapSnd ((,) b)) $ viewL xys)-             (if b-                then Nothing-                else fmap (mapSnd ((,) True)) $ viewL ys))+             (if' b Nothing+                (fmap (mapSnd ((,) True)) $ viewL ys)))       (False,xs)  {-# INLINE appendStored #-}@@ -932,8 +932,8 @@   catMaybes :: T (Maybe a) -> T a-catMaybes =-   flip runViewL (\next ->+catMaybes sig =+   runViewL sig (\next ->    generate (       let go s0 =              next s0 >>= \(ma,s1) ->@@ -942,8 +942,8 @@       in  go))  flattenPairs :: T (a,a) -> T a-flattenPairs =-   flip runViewL (\next t ->+flattenPairs sig =+   runViewL sig (\next t ->    generate       (\(carry,s0) ->          fmap (\b -> (b, (Nothing, s0))) carry `mplus`
src/Synthesizer/Storable/Cut.hs view
@@ -20,6 +20,8 @@ import Foreign.Storable (Storable)  import NumericPrelude.Numeric+import NumericPrelude.Base+import Prelude ()   {-# INLINE arrange #-}@@ -167,7 +169,7 @@    let n = SVST.length v    in  SV.foldr           (\x continue i ->-             SVST.modify v i (x Additive.+) >>+             SVST.modify v i (x +) >>              continue (succ i))           (\_i -> return ())           (Sig.take (n Additive.- start) xs)@@ -182,32 +184,40 @@        (now,future) = Sig.splitAt (n Additive.- start) xs        go i [] = return i        go i (c:cs) =-          addChunkToBuffer v i c >>-          go (i Additive.+ SV.length c) cs+          unsafeAddChunkToBuffer v i c >>+          go (i + SV.length c) cs    in  fmap (flip (,) future) . go start . Sig.chunks $ now -{- | chunk must fit into the buffer -}-{- This implementation will be faster as long as 'SV.foldr' is inefficient. -} {-# INLINE addChunkToBuffer #-} addChunkToBuffer :: (Storable a, Additive.C a) =>    SVST.Vector s a -> Int -> SV.Vector a -> ST s () addChunkToBuffer v start xs =+   if start + SV.length xs <= SVST.length v+     then unsafeAddChunkToBuffer v start xs+     else error "Storable.addChunkToBuffer: chunk too large"++{- | chunk must fit into the buffer -}+{- This implementation will be faster as long as 'SV.foldr' is inefficient. -}+{-# INLINE unsafeAddChunkToBuffer #-}+unsafeAddChunkToBuffer :: (Storable a, Additive.C a) =>+   SVST.Vector s a -> Int -> SV.Vector a -> ST s ()+unsafeAddChunkToBuffer v start xs =    let go i j =           if j >= SV.length xs             then return ()             else-              SVST.unsafeModify v i (SV.index xs j Additive.+) >>-              go (i Additive.+ 1) (j Additive.+ 1)+              SVST.unsafeModify v i (SV.index xs j +) >>+              go (i + 1) (j + 1)    in  go start 0  {- | chunk must fit into the buffer -}-{-# INLINE addChunkToBufferFoldr #-}-addChunkToBufferFoldr :: (Storable a, Additive.C a) =>+{-# INLINE unsafeAddChunkToBufferFoldr #-}+unsafeAddChunkToBufferFoldr :: (Storable a, Additive.C a) =>    SVST.Vector s a -> Int -> SV.Vector a -> ST s ()-addChunkToBufferFoldr v start xs =+unsafeAddChunkToBufferFoldr v start xs =    SV.foldr       (\x continue i ->-         SVST.unsafeModify v i (x Additive.+) >>+         SVST.unsafeModify v i (x +) >>          continue (succ i))       (\_i -> return ())       xs start@@ -222,7 +232,7 @@        (now,future) = Sig.splitAt (n Additive.- start) xs    in  Sig.foldr           (\x continue i ->-             SVST.modify v i (x Additive.+) >>+             SVST.modify v i (x +) >>              continue (succ i))           (\i -> return (i, future))           now start@@ -246,6 +256,6 @@               Sig.switchL                  (return (i, Sig.empty))                  (\x xs ->-                     SVST.modify v i (x Additive.+) >>+                     SVST.modify v i (x +) >>                      go (succ i) xs)    in  go start
src/Synthesizer/Storable/Signal.hs view
@@ -167,23 +167,6 @@ -}  {--Where to place this function?-So far, for applying a causal process to a storable signal-we have just used the generic crochetL method.--applyCausalChunk :: Causal.T a b -> Causal.T (Vector a) (Vector b)-applyCausalChunk = undefined---A generalized version could be of type--Transform.C sig a b => Causal.T a b -> Causal.T (sig a) (sig b)--but we cannot implement that,-since crochetL does not return the final state.--}--{- reduceLVector :: Storable x =>    (x -> acc -> Maybe acc) -> acc -> Vector x -> (acc, Bool) reduceLVector f acc0 x =
src/Synthesizer/Zip.hs view
@@ -4,11 +4,89 @@  import Data.Monoid (Monoid, mempty, mappend, ) +import qualified Control.Arrow as Arrow+import Control.Arrow (Arrow, (^<<), (<<^), ) + {- | Parallel combination of two signals of equal length. -}-data T a b = Cons a b+data T a b = Cons {first :: a, second :: b}++{- |+Zip together two signals.+It is a checked error if their lengths differ.+-}+consChecked ::+   (CutG.Read a, CutG.Read b) =>+   String -> a -> b -> T a b+consChecked name a b =+   let lenA = CutG.length a+       lenB = CutG.length b+   in  if lenA == lenB+         then Cons a b+         else error $ "different lengths " +++              show lenA ++ " vs. " ++ show lenB ++ " in " ++ name++{- |+Zip together two signals+and shorten them to the length of the shorter one.+-}+consShorten ::+   (CutG.Transform a, CutG.Transform b) =>+   a -> b -> T a b+consShorten a b =+   let len = min (CutG.length a) (CutG.length b)+   in  Cons (CutG.take len a) (CutG.take len b)++++arrowFirst ::+   Arrow arrow =>+   arrow a b -> arrow (T a c) (T b c)+arrowFirst arrow =+   uncurry Cons+   ^<<+   Arrow.first arrow+   <<^+   (\(Cons a b) -> (a,b))++arrowSecond ::+   Arrow arrow =>+   arrow a b -> arrow (T c a) (T c b)+arrowSecond arrow =+   uncurry Cons+   ^<<+   Arrow.second arrow+   <<^+   (\(Cons a b) -> (a,b))++arrowFirstShorten ::+   (Arrow arrow, CutG.Transform b, CutG.Transform c) =>+   arrow a b -> arrow (T a c) (T b c)+arrowFirstShorten arrow =+   uncurry consShorten+   ^<<+   Arrow.first arrow+   <<^+   (\(Cons a b) -> (a,b))++arrowSecondShorten ::+   (Arrow arrow, CutG.Transform b, CutG.Transform c) =>+   arrow a b -> arrow (T c a) (T c b)+arrowSecondShorten arrow =+   uncurry consShorten+   ^<<+   Arrow.second arrow+   <<^+   (\(Cons a b) -> (a,b))+++arrowFanout ::+   Arrow arrow =>+   arrow a b -> arrow a c -> arrow a (T b c)+arrowFanout b c =+   uncurry  Cons Arrow.^<<  b Arrow.&&& c   instance (Monoid a, Monoid b) => Monoid (T a b) where
src/Test/Sound/Synthesizer/Basic/ToneModulation.hs view
@@ -8,7 +8,7 @@  import qualified Test.Sound.Synthesizer.Plain.Interpolation as InterpolationTest -import Test.QuickCheck (test, Property, (==>), Testable, )+import Test.QuickCheck (quickCheck, Property, (==>), Testable, ) -- import Test.Utility  import qualified Number.NonNegative       as NonNeg@@ -37,7 +37,7 @@       ToneMod.flattenShapePhaseAnalytic periodInt period c  --- * auxiliary test functions+-- * auxiliary quickCheck functions  {- Although that looks like a too small value, it is actually right,@@ -73,21 +73,21 @@   -testRationalLineIp :: Testable test =>-   (InterpolationTest.LinePreserving Rational Rational -> test) -> IO ()-testRationalLineIp f  =  test f+testRationalLineIp :: Testable quickCheck =>+   (InterpolationTest.LinePreserving Rational Rational -> quickCheck) -> IO ()+testRationalLineIp f  =  quickCheck f -testRationalIp :: Testable test =>-   (InterpolationTest.T Rational Rational -> test) -> IO ()-testRationalIp f  =  test f+testRationalIp :: Testable quickCheck =>+   (InterpolationTest.T Rational Rational -> quickCheck) -> IO ()+testRationalIp f  =  quickCheck f   tests :: [(String, IO ())] tests =    ("untangleShapePhase",-      test (\periodInt period ->-                untangleShapePhase periodInt (period :: Rational))) :+      quickCheck $ \periodInt period ->+         untangleShapePhase periodInt (period :: Rational)) :    ("flattenShapePhase",-      test (\periodInt period ->-                flattenShapePhase periodInt (period :: Rational))) :+      quickCheck $ \periodInt period ->+         flattenShapePhase periodInt (period :: Rational)) :    []
src/Test/Sound/Synthesizer/Generic/ToneModulation.hs view
@@ -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 (test, Property, (==>), )+import Test.QuickCheck (quickCheck, Property, (==>), ) import Test.Utility (ArbChar, ) -- import Debug.Trace (trace, ) @@ -280,19 +280,19 @@  tests :: [(String, IO ())] tests =-   ("limitMinRelativeValues", test limitMinRelativeValues) :+   ("limitMinRelativeValues", quickCheck limitMinRelativeValues) :    ("integrateFractional",-      test (\period -> integrateFractional (period :: NonNeg.Rational))) :+      quickCheck (\period -> integrateFractional (period :: NonNeg.Rational))) :    ("oscillatorCellSize",-      test (\ml ms periodInt period ext ixs ->+      quickCheck (\ml ms periodInt period ext ixs ->                oscillatorCellSize ml ms periodInt (period :: NonNeg.Rational)                   ext (ixs :: NonEmpty.T ArbChar))) :    ("oscillatorSuffixes",-      test (\ml ms periodInt period ext ixs ->+      quickCheck (\ml ms periodInt period ext ixs ->                oscillatorSuffixes ml ms periodInt (period :: NonNeg.Rational)                   ext (ixs :: NonEmpty.T ArbChar))) :    ("oscillatorCells",-      test (\ml ms periodInt period ext ixs ->+      quickCheck (\ml ms periodInt period ext ixs ->                oscillatorCells ml ms periodInt (period :: NonNeg.Rational)                   ext (ixs :: NonEmpty.T ArbChar))) :    ("sampledTone",
src/Test/Sound/Synthesizer/Plain/Analysis.hs view
@@ -17,7 +17,7 @@  import Data.List (genericLength) -import Test.QuickCheck (test, Property, (==>))+import Test.QuickCheck (quickCheck, Property, (==>)) import Test.Utility (approxEqual)  -- import qualified Algebra.Ring                  as Ring@@ -117,7 +117,7 @@ centroid xs =    sum xs /= zero ==>       Analysis.centroid xs == Analysis.centroidAlt xs--- Test.QuickCheck.test (\xs -> sum xs /= 0 Test.QuickCheck.==> propCentroid (xs::[Rational]))+-- Test.QuickCheck.quickCheck (\xs -> sum xs /= 0 Test.QuickCheck.==> propCentroid (xs::[Rational]))  histogramDCOffset :: Int -> Int -> [Int] -> Property histogramDCOffset x0 x1 xs =@@ -131,18 +131,18 @@  tests :: [(String, IO ())] tests =-   ("volumeVectorMaximum", test (volumeVectorMaximum :: [Rational] -> Bool)) :-   -- test may fail due to rounding errors, but so far the computation is exactly the same-   ("volumeVectorEuclidean", test (volumeVectorEuclidean :: Double -> [Double] -> Bool)) :-   ("volumeVectorEuclideanSqr", test (volumeVectorEuclideanSqr :: Rational -> [Rational] -> Bool)) :-   ("volumeVectorSum", test (volumeVectorSum :: Rational -> [Rational] -> Bool)) :-   ("bounds", test (bounds :: Rational -> [Rational] -> Bool)) :-   ("spread", test (spread :: (Rational,Rational) -> Bool)) :-   ("histogramDiscrete", test (histogramDiscrete :: Int -> [Int] -> Bool)) :-   ("histogramDiscreteLength", test (histogramDiscreteLength :: [Int] -> Bool)) :-   ("histogramDiscreteConcat", test (histogramDiscreteConcat :: [Int] -> [Int] -> Bool)) :-   ("histogramLinear", test (histogramLinear :: Int -> [Int] -> Bool)) :-   ("histogramLinearLength", test (histogramLinearLength :: Int -> [Int] -> Bool)) :-   ("centroid", test (centroid :: [Rational] -> Property)) :-   ("histogramDCOffset", test (histogramDCOffset :: Int -> Int -> [Int] -> Property)) :+   ("volumeVectorMaximum", quickCheck (volumeVectorMaximum :: [Rational] -> Bool)) :+   -- quickCheck may fail due to rounding errors, but so far the computation is exactly the same+   ("volumeVectorEuclidean", quickCheck (volumeVectorEuclidean :: Double -> [Double] -> Bool)) :+   ("volumeVectorEuclideanSqr", quickCheck (volumeVectorEuclideanSqr :: Rational -> [Rational] -> Bool)) :+   ("volumeVectorSum", quickCheck (volumeVectorSum :: Rational -> [Rational] -> Bool)) :+   ("bounds", quickCheck (bounds :: Rational -> [Rational] -> Bool)) :+   ("spread", quickCheck (spread :: (Rational,Rational) -> Bool)) :+   ("histogramDiscrete", quickCheck (histogramDiscrete :: Int -> [Int] -> Bool)) :+   ("histogramDiscreteLength", quickCheck (histogramDiscreteLength :: [Int] -> Bool)) :+   ("histogramDiscreteConcat", quickCheck (histogramDiscreteConcat :: [Int] -> [Int] -> Bool)) :+   ("histogramLinear", quickCheck (histogramLinear :: Int -> [Int] -> Bool)) :+   ("histogramLinearLength", quickCheck (histogramLinearLength :: Int -> [Int] -> Bool)) :+   ("centroid", quickCheck (centroid :: [Rational] -> Property)) :+   ("histogramDCOffset", quickCheck (histogramDCOffset :: Int -> Int -> [Int] -> Property)) :    []
src/Test/Sound/Synthesizer/Plain/Control.hs view
@@ -2,7 +2,7 @@  import qualified Synthesizer.Plain.Control as Control -import Test.QuickCheck (test, Property, (==>))+import Test.QuickCheck (quickCheck, Property, (==>)) import Test.Utility (equalList, approxEqualListAbs, approxEqualListRel, )  -- import qualified Algebra.Ring                  as Ring@@ -102,11 +102,11 @@  tests :: [(String, IO ())] tests =-   ("linearRing", test linearRing) :-   ("linearApprox", test linearApprox) :-   ("linearExact", test linearExact) :-   ("exponential", test exponential) :-   ("exponential2", test exponential2) :-   ("cosine", test cosine) :-   ("cubic", test cubic) :+   ("linearRing", quickCheck linearRing) :+   ("linearApprox", quickCheck linearApprox) :+   ("linearExact", quickCheck linearExact) :+   ("exponential", quickCheck exponential) :+   ("exponential2", quickCheck exponential2) :+   ("cosine", quickCheck cosine) :+   ("cubic", quickCheck cubic) :    []
src/Test/Sound/Synthesizer/Plain/Filter.hs view
@@ -17,7 +17,7 @@  import qualified Test.Sound.Synthesizer.Plain.NonEmpty as NonEmpty -import Test.QuickCheck (test, {- Property, (==>) -})+import Test.QuickCheck (quickCheck, {- Property, (==>) -}) import Test.Utility (equalList, ArbChar, )  -- import qualified Algebra.Module                as Module@@ -188,12 +188,12 @@  tests :: [(String, IO ())] tests =-   ("sums", test sums) :-   ("sumRange", test sumRange) :-   ("getRange", test getRange) :-   ("sumsPosModulated", test sumsPosModulated) :-   ("minPosModulated", test minPosModulated):-   ("downSample2", test downSample2) :-   ("sumsDownSample2", test sumsDownSample2) :-   ("movingAverageModulatedPyramid", test movingAverageModulatedPyramid) :+   ("sums", quickCheck sums) :+   ("sumRange", quickCheck sumRange) :+   ("getRange", quickCheck getRange) :+   ("sumsPosModulated", quickCheck sumsPosModulated) :+   ("minPosModulated", quickCheck minPosModulated):+   ("downSample2", quickCheck downSample2) :+   ("sumsDownSample2", quickCheck sumsDownSample2) :+   ("movingAverageModulatedPyramid", quickCheck movingAverageModulatedPyramid) :    []
src/Test/Sound/Synthesizer/Plain/Filter/Allpass.hs view
@@ -5,7 +5,7 @@  -- import qualified Test.Sound.Synthesizer.Plain.NonEmpty as NonEmpty -import Test.QuickCheck (test, {- Property, (==>) -})+import Test.QuickCheck (quickCheck, {- Property, (==>) -}) import Test.Utility (equalList, )  -- import qualified Algebra.Module                as Module@@ -51,6 +51,6 @@  tests :: [(String, IO ())] tests =-   ("cascadeStep", test cascadeStep) :-   ("cascade", test cascade) :+   ("cascadeStep", quickCheck cascadeStep) :+   ("cascade", quickCheck cascade) :    []
src/Test/Sound/Synthesizer/Plain/Filter/Hilbert.hs view
@@ -8,7 +8,7 @@  import qualified Test.Sound.Synthesizer.Plain.NonEmpty as NonEmpty -import Test.QuickCheck (test, {- Property, (==>) -})+import Test.QuickCheck (quickCheck, {- Property, (==>) -}) -- import Test.Utility (equalList, )  -- import qualified Algebra.Module                as Module@@ -40,5 +40,5 @@  tests :: [(String, IO ())] tests =-   ("hilbert", test cascade) :+   ("hilbert", quickCheck cascade) :    []
src/Test/Sound/Synthesizer/Plain/Oscillator.hs view
@@ -7,7 +7,7 @@ import qualified Test.Sound.Synthesizer.Plain.Wave          as WaveTest -- import qualified Test.Sound.Synthesizer.Plain.Interpolation as InterpolationTest -import Test.QuickCheck (test, {- Property, (==>), -} )+import Test.QuickCheck (quickCheck, {- Property, (==>), -} )  import qualified Algebra.RealField             as RealField @@ -35,5 +35,5 @@  tests :: [(String, IO ())] tests =-   ("phaseShapeModRational",  test phaseShapeModRational) :+   ("phaseShapeModRational",  quickCheck phaseShapeModRational) :    []
src/Test/Sound/Synthesizer/Plain/ToneModulation.hs view
@@ -30,6 +30,7 @@ import qualified Algebra.Module                as Module import qualified Algebra.RealField             as RealField import qualified Algebra.Additive              as Additive+import qualified Algebra.ZeroTestable          as ZeroTestable  import Data.List.HT (isAscending, ) import Data.Ord.HT (limit, )@@ -276,7 +277,8 @@              (tail coords)  -shapeFreqModFromSampledToneCoordsIdentity :: (RealField.C t) =>+shapeFreqModFromSampledToneCoordsIdentity ::+   (RealField.C t, ZeroTestable.C t) =>    NonNeg.Int -> NonNeg.T t -> (t, [NonNeg.T t]) -> Property shapeFreqModFromSampledToneCoordsIdentity       periodIntNN periodNN (shape0,shapesNN) =
synthesizer-core.cabal view
@@ -1,5 +1,5 @@ Name:           synthesizer-core-Version:        0.4.2+Version:        0.5 License:        GPL License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de>@@ -23,7 +23,7 @@      Oscillators, Noise generators, Frequency filters,      Fast Fourier transform for computation of frequency spectrum Stability:      Experimental-Tested-With:    GHC==6.4.1, GHC==6.8.2, GHC==6.10.4+Tested-With:    GHC==6.4.1, GHC==6.8.2, GHC==6.10.4, GHC==6.12.3, GHC==7.0.4, GHC==7.2.1 Cabal-Version:  >=1.6 Build-Type:     Simple @@ -51,11 +51,6 @@   default:     False  -Source-Repository this-  Tag:         0.4.2-  Type:        darcs-  Location:    http://code.haskell.org/synthesizer/core/- Source-Repository head   Type:        darcs   Location:    http://code.haskell.org/synthesizer/core/@@ -68,10 +63,10 @@     event-list >=0.1 && <0.2,     non-negative >=0.1 && <0.2,     explicit-exception >=0.1.6 && <0.2,-    numeric-prelude >=0.2.1 && <0.3,+    numeric-prelude >=0.3 && <0.4,     numeric-quest >=0.1 && <0.2,     utility-ht >=0.0.5 && <0.1,-    filepath >=1.1 && <1.2,+    filepath >=1.1 && <1.3,     stream-fusion >=0.1.2 && <0.2,     bytestring >=0.9 && <0.10,     binary >=0.1 && <1,@@ -92,13 +87,19 @@       array >=0.1 && <0.4,       containers >=0.1 && <0.5,       random >=1.0 && <2.0,-      process >=1.0 && <1.1+      process >=1.0 && <1.2   Else     Hs-Source-Dirs: src-3     Build-Depends:       base >= 1.0 && < 2,       special-functors >= 1.0 && <1.1 +  If impl(ghc>=7.0)+-- also warns about NumericPrelude import:  -fwarn-missing-import-lists+    GHC-Options: -fwarn-unused-do-bind+    CPP-Options: -DNoImplicitPrelude=RebindableSyntax+    Extensions: CPP+   GHC-Options:    -Wall   Hs-source-dirs: src   Exposed-modules:@@ -158,7 +159,6 @@     Synthesizer.Plain.Oscillator     Synthesizer.Plain.ToneModulation     Synthesizer.Plain.Wave-    Synthesizer.Plain.Miscellaneous     Synthesizer.Plain.Instrument     Synthesizer.Plain.Effect     Synthesizer.Plain.Effect.Fly@@ -182,7 +182,6 @@     Synthesizer.State.Filter.Recursive.Integration     Synthesizer.State.Filter.Recursive.MovingAverage     Synthesizer.State.Interpolation-    Synthesizer.State.Miscellaneous     Synthesizer.State.Noise     Synthesizer.State.NoiseCustom     Synthesizer.State.Oscillator@@ -200,6 +199,7 @@     Synthesizer.Causal.Spatial     Synthesizer.Causal.Filter.NonRecursive     Synthesizer.Causal.Filter.Recursive.Integration+    Synthesizer.CausalIO.Gate     Synthesizer.CausalIO.Process     Synthesizer.Generic.Analysis     Synthesizer.Generic.Cut@@ -239,12 +239,19 @@ Executable test   If !flag(buildTests)     Buildable: False-  GHC-Options: -Wall+  GHC-Options: -Wall -fwarn-tabs -fwarn-incomplete-record-updates   Hs-Source-Dirs: src++  If impl(ghc>=7.0)+    GHC-Options: -fwarn-unused-do-bind+    CPP-Options: -DNoImplicitPrelude=RebindableSyntax+    Extensions: CPP+   If flag(category)     Hs-Source-Dirs: src-4   Else     Hs-Source-Dirs: src-3+   Other-Modules:     Test.Utility     Test.Sound.Synthesizer.Plain.Analysis@@ -276,13 +283,18 @@       storablevector >=0.2.7 && <0.3,       utility-ht >=0.0.5 && <0.1,       storable-tuple >=0.0.1 && <0.1,-      numeric-prelude >=0.2 && <0.3,       timeit >=1.0 && <1.1,       base >=4 && <5   Else     Buildable: False -  GHC-Options:    -Wall -auto-all+  If impl(ghc>=7.0)+    GHC-Options: -fwarn-unused-do-bind+    CPP-Options: -DNoImplicitPrelude=RebindableSyntax+    Extensions: CPP++  GHC-Options:      -Wall+  GHC-Prof-Options: -auto-all   Hs-Source-Dirs: speedtest, src   If flag(category)     Hs-Source-Dirs: src-4@@ -293,6 +305,12 @@ Executable speedtest   If !flag(buildProfilers)     Buildable: False++  If impl(ghc>=7.0)+    GHC-Options: -fwarn-unused-do-bind+    CPP-Options: -DNoImplicitPrelude=RebindableSyntax+    Extensions: CPP+   GHC-Options: -Wall -fexcess-precision   If flag(optimizeAdvanced)     GHC-Options: -optc-ffast-math -optc-O3@@ -308,6 +326,12 @@ Executable speedtest-exp   If !flag(buildProfilers)     Buildable: False++  If impl(ghc>=7.0)+    GHC-Options: -fwarn-unused-do-bind+    CPP-Options: -DNoImplicitPrelude=RebindableSyntax+    Extensions: CPP+   GHC-Options: -Wall -fexcess-precision   Hs-Source-Dirs: speedtest, src   If flag(category)@@ -317,11 +341,18 @@   Main-Is: SpeedTestExp.hs   If flag(splitBase)     Build-Depends:-      old-time >= 1.0 && < 1.1, directory >= 1.0 && < 1.1+      old-time >= 1.0 && < 1.1,+      directory >= 1.0 && < 1.2  Executable speedtest-simple   If !flag(buildProfilers)     Buildable: False++  If impl(ghc>=7.0)+    GHC-Options: -fwarn-unused-do-bind+    CPP-Options: -DNoImplicitPrelude=RebindableSyntax+    Extensions: CPP+   GHC-Options: -Wall   Hs-Source-Dirs: speedtest, src   If flag(category)