{-# 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 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 -}