{-# OPTIONS_GHC -O #-} module Main (main) where import qualified Synthesizer.Storable.Signal as SigSt import qualified Synthesizer.Storable.Cut as CutSt import qualified Data.StorableVector.ST.Strict as SVST import qualified Data.StorableVector.Lazy as SVL import qualified Data.EventList.Relative.TimeBody as EventList -- import qualified Synthesizer.Generic.Signal2 as SigG2 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.Causal.Process as Causal import qualified Synthesizer.Causal.Cut as CutC import qualified Synthesizer.Causal.Displacement as DispC import qualified Synthesizer.Causal.Filter.NonRecursive as FiltNRC import qualified Synthesizer.Basic.Wave as Wave import qualified Synthesizer.Basic.Phase as Phase import qualified Algebra.RealField as RealField import qualified Algebra.Ring as Ring import qualified Algebra.Additive as Additive import Control.Monad.Trans.State (StateT(StateT), ) import Control.Monad.ST (runST, ) import qualified Sound.Frame.Stereo as Stereo import Sound.Frame.NumericPrelude.Stereo () import Control.Arrow ((<<<), (<<^), second, ) import Foreign.Storable (Storable, ) import NumericPrelude.Numeric import NumericPrelude.Base import Prelude () phase :: RealField.C a => a -> Phase.T a phase = Phase.fromRepresentative {-# INLINE osci0 #-} osci0 :: Float -> SigSt.T Float osci0 freq = SigS.toStorableSignal SigSt.defaultChunkSize $ SigS.take 10000000 $ OsciS.staticSaw zero freq {-# INLINE osci1 #-} osci1 :: Float -> SigSt.T Float osci1 freq = SigS.toStorableSignal SigSt.defaultChunkSize $ SigS.take 10000000 $ FiltNRS.amplify 0.3 $ foldl1 SigS.mix $ zipWith (\ p f -> OsciS.staticSaw (phase p) (freq*f)) [0.0, 0.7, 0.1] [1.008, 1.003, 0.990] {-# INLINE osci1Flat #-} osci1Flat :: Float -> SigSt.T Float osci1Flat freq = let {-# INLINE osc #-} osc p f = OsciS.staticSaw (phase p) (freq*f) (p0,p1,p2) = (0.0, 0.7, 0.1) (f0,f1,f2) = (1.008, 1.003, 0.990) in SigS.toStorableSignal SigSt.defaultChunkSize $ SigS.take 10000000 $ FiltNRS.amplify 0.3 $ osc p0 f0 `SigS.mix` osc p1 f1 `SigS.mix` osc p2 f2 {-# INLINE osci1Causal #-} osci1Causal :: Float -> SigSt.T Float osci1Causal freq = let {-# INLINE osc #-} osc p f = OsciS.staticSaw (phase p) (freq*f) (p0,p1,p2) = (0.0, 0.7, 0.1) (f0,f1,f2) = (1.008, 1.003, 0.990) in SigS.toStorableSignal SigSt.defaultChunkSize $ (CutC.take 10000000 <<< FiltNRC.amplify 0.3 <<< DispC.mix <<< second DispC.mix) `Causal.applyFst` osc p0 f0 `Causal.applyFst` osc p1 f1 `Causal.apply` osc p2 f2 {-# INLINE osci1Join #-} osci1Join :: Float -> SigSt.T Float osci1Join freq = let {-# INLINE joinOsci #-} joinOsci p f = SigS.runViewL (OsciS.staticSaw (phase p) (freq*f)) (\next -> Causal.fromStateMaybe (\x -> fmap (x+) (StateT next))) (p0,p1,p2) = (0.0, 0.7, 0.1) (f0,f1,f2) = (1.008, 1.003, 0.990) in SigS.toStorableSignal SigSt.defaultChunkSize $ (CutC.take 10000000 <<< FiltNRC.amplify 0.3 <<< joinOsci p0 f0 <<< joinOsci p1 f1 <<< joinOsci p2 f2) `Causal.apply` SigS.repeat zero {-# INLINE osci1Simultaneous #-} osci1Simultaneous :: Float -> SigSt.T Float osci1Simultaneous freq = let {-# INLINE osc #-} osc p f = OsciS.staticSaw (phase p) (freq*f) (p0,p1,p2) = (0.0, 0.7, 0.1) (f0,f1,f2) = (1.008, 1.003, 0.990) {-# INLINE multOsc #-} multOsc = SigS.runViewL (osc p0 f0) (\next0 s0 -> SigS.runViewL (osc p1 f1) (\next1 s1 -> SigS.runViewL (osc p2 f2) (\next2 s2 -> SigS.generate (\(t0,t1,t2) -> do (x0,r0) <- next0 t0 (x1,r1) <- next1 t1 (x2,r2) <- next2 t2 return ((x0,x1,x2),(r0,r1,r2))) (s0,s1,s2)))) in SigS.toStorableSignal SigSt.defaultChunkSize $ (CutC.take 10000000 <<< FiltNRC.amplify 0.3 <<^ (\(y0,y1,y2) -> y0+y1+y2)) `Causal.apply` multOsc {-# INLINE osci2 #-} osci2 :: Float -> SigSt.T (Stereo.T Float) osci2 freq = let {-# INLINE channel #-} channel ps fs = FiltNRS.amplify 0.3 $ -- foldl1 (SigS.zipWith (+)) $ foldl1 SigS.mix $ zipWith (\ p f -> OsciS.staticSaw (phase p) (freq*f)) ps fs in SigS.toStorableSignal SigSt.defaultChunkSize $ SigS.take 10000000 $ SigS.zipWith Stereo.cons (channel [0.0, 0.7, 0.1] [1.008, 1.003, 0.990]) (channel [0.3, 0.4, 0.6] [0.992, 0.997, 1.010]) {-# INLINE osci2Flat #-} osci2Flat :: Float -> SigSt.T (Stereo.T Float) osci2Flat freq = let {-# INLINE osc #-} osc p f = -- OsciS.static Wave.saw (phase p) (freq*f) OsciS.staticSaw (phase p) (freq*f) {-# INLINE channel #-} channel (p0,p1,p2) (f0,f1,f2) = FiltNRS.amplify 0.3 $ osc p0 f0 `SigS.mix` osc p1 f1 `SigS.mix` osc p2 f2 in SigS.toStorableSignal SigSt.defaultChunkSize $ SigS.take 10000000 $ SigS.zipWith Stereo.cons (channel (0.0, 0.7, 0.1) (1.008, 1.003, 0.990)) (channel (0.3, 0.4, 0.6) (0.992, 0.997, 1.010)) {- {-# INLINE osci2Storable #-} osci2Storable :: Float -> SigSt.T (Stereo.T Float) osci2Storable freq = let osc p f = SigS.toStorableSignal SigSt.defaultChunkSize $ OsciS.staticSaw (phase p) (freq*f) channel (p0,p1,p2) (f0,f1,f2) = osc p0 f0 `SigSt.mix` osc p1 f1 `SigSt.mix` osc p2 f2 in SigSt.take 10000000 $ SigSt.zipWith (\l r -> (0.3::Float) *> Stereo.cons l r) (channel (0.0, 0.7, 0.1) (1.008, 1.003, 0.990)) (channel (0.3, 0.4, 0.6) (0.992, 0.997, 1.010)) -} {-# INLINE osci2Storable #-} osci2Storable :: Float -> SigSt.T (Stereo.T Float) osci2Storable freq = let channel ps fs = {-# SCC "channel" #-} foldl1 SigSt.mix $ zipWith (\ p f -> {-# SCC "Osci.staticSaw" #-} SigS.toStorableSignal SigSt.defaultChunkSize $ OsciS.staticSaw (phase p) (freq*f)) ps fs in {-# SCC "take" #-} SigSt.take 10000000 $ {-# SCC "zipWith" #-} SigSt.zipWith (\l r -> (0.3::Float) *> Stereo.cons l r) (channel [0.0, 0.7, 0.1] [1.008, 1.003, 0.990]) {- SigSt.map (\l -> Stereo.cons l l) -} (channel [0.3, 0.4, 0.6] [0.992, 0.997, 1.010]) {- With map: real 0m1.656s user 0m1.440s sys 0m0.208s With zip: real 0m3.073s user 0m2.792s sys 0m0.212s -} {- Mixing implemented by the basic mixing routine of 'CutSt.arrange'. -} {-# INLINE multiMixInf #-} multiMixInf :: (Additive.C y, Storable y) => SigSt.ChunkSize -> [SigSt.T y] -> SigSt.T y multiMixInf (SVL.ChunkSize sz) = let {-# INLINE go #-} go xs = let (prefixes, suffixes) = unzip $ map (SigSt.splitAt sz) xs in SVST.runSTVector (do v <- SVST.new sz zero mapM_ (CutSt.addToBuffer v 0) prefixes return v) : go suffixes in SigSt.fromChunks . go {-# INLINE multiMixInf2 #-} multiMixInf2 :: (Additive.C y, Storable y) => SigSt.ChunkSize -> [SigSt.T y] -> SigSt.T y multiMixInf2 (SVL.ChunkSize sz) = let {-# INLINE go #-} go xs = let (prefix, suffixes) = runST (do v <- SVST.new sz zero remainders <- mapM (CutSt.addToBuffer v 0) xs -- chunk <- SVST.freeze v chunk <- SVST.unsafeFreeze v return (chunk, map snd remainders)) in prefix : go suffixes in SigSt.fromChunks . go {-# INLINE osci2MultiMix #-} osci2MultiMix :: Float -> SigSt.T (Stereo.T Float) osci2MultiMix freq = let channel ps fs = multiMixInf SigSt.defaultChunkSize $ zipWith (\ p f -> {-# SCC "Osci.staticSaw" #-} SigS.toStorableSignal SigSt.defaultChunkSize $ OsciS.staticSaw (phase p) (freq*f)) ps fs in SigSt.take 10000000 $ SigSt.zipWith (\l r -> (0.3::Float) *> Stereo.cons l r) (channel [0.0, 0.7, 0.1] [1.008, 1.003, 0.990]) (channel [0.3, 0.4, 0.6] [0.992, 0.997, 1.010]) {- real 0m3.609s user 0m3.396s sys 0m0.208s -} {-# INLINE osci2Arrange #-} osci2Arrange :: Float -> SigSt.T (Stereo.T Float) osci2Arrange freq = let channel ps fs = CutSt.arrange SigSt.defaultChunkSize $ EventList.fromPairList $ map ((,) 0) $ zipWith (\ p f -> {-# SCC "Osci.staticSaw" #-} SigS.toStorableSignal SigSt.defaultChunkSize $ OsciS.staticSaw (phase p) (freq*f)) ps fs in SigSt.take 10000000 $ SigSt.zipWith (\l r -> (0.3::Float) *> Stereo.cons l r) (channel [0.0, 0.7, 0.1] [1.008, 1.003, 0.990]) (channel [0.3, 0.4, 0.6] [0.992, 0.997, 1.010]) main :: IO () main = do SigSt.writeFile "chorus.f32" (osci2Arrange 0.01) {- ghc -o dist/build/chorustest -odir dist/build -hidir dist/build -package synthesizer-core -O -fexcess-precision -fvia-C -optc-ffast-math -optc-O3 -ddump-simpl -ddump-simpl-stats speedtest/ChorusTest.hs >dist/build/ChorusTest.core With SigS.mix (after rewriting zipAppend using runViewL) $ time dist/build/chorustest real 0m5.797s user 0m5.544s sys 0m0.252s With SigS.zipWith (+) $ time dist/build/chorustest real 0m5.969s user 0m5.688s sys 0m0.260s osci1Causal needs about three times as the manually written function in storablevector:SpeedTestChorus. This is certainly due to staticSaw, that is not inlined. real 0m2.368s user 0m2.252s sys 0m0.116s After adding SPECIALISE INLINE pragma to staticSaw, the function osci1Flat reaches the speed of the manual implementation in storablevector, that uses one unfoldrN. It needs about 0.8s. -} {- ghc -o dist/build/chorustest -odir dist/build -hidir dist/build -package synthesizer-core -O -fexcess-precision -fvia-C -optc-ffast-math -optc-O3 -prof -auto-all speedtest/ChorusTest.hs $ time dist/build/chorustest +RTS -p -}