packages feed

synthesizer-0.2: speedtest/FusionTest.hs

{-# OPTIONS_GHC -O2 #-}
module Main (main) where

import qualified Synthesizer.Storable.Signal as SigSt
import qualified Synthesizer.Storable.Oscillator as OsciSt
import qualified Synthesizer.Storable.Cut as CutSt

import qualified Synthesizer.State.Signal as SigS
import qualified Synthesizer.State.Oscillator as OsciS
import qualified Synthesizer.State.Control as CtrlS
import qualified Synthesizer.State.Filter.NonRecursive as FiltNRS
import qualified Synthesizer.State.Cut as CutS
import qualified Synthesizer.State.NoiseCustom as NoiseS
import qualified Synthesizer.State.Interpolation as InterpolationS

import qualified Synthesizer.FusionList.Signal as SigFL
import qualified Synthesizer.FusionList.Oscillator as OsciFL
import qualified Synthesizer.FusionList.Control as CtrlFL
import qualified Synthesizer.FusionList.Filter.NonRecursive as FiltNRFL

import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.Generic.Filter.Delay as DelayG
import qualified Synthesizer.Generic.Interpolation as InterpolationG

import qualified Synthesizer.Interpolation.Module as InterpolationM
import qualified Synthesizer.Basic.Wave       as Wave
import qualified Synthesizer.Basic.Phase      as Phase
import qualified Synthesizer.Basic.DistortionControlled as Dist
import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter
import qualified Synthesizer.Plain.Filter.Recursive    as FiltR
import qualified Synthesizer.Plain.Control as Ctrl
import Synthesizer.Piecewise ((|#), (#|-), (-|#), (#|), )

import qualified Data.EventList.Relative.TimeBody as EventList

import Synthesizer.Basic.Binary (int16FromCanonical, int16FromDouble, )
import Data.Int (Int8, Int16, )
import Foreign.Storable (Storable, )
import qualified Sound.Signal as Signal
import qualified Data.List as List
import qualified Data.Char as Char

import GHC.Float (double2Int, int2Double)
import NumericPrelude ((^?))
import qualified NumericPrelude as NP

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 System.Random (mkStdGen)
import qualified Synthesizer.RandomKnuth as Knuth


{-
If you increase the chunk size to 10000 the computation becomes slower.
Is this reproducable?
-}
defaultChunkSize :: SigSt.ChunkSize
defaultChunkSize = SigSt.chunkSize 1000


{-# INLINE storableFromFusionList #-}
storableFromFusionList :: Storable a => SigFL.T a -> SigSt.T a
storableFromFusionList =
   SigFL.toStorableSignal defaultChunkSize
--   SigSt.fromFusionList defaultChunkSize

mapTest0 :: SigSt.T Char
mapTest0 =
   SigSt.fromList defaultChunkSize
      (List.map succ (List.replicate 200000 'a'))

mapTest1 :: [Char] -> SigSt.T Char
mapTest1 =
   SigSt.fromList defaultChunkSize . List.map Char.toUpper

mapTest2 :: [Char] -> SigSt.T Char
mapTest2 xs =
   SigSt.fromList defaultChunkSize (List.map Char.toUpper xs)

mapTest3 :: SigSt.T Int8
mapTest3 =
   SigSt.fromList defaultChunkSize
      (List.map succ (List.replicate 200000 1234))

mapTest4 :: SigSt.T Int8
mapTest4 =
   SigSt.fromList defaultChunkSize
      (List.map pred (List.replicate 200000 1234))

mapTest5 :: SigSt.T Int8
mapTest5 =
   storableFromFusionList
      (SigFL.map pred (SigFL.replicate 200000 1234))

{- inlining here even reduces the application of rules - Why? -}
{- INLINE mapTest6 -}
mapTest6 :: SigSt.T Int16
mapTest6 =
   storableFromFusionList $ SigFL.take 200000 $
   SigFL.map int16FromCanonical $
--   SigFL.map (^2) $
   SigFL.repeat (3::Double)


{-# INLINE zeroPhase #-}
zeroPhase :: Phase.T Double
zeroPhase = NP.zero

osciTest0 :: SigSt.T Int16
osciTest0 =
   storableFromFusionList $
   SigFL.take 200000 $
   -- int16FromCanonical is not only slow in execution but also blocks fusion - why?
   SigFL.map int16FromCanonical $
   (OsciFL.staticSaw zeroPhase 0.01 :: SigFL.T Double)

osciTest0a :: SigSt.T Int16
osciTest0a =
   storableFromFusionList $
   SigFL.take 200000 $
   SigFL.map int16FromDouble $
   OsciFL.staticSaw zeroPhase 0.01

{-
{-# INLINE exponential2 #-}
exponential2 :: Trans.C a =>
      a   {-^ half life -}
   -> a   {-^ initial value -}
   -> SigFL.T a
          {-^ exponential decay -}
exponential2 halfLife =
   SigFL.iterate (((Ring.one Field./ (Ring.one Additive.+ Ring.one)) Trans.^? Field.recip halfLife) Ring.*)
-}


osciTest0b :: SigSt.T Int16
osciTest0b =
   storableFromFusionList $
   SigFL.take 200000 $
   SigFL.map int16FromDouble $
   FiltNRFL.envelope
      (CtrlFL.exponential2 50000 1)
      (OsciFL.staticSaw zeroPhase 0.01)

osciTest0ba :: SigSt.T Int16
osciTest0ba =
   storableFromFusionList $
   SigFL.take 200000 $
   SigFL.map int16FromDouble $
   CtrlFL.exponential2 50000 1

osciTest0c :: SigSt.T Int16
osciTest0c =
   storableFromFusionList $
   SigFL.take 200000 $
   SigFL.map int16FromDouble $
   FiltNRFL.envelope
      (CtrlFL.exponential2 50000 0.5)
      (OsciFL.shapeMod Wave.squareBalanced zeroPhase 0.01 $
          SigFL.map (0.5*) $ OsciFL.staticSine zeroPhase 0.00002)

osciTest0d :: SigSt.T Int16
osciTest0d =
   storableFromFusionList $
   SigFL.take 200000 $
   SigFL.map int16FromDouble $
   FiltNRFL.envelope
--      (exponential2 50000 0.5)
      (CtrlFL.exponential2 50000 0.5)
--      (SigFL.iterate ((0.5 ^? recip 50000)*) 0.5)
      (OsciFL.freqMod Wave.square zeroPhase
          (SigFL.map (0.01+) $ SigFL.map (0.0001*) $ OsciFL.staticSine zeroPhase 0.0001))

osciTest0e :: SigSt.T Int16
osciTest0e =
   storableFromFusionList $
   SigFL.take 200000 $
   SigFL.map int16FromDouble $
   FiltNRFL.envelope
      (CtrlFL.exponential2 50000 0.5)
      (OsciFL.shapeFreqMod Wave.squareBalanced zeroPhase
          (SigFL.map (0.5*) $ OsciFL.staticSine zeroPhase 0.00002)
          (SigFL.map (0.01+) $ SigFL.map (0.0001*) $ OsciFL.staticSine zeroPhase 0.0001))

osciTest0ea :: SigSt.T Int16
osciTest0ea =
   storableFromFusionList $
   SigFL.take 200000 $
   SigFL.map int16FromDouble $
      (OsciFL.shapeFreqMod Wave.squareBalanced zeroPhase
          (OsciFL.staticSine zeroPhase 0.00002)
          (OsciFL.staticSine zeroPhase 0.0001))

osciTest0f :: SigSt.T Int16
osciTest0f =
   storableFromFusionList $
   SigFL.take 200000 $
   SigFL.map int16FromDouble $
   FiltNRFL.envelope
      (CtrlFL.exponential2 50000 1)
--      (SigFL.zipWith (\x y -> (x+y)/2)
--      (MiscFL.mix
      (SigFL.mix
         (OsciFL.static Wave.saw zeroPhase 0.01003)
         (OsciFL.static Wave.saw zeroPhase 0.00997))
-- staticSaw blocks fusion
--         (OsciFL.staticSaw zeroPhase 0.01003)
--         (OsciFL.staticSaw zeroPhase 0.00997))

osciTest0fa :: SigSt.T Int16
osciTest0fa =
   storableFromFusionList $
   SigFL.take 200000 $
   SigFL.map int16FromDouble $
   FiltNRFL.envelope
      (CtrlFL.exponential2 50000 1)
      (SigFL.mix
         (SigFL.mix
            (OsciFL.staticSaw zeroPhase 0.01001)
            (OsciFL.staticSaw zeroPhase 0.00998))
         (SigFL.mix
            (OsciFL.staticSaw zeroPhase 0.01005)
            (OsciFL.staticSaw zeroPhase 0.00996)))

osciTest1 :: SigSt.T Double
osciTest1 =
   storableFromFusionList $
   SigFL.take 200000 $
   (OsciFL.staticSaw zeroPhase 0.01 :: SigFL.T Double)

osciTest2 :: SigSt.T Int16
osciTest2 =
   storableFromFusionList $
   SigFL.take 200000 $
   SigFL.iterate (200+) 0

osciTest3 :: SigSt.T Double
osciTest3 =
   SigSt.take 200000 $
   SigSt.map (\x->x*x) $
   SigSt.iterate defaultChunkSize (200+) 0

osciTest4 :: SigSt.T Int16
osciTest4 =
   SigSt.take 200000 $
   SigSt.map int16FromCanonical $  -- this is now really fast thanks to specialisation
   (SigSt.iterate defaultChunkSize (1+) 0 :: SigSt.T Double)

osciTest5 :: SigSt.T Int16
osciTest5 =
   SigSt.take 200000 $
   SigSt.map int16FromDouble $
   (SigSt.iterate defaultChunkSize (1+) 0 :: SigSt.T Double)

osciTest6 :: SigSt.T Int16
osciTest6 =
   -- takeCrochet is slow if not fused away
   SigSt.takeCrochet 200000 $
   SigSt.map int16FromDouble $
   (SigSt.iterate defaultChunkSize (1+) 0 :: SigSt.T Double)


{-
waveSine :: Floating a => a -> a
waveSine x = sin (2*pi*x)
-}

{-
waveSine :: Trans.C a => a -> a
waveSine x = Trans.sin (NP.fromInteger 2 NP.* Trans.pi NP.* x)

incrFracDouble :: Double -> Double -> Double
incrFracDouble d x = NP.fraction (d + x)

{-# ONLINE incrFrac #-}
incrFrac :: NP.RealFrac a => a -> a -> a
incrFrac d x = NP.fraction (d NP.+ x)

fraction :: Double -> Double
fraction x =
   let second :: (Int, a) -> a
       second = snd
       f = second (properFraction x)
   in  if f>=0 then f else f+1
-}

{-
fraction :: Double -> Double
fraction x = x - fromIntegral (floor x :: Int)
-}

{-
fraction :: Double -> Double
fraction x = x - int2Double (double2Int x)

incrFracDouble :: Double -> Double -> Double
incrFracDouble d x = fraction (d + x)
-}

{-
incrFracDouble :: Double -> Double -> Double
incrFracDouble d x = d + x
-}


osciTest7 :: SigSt.T Int16
osciTest7 =
   SigSt.take 200000 $
   SigSt.map int16FromDouble $
--   SigSt.map (\x -> sin (2*pi*x)) $
   SigSt.map (Wave.apply Wave.sine) $
--   SigSt.map (Wave.apply waveSine) $
--   (SigSt.iterate defaultChunkSize (0.01 +) NP.zero :: SigSt.T (Phase.T Double))
   (SigSt.iterate defaultChunkSize (Phase.increment 0.01) NP.zero :: SigSt.T (Phase.T Double))
--   (SigSt.iterate defaultChunkSize (incrFrac 0.01) NP.zero :: SigSt.T (Phase.T Double))
--   (SigSt.iterate defaultChunkSize (incrFracDouble 0.01) NP.zero :: SigSt.T (Phase.T Double))

osciTest8 :: SigSt.T Int16
osciTest8 =
   SigSt.take 200000 $
   SigSt.map int16FromDouble $
   (OsciSt.staticSaw defaultChunkSize zeroPhase 0.01 :: SigSt.T Double)


appendTest0 :: SigSt.T Int16
appendTest0 =
   storableFromFusionList $
   SigFL.map int16FromDouble $
      let tone0 = SigFL.take 100000 $ OsciFL.static Wave.saw zeroPhase 0.010
          tone1 = SigFL.take 100000 $ OsciFL.static Wave.saw zeroPhase 0.015
      in  SigFL.append tone0 tone1

appendTest1 :: SigSt.T Int16
appendTest1 =
   let tone0 = SigFL.take 100000 $ OsciFL.static Wave.saw zeroPhase 0.010
       tone1 = SigFL.take 100000 $ OsciFL.static Wave.saw zeroPhase 0.015
   in  storableFromFusionList $
       SigFL.map int16FromDouble $
       SigFL.append tone0 tone1

appendTest2 :: SigSt.T Int16
appendTest2 =
   SigSt.map int16FromDouble $
   SigSt.appendFromFusionList defaultChunkSize
      (SigFL.take 100000 $ OsciFL.static Wave.saw zeroPhase 0.010)
      (SigFL.take 100000 $ OsciFL.static Wave.saw zeroPhase 0.015)

appendTest3 :: SigSt.T Int16
appendTest3 =
   storableFromFusionList $
   SigFL.map int16FromDouble $
   SigSt.appendFusionList defaultChunkSize
      (SigFL.take 100001 $ OsciFL.static Wave.sine zeroPhase 0.010)
      (SigFL.take 100000 $ OsciFL.static Wave.saw zeroPhase 0.015)

mixTest0 :: SigSt.T Int16
mixTest0 =
   SigSt.map int16FromDouble $
   SigSt.mixSize defaultChunkSize
      (SigSt.replicate defaultChunkSize 100000 NP.zero)
      (SigSt.replicate defaultChunkSize 100001 NP.one)

mixTest3 :: SigSt.T Int16
mixTest3 =
   SigSt.map int16FromDouble $
   SigSt.mixSize defaultChunkSize
--      (storableFromFusionList $ SigFL.take 100000 $ OsciFL.static Wave.sine zeroPhase 0.010)
--      (storableFromFusionList $ SigFL.take 100000 $ CtrlFL.exponential2 50000 1)
      (storableFromFusionList $ SigFL.take 100001 $ OsciFL.static Wave.saw zeroPhase 0.015)
      (SigSt.empty)

mixTest4 :: SigSt.T Int16
mixTest4 =
   SigSt.map int16FromDouble $
   SigSt.mixSize defaultChunkSize
      (SigSt.take 100002 $ OsciSt.staticSine defaultChunkSize zeroPhase 0.020) $
   SigSt.mixSize defaultChunkSize
      (SigSt.take 100001 $ OsciSt.staticSine defaultChunkSize zeroPhase 0.010)
      (SigSt.take 100000 $ OsciSt.staticSaw  defaultChunkSize zeroPhase 0.015)


mixTest5 :: SigSt.T Int16
mixTest5 =
   SigSt.map int16FromDouble $
   SigSt.take 441000 $
--   SigSt.append
   SigSt.mix
--   SigSt.mixSize defaultChunkSize
      (SigSt.iterate defaultChunkSize ((1-1e-6)*) 0.5)
      (SigSt.iterate defaultChunkSize (1e-6 +) 0)

mixTest6 :: SigSt.T Int16
mixTest6 =
   SigSt.map int16FromDouble $
   SigSt.take 441000 $
--   SigSt.append
   SigSt.mix
--   SigSt.mixSize defaultChunkSize
      (SigS.toStorableSignal defaultChunkSize $ SigS.iterate ((1-1e-6)*) 0.5)
      (SigS.toStorableSignal defaultChunkSize $ SigS.iterate (1e-6 +) 0)


stateTest0 :: SigSt.T Int16
stateTest0 =
   SigS.toStorableSignal defaultChunkSize $
   SigS.map int16FromDouble $
   SigS.take 441000 $
   SigS.zipWith (*) (SigS.iterate ((1-1e-4)*) 1) $
--   SigS.map (\t -> if even (floor t :: Int) then 1 else -1) $
   SigS.map sin $
   SigS.iterate ((2*pi/100)+) (0::Double)

stateTest1 :: SigSt.T Int16
stateTest1 =
   SigS.toStorableSignal defaultChunkSize $
   SigS.map int16FromDouble $
   SigS.take 100000 $
   SigS.zipWith Dist.sine (SigS.iterate ((1-0.3e-4)*) 1) $
   SigS.map (Wave.apply Wave.sine) $
   SigS.iterate (Phase.increment 0.01) zeroPhase

stateTest2 :: SigSt.T Int16
stateTest2 =
   SigS.toStorableSignal defaultChunkSize $
   SigS.map int16FromDouble $
   SigS.take 100000 $
   SigS.map (Dist.logit 1) $
   SigS.map (Dist.sine 5) $
   SigS.zipWith (*) (SigS.iterate ((1-0.3e-4)*) 30) $
   SigS.map (Wave.apply Wave.sine) $
   SigS.iterate (Phase.increment 0.01) zeroPhase

stateOsciTest0 :: SigSt.T Int16
stateOsciTest0 =
   SigS.toStorableSignal defaultChunkSize $
   SigS.take 200000 $
   SigS.map int16FromCanonical $
   (OsciS.static Wave.saw zeroPhase 0.01 :: SigS.T Double)

stateOsciTest0a :: SigSt.T Int16
stateOsciTest0a =
   SigS.toStorableSignal defaultChunkSize $
   SigS.take 200000 $
   SigS.map int16FromDouble $
   OsciS.static Wave.saw zeroPhase 0.01

stateOsciTest0fa :: SigSt.T Int16
stateOsciTest0fa =
   SigS.toStorableSignal defaultChunkSize $
   SigS.take 200000 $
   SigS.map int16FromDouble $
--   FiltNRS.envelope
--      (CtrlS.exponential2 50000 1)
   SigS.map (0.5*) $
      (SigS.mix
         (SigS.mix
            (OsciS.static Wave.saw (Phase.fromRepresentative 0.1) 0.01001)
            (OsciS.static Wave.saw (Phase.fromRepresentative 0.7) 0.00998))
         (SigS.mix
            (OsciS.static Wave.saw (Phase.fromRepresentative 0.2) 0.01005)
            (OsciS.static Wave.saw (Phase.fromRepresentative 0.4) 0.00996)))

{-# INLINE chord #-}
chord :: SigS.T Double
chord =
   let freq = 0.005
       {-# INLINE tone #-}
       tone f =
          SigS.mix
             (SigS.mix
                (OsciS.static Wave.saw zeroPhase (f*1.001))
                (OsciS.static Wave.saw zeroPhase (f*0.998)))
             (SigS.mix
                (OsciS.static Wave.saw zeroPhase (f*1.005))
                (OsciS.static Wave.saw zeroPhase (f*0.996)))
   in  tone (freq*1.00) `SigS.mix`
       tone (freq*1.25) `SigS.mix`
       tone (freq*1.50)

stateOsciTestChord :: SigSt.T Int16
stateOsciTestChord =
   SigS.toStorableSignal defaultChunkSize $
   SigS.take 200000 $
   SigS.map int16FromDouble $
   SigS.map (0.2*) $
   chord

stateFilterTest :: SigSt.T Int16
stateFilterTest =
   SigS.toStorableSignal defaultChunkSize $
   SigS.take 200000 $
   SigS.map int16FromDouble $
   SigS.map (0.05*) $
   SigS.map UniFilter.lowpass $
   SigS.modifyModulated
      UniFilter.modifier
      (SigS.map UniFilter.parameter $
       SigS.zipWith FiltR.Pole
          (SigS.repeat (5::Double))
          (SigS.map (\f -> 0.02*3 ^? f) $
           OsciS.static Wave.fastSine2 (Phase.fromRepresentative 0.75) 0.000005)) $
   chord

stateAppendTest0 :: SigSt.T Int16
stateAppendTest0 =
   SigS.toStorableSignal defaultChunkSize $
   SigS.map int16FromDouble $
      let tone f =
             SigS.take 50000 $
             SigS.map (Wave.apply Wave.saw) $
             SigS.iterate (Phase.increment f) zeroPhase
      in  tone 0.010 `SigS.append`
          tone 0.015 `SigS.append`
          tone 0.020

stateAppendTest1 :: SigSt.T Int16
stateAppendTest1 =
   SigS.toStorableSignal defaultChunkSize $
   SigS.map int16FromDouble $
      let tone f =
             SigS.take 50000 $
             SigS.map (Wave.apply Wave.saw) $
             SigS.iterate (Phase.increment f) zeroPhase
      in  tone 0.010 `SigS.appendStored`
          tone 0.015 `SigS.appendStored`
          tone 0.020

stateAppendTest2 :: SigSt.T Int16
stateAppendTest2 =
   SigSt.map int16FromDouble $
      let tone f =
             SigS.toStorableSignal defaultChunkSize $
             SigS.take 50000 $
             SigS.map (Wave.apply Wave.saw) $
             SigS.iterate (Phase.increment f) zeroPhase
      in  tone 0.010 `SigSt.append`
          tone 0.015 `SigSt.append`
          tone 0.020

stateConcatTest0 :: SigSt.T Int16
stateConcatTest0 =
   SigS.toStorableSignal defaultChunkSize $
   SigS.map int16FromDouble $
      let tone f =
             SigS.take 50000 $
             SigS.map (Wave.apply Wave.saw) $
             SigS.iterate (Phase.increment f) zeroPhase
      in  SigS.concat $
             tone 0.010 :
             tone 0.015 :
             tone 0.020 :
             []

stateConcatTest1 :: SigSt.T Int16
stateConcatTest1 =
   SigS.toStorableSignal defaultChunkSize $
   SigS.map int16FromDouble $
      let tone f =
             SigS.take 50000 $
             SigS.map (Wave.apply Wave.saw) $
             SigS.iterate (Phase.increment f) zeroPhase
      in  SigS.concatStored $
             tone 0.010 :
             tone 0.015 :
             tone 0.020 :
             []

{-# NOINLINE storablePercTone #-}
storablePercTone :: Double -> SigSt.T Double
storablePercTone f =
   SigS.toStorableSignal defaultChunkSize $
   SigS.take 22000 $
   FiltNRS.envelope (CtrlS.exponential2 10000 1) $
--   OsciS.static Wave.saw zero f
   SigS.map (0.5*) $
   SigS.mix
      (OsciS.static Wave.saw zeroPhase (f*0.999))
      (OsciS.static Wave.saw zeroPhase (f*1.001))

storableConcatTest :: SigSt.T Int16
storableConcatTest =
   SigSt.map int16FromDouble $
   SigSt.concat $
   take 13 $
   map storablePercTone $
   iterate (* 2^?(1/12)) 0.005

storableArrangeTest :: SigSt.T Int16
storableArrangeTest =
   SigSt.map int16FromDouble $
   SigSt.map (0.5*) $
   CutSt.arrange defaultChunkSize $
   foldr (EventList.cons 4000) (EventList.empty) $
--   foldr (EventList.cons 4000) (EventList.pause 0) $
   take 25 $
   map storablePercTone $
   iterate (* 2^?(1/12)) 0.005

-- This is much faster than Arrange.
-- about 2 seconds
storableConcatInfTest :: SigSt.T Int16
storableConcatInfTest =
   SigSt.map int16FromDouble $
   SigSt.map (0.5*) $
   SigSt.concat $
   take 110 $
   map storablePercTone $
   iterate (* 2^?(1/12)) 0.002

-- about 5-6 seconds
storableArrangeInfTest :: SigSt.T Int16
storableArrangeInfTest =
   SigSt.map int16FromDouble $
   SigSt.map (0.5*) $
   SigSt.take 440000 $
   CutSt.arrange defaultChunkSize $
   foldr (EventList.cons 4000) (EventList.empty) $
   map storablePercTone $
   iterate (* 2^?(1/12)) 0.002



statePercTone :: Double -> SigS.T Double
statePercTone f =
   SigS.take 22000 $
   FiltNRS.envelope (CtrlS.exponential2 10000 1) $
--   OsciS.static Wave.saw zeroPhase f
   SigS.map (0.5*) $
   SigS.mix
      (OsciS.static Wave.saw zeroPhase (f*0.999))
      (OsciS.static Wave.saw zeroPhase (f*1.001))

stateArrangeInfTest :: SigSt.T Int16
stateArrangeInfTest =
   SigS.toStorableSignal defaultChunkSize $
   SigS.map int16FromDouble $
   SigS.map (0.5*) $
   SigS.take 440000 $
   CutS.arrange $
   foldr (EventList.cons 4000) (EventList.empty) $
   map statePercTone $
   iterate (* 2^?(1/12)) 0.002


{-# INLINE fastSine2 #-}
fastSine2 :: (Ord a, Ring.C a, Num a) => a -> a
fastSine2 x =
   if 2*x<1
     then 1 - NP.sqr (4*x-1)
     else NP.sqr (4*x-3) - 1

fastSineTest :: SigSt.T Int16
fastSineTest =
   SigS.toStorableSignal defaultChunkSize $
   SigS.map int16FromDouble $
   SigS.take 440000 $
--   OsciS.static Wave.sine zeroPhase $
--   OsciS.static Wave.fastSine4 zeroPhase $
   OsciS.static Wave.fastSine2 zeroPhase $
--   OsciS.static fastSine2 zeroPhase $
   0.01


{-# INLINE stateBubbles #-}
stateBubbles :: SigS.T Double
stateBubbles =
   OsciS.freqMod Wave.sine zeroPhase $
   SigS.map (\p -> 0.01 * exp(-p)) $
   SigS.mix
      (SigS.map (1.5*) $ OsciS.static Wave.saw zeroPhase 0.00001)
      (SigS.map (0.5*) $ OsciS.static Wave.saw zeroPhase 0.0002)

stateBubblesTest :: SigSt.T Int16
stateBubblesTest =
   SigS.toStorableSignal defaultChunkSize $
   SigS.map int16FromDouble $
   SigS.take 440000 $
   stateBubbles

storableCombTest :: SigSt.T Int16
storableCombTest =
   SigSt.map int16FromDouble $
   SigSt.delayLoopOverlap 11000 (SigSt.map (0.5*)) $
   SigS.toStorableSignal defaultChunkSize $
--   SigS.append (statePercTone 0.01) (SigS.replicate 40000 0)
   SigS.take 440000 $
   SigS.map (0.5*) $
   stateBubbles


storableTakeTest :: SigSt.T Int16
storableTakeTest =
   SigSt.take 440000 $
   SigS.toStorableSignal defaultChunkSize $
   SigS.map int16FromDouble $
   OsciS.static Wave.saw zeroPhase 0.01


stateNoiseTest :: SigSt.T Int16
stateNoiseTest =
   SigS.toStorableSignal defaultChunkSize $
   SigS.take 440000 $
   SigS.map int16FromDouble $
   SigS.map (0.3*) $
   SigS.map UniFilter.lowpass $
   SigS.modifyModulated
      UniFilter.modifier
      (SigS.map UniFilter.parameter $
       SigS.zipWith FiltR.Pole
          (SigS.repeat (10::Double))
          (SigS.map (\f -> 0.02*3 ^? f) $
           OsciS.static Wave.sine (Phase.fromRepresentative 0.75) 0.000005)) $
--   NoiseS.whiteGen (mkStdGen 1)
   NoiseS.whiteGen (Knuth.cons 1)


stateADSRTest :: SigSt.T Int16
stateADSRTest =
   SigS.toStorableSignal defaultChunkSize $
   SigS.map int16FromDouble $
   FiltNRS.envelope
      (CtrlS.piecewise
          (0    |#  (5000, CtrlS.cubicPiece 0.001 0) #|-
           0.5 -|# (40000, CtrlS.stepPiece) #|-
           0.5 -|#  (8000, CtrlS.exponentialPiece 0) #|
           0.01)) $
   OsciS.static Wave.saw zeroPhase 0.01


phaserTest :: SigSt.T Int16
phaserTest =
   SigSt.take 440000 $
   SigSt.map int16FromDouble $
   SigSt.map (0.5*) $
   (\noise ->
       SigSt.mix
          noise
          (DelayG.modulated InterpolationM.linear (-500)
             (SigS.toStorableSignal defaultChunkSize
                (SigS.map
                   (\x -> 100*(2+x) :: Double)
                   (OsciS.static Wave.sine zeroPhase 0.00001)))
             noise)) $
   SigS.toStorableSignal defaultChunkSize $
--   OsciS.static Wave.saw zeroPhase 0.01
   NoiseS.whiteGen (Knuth.cons 1)


phaserTest0 :: SigSt.T Int16
phaserTest0 =
   SigSt.take 440000 $
   SigSt.map int16FromDouble $
   DelayG.modulated InterpolationM.constant (-500)
      (SigSt.repeat defaultChunkSize (142::Double)) $
   SigSt.repeat defaultChunkSize (23::Double)


phaserTest1 :: SigSt.T Int16
phaserTest1 =
   SigSt.take 440000 $
   SigSt.map int16FromDouble $
--   SigG.mapTails (maybe 0 fst . SigSt.viewL . SigSt.drop 100) $
{-
   (\noise ->
       SigSt.mix
          (SigG.zipWithTails
             (\n -> maybe 0 fst . SigSt.viewL . SigSt.drop (div n 50))
             (SigG.iterate succ 0) noise)
          noise) $
-}
{-
   SigG.zipWithTails
      (\n -> maybe 0 fst . SigSt.viewL . SigSt.drop (div n 50))
      (SigG.iterate succ 0) $
-}
   (\noise -> SigSt.mix noise noise) $
   SigS.toStorableSignal defaultChunkSize $
   NoiseS.whiteGen (Knuth.cons 1)



main :: IO ()
main =
   do SigSt.writeFile "storable-fusion.sw" phaserTest
      -- SigSt.writeFile "storable-fusion.sw" stateFilterTest
      -- SigSt.writeFile "storable-fusion.sw" osciTest4
      -- SigSt.writeFile "storable-fusion.sw" mapTest5


{-
show highlighted core output

ghc-core -o dist/build/fusiontest/fusiontest -O -Wall -fexcess-precision -package synthesizer speedtest/FusionTest.hs

use installed synthesizer package

ghc -o dist/build/fusiontest/fusiontest -O -Wall -fexcess-precision -ddump-simpl-stats -package synthesizer speedtest/FusionTest.hs

ghc -o dist/build/fusiontest/fusiontest -O -Wall -fexcess-precision -ddump-simpl-stats -ddump-simpl -package synthesizer speedtest/FusionTest.hs >dist/build/fusiontest/FusionTest.log


with make and no explicit package specification:

ghc -Idist/build -o dist/build/fusiontest/fusiontest --make -Wall -O2 -fexcess-precision -ddump-simpl-stats -i -idist/build/autogen -isrc -odir dist/build/fusiontest/fusiontest-tmp -hidir dist/build/fusiontest/fusiontest-tmp src/FusionTest.hs

with make and explicit package specification:

ghc -Idist/build -o dist/build/fusiontest/fusiontest --make -Wall -O2 -fexcess-precision -hide-all-packages -i -idist/build/autogen -isrc -odir dist/build/fusiontest/fusiontest-tmp -hidir dist/build/fusiontest/fusiontest-tmp -package base-1.0 -package mtl-1.0 -package non-negative-0.0.2 -package numeric-prelude-0.0.3 -package event-list-0.0.7 -package Haskore-0.0.2 -package HTam-0.0 -package numeric-quest-0.1 -package bytestring-0.9.0.5 -package binary-0.4.1 -package storablevector-0.1 -package UniqueLogicNP-0.0 -package QuickCheck-1.0 src/FusionTest.hs

without make and with detailed simplifier report:

ghc -Idist/build -o dist/build/fusiontest/fusiontest -Wall -O2 -fexcess-precision -ddump-simpl-stats -ddump-simpl-iterations -ddump-asm -i -idist/build/autogen -isrc -idist/build/fusiontest/fusiontest-tmp -odir dist/build/fusiontest/fusiontest-tmp -hidir dist/build/fusiontest/fusiontest-tmp -package base-1.0 -package mtl-1.0 -package non-negative-0.0.2 -package numeric-prelude-0.0.3 -package event-list-0.0.7 -package Haskore-0.0.2 -package HTam-0.0 -package numeric-quest-0.1 -package bytestring-0.9.0.5 -package binary-0.4.1 -package storablevector-0.1 -package UniqueLogicNP-0.0 -package QuickCheck-1.0 dist/build/HSsynthesizer*.o src/FusionTest.hs

ghc -Idist/build -o dist/build/fusiontest/fusiontest -Wall -O2 -fexcess-precision -ddump-simpl-stats -ddump-simpl-iterations -i -idist/build/autogen -isrc -idist/build/fusiontest/fusiontest-tmp -odir dist/build/fusiontest/fusiontest-tmp -hidir dist/build/fusiontest/fusiontest-tmp -package base-1.0 -package mtl-1.0 -package non-negative-0.0.2 -package numeric-prelude-0.0.3 -package event-list-0.0.7 -package Haskore-0.0.2 -package HTam-0.0 -package numeric-quest-0.1 -package bytestring-0.9.0.5 -package binary-0.4.1 -package storablevector-0.1 -package UniqueLogicNP-0.0 -package QuickCheck-1.0 dist/build/HSsynthesizer*.o src/FusionTest.hs >src/FusionTest.log

ghc-6.8.2 -Idist/build -o dist/build/fusiontest/fusiontest -Wall -O2 -fexcess-precision -ddump-simpl-stats -ddump-simpl-iterations -i -idist/build/autogen -isrc -idist/build/fusiontest/fusiontest-tmp -odir dist/build/fusiontest/fusiontest-tmp -hidir dist/build/fusiontest/fusiontest-tmp -package base -package mtl -package non-negative -package numeric-prelude -package event-list -package Haskore -package HTam -package numeric-quest -package bytestring -package binary -package storablevector -package UniqueLogicNP -package QuickCheck dist/build/HSsynthesizer*.o src/FusionTest.hs >src/FusionTest.log
-}