module LambdaSound.Sound.ComputeSound where import Control.Monad (join) import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.HashTable.IO qualified as H import Data.Hashable import Data.Massiv.Array qualified as M import Data.Massiv.Array.Unsafe qualified as MU import Data.SomeStableName (SomeStableName, makeSomeStableName) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Marshal (copyBytes) import Foreign.Storable (Storable (..)) import GHC.Generics (Generic) import LambdaSound.Sound.Types makeWithIndexFunction :: (SamplingInfo -> Int -> a) -> ComputeSound a makeWithIndexFunction :: forall a. (SamplingInfo -> Ix1 -> a) -> ComputeSound a makeWithIndexFunction SamplingInfo -> Ix1 -> a f = (SamplingInfo -> Vector D a) -> ComputeSound a forall a. (SamplingInfo -> Vector D a) -> ComputeSound a makeDelayedResult ((SamplingInfo -> Vector D a) -> ComputeSound a) -> (SamplingInfo -> Vector D a) -> ComputeSound a forall a b. (a -> b) -> a -> b $ \SamplingInfo si -> let f' :: Ix1 -> a f' = SamplingInfo -> Ix1 -> a f SamplingInfo si in Comp -> Sz Ix1 -> (Ix1 -> a) -> Vector D a forall r ix e. Load r ix e => Comp -> Sz ix -> (ix -> e) -> Array r ix e M.makeArray Comp M.Seq (Ix1 -> Sz Ix1 M.Sz1 SamplingInfo si.samples) Ix1 -> a f' {-# INLINE makeWithIndexFunction #-} makeDelayedResult :: (SamplingInfo -> M.Vector M.D a) -> ComputeSound a makeDelayedResult :: forall a. (SamplingInfo -> Vector D a) -> ComputeSound a makeDelayedResult SamplingInfo -> Vector D a f = (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound _ -> do SomeStableName stableF <- (SamplingInfo -> Vector D a) -> IO SomeStableName forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName makeSomeStableName SamplingInfo -> Vector D a f (SoundResult a, ComputationInfo) -> IO (SoundResult a, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (IO (Vector D a) -> SoundResult a forall a. IO (Vector D a) -> SoundResult a DelayedResult (IO (Vector D a) -> SoundResult a) -> IO (Vector D a) -> SoundResult a forall a b. (a -> b) -> a -> b $ Vector D a -> IO (Vector D a) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Vector D a -> IO (Vector D a)) -> Vector D a -> IO (Vector D a) forall a b. (a -> b) -> a -> b $ SamplingInfo -> Vector D a f SamplingInfo si, SomeStableName -> ComputationInfo ComputationInfoMakeDelayedResult SomeStableName stableF) {-# INLINE makeDelayedResult #-} changeSamplingInfo :: (SamplingInfo -> SamplingInfo) -> ComputeSound a -> ComputeSound a changeSamplingInfo :: forall a. (SamplingInfo -> SamplingInfo) -> ComputeSound a -> ComputeSound a changeSamplingInfo SamplingInfo -> SamplingInfo changeSI (ComputeSound SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo) compute) = (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound memo -> do SomeStableName stableChangeSI <- (SamplingInfo -> SamplingInfo) -> IO SomeStableName forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName makeSomeStableName SamplingInfo -> SamplingInfo changeSI (SoundResult a result, ComputationInfo ci) <- SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo) compute (SamplingInfo -> SamplingInfo changeSI SamplingInfo si) MemoComputeSound memo (SoundResult a, ComputationInfo) -> IO (SoundResult a, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (SoundResult a result, SomeStableName -> ComputationInfo -> ComputationInfo ComputationInfoChangeSamplingInfo SomeStableName stableChangeSI ComputationInfo ci) {-# INLINE changeSamplingInfo #-} mapDelayedResult :: (SamplingInfo -> M.Vector M.D a -> M.Vector M.D b) -> ComputeSound a -> ComputeSound b mapDelayedResult :: forall a b. (SamplingInfo -> Vector D a -> Vector D b) -> ComputeSound a -> ComputeSound b mapDelayedResult SamplingInfo -> Vector D a -> Vector D b mapVector ComputeSound a cs = (SamplingInfo -> MemoComputeSound -> IO (SoundResult b, ComputationInfo)) -> ComputeSound b forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult b, ComputationInfo)) -> ComputeSound b) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult b, ComputationInfo)) -> ComputeSound b forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound memo -> do (IO (Vector D a) delayedVector, ComputationInfo ci) <- ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) forall a. ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) asDelayedResult ComputeSound a cs SamplingInfo si MemoComputeSound memo SomeStableName stableMapVector <- (SamplingInfo -> Vector D a -> Vector D b) -> IO SomeStableName forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName makeSomeStableName SamplingInfo -> Vector D a -> Vector D b mapVector let mapVector' :: Vector D a -> Vector D b mapVector' = SamplingInfo -> Vector D a -> Vector D b mapVector SamplingInfo si (SoundResult b, ComputationInfo) -> IO (SoundResult b, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (IO (Vector D b) -> SoundResult b forall a. IO (Vector D a) -> SoundResult a DelayedResult (IO (Vector D b) -> SoundResult b) -> IO (Vector D b) -> SoundResult b forall a b. (a -> b) -> a -> b $ (Vector D a -> Vector D b) -> IO (Vector D a) -> IO (Vector D b) forall a b. (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Vector D a -> Vector D b mapVector' IO (Vector D a) delayedVector, SomeStableName -> ComputationInfo -> ComputationInfo ComputationInfoMapDelayedResult SomeStableName stableMapVector ComputationInfo ci) {-# INLINE mapDelayedResult #-} withSamplingInfoCS :: (SamplingInfo -> ComputeSound a) -> ComputeSound a withSamplingInfoCS :: forall a. (SamplingInfo -> ComputeSound a) -> ComputeSound a withSamplingInfoCS SamplingInfo -> ComputeSound a f = (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound memo -> do SomeStableName stableF <- (SamplingInfo -> ComputeSound a) -> IO SomeStableName forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName makeSomeStableName SamplingInfo -> ComputeSound a f let (ComputeSound SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo) compute) = SamplingInfo -> ComputeSound a f SamplingInfo si (SoundResult a res, ComputationInfo _) <- SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo) compute SamplingInfo si MemoComputeSound memo (SoundResult a, ComputationInfo) -> IO (SoundResult a, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (SoundResult a res, SomeStableName -> ComputationInfo ComputationInfoWithSamplingInfo SomeStableName stableF) {-# INLINE withSamplingInfoCS #-} withSampledSoundPulseCS :: Duration -> ComputeSound Pulse -> (M.Vector M.S Pulse -> ComputeSound a) -> ComputeSound a withSampledSoundPulseCS :: forall a. Duration -> ComputeSound Pulse -> (Vector S Pulse -> ComputeSound a) -> ComputeSound a withSampledSoundPulseCS Duration duration ComputeSound Pulse cs Vector S Pulse -> ComputeSound a f = (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound memo -> do let sampleSI :: SamplingInfo sampleSI = Hz -> Duration -> SamplingInfo makeSamplingInfo SamplingInfo si.sampleRate Duration duration (MVector RealWorld S Pulse -> IO () writeSamples, ComputationInfo ci) <- ComputeSound Pulse -> SamplingInfo -> MemoComputeSound -> IO (MVector RealWorld S Pulse -> IO (), ComputationInfo) asWriteResult ComputeSound Pulse cs SamplingInfo sampleSI MemoComputeSound memo MVector RealWorld S Pulse dest <- Sz Ix1 -> IO (MArray (PrimState IO) S Ix1 Pulse) forall ix e (m :: * -> *). (Index ix, Storable e, PrimMonad m) => Sz ix -> m (MArray (PrimState m) S ix e) MU.unsafeMallocMArray (Ix1 -> Sz Ix1 M.Sz1 SamplingInfo sampleSI.samples) MVector RealWorld S Pulse -> IO () writeSamples MVector RealWorld S Pulse dest Vector S Pulse samples <- Comp -> MArray (PrimState IO) S Ix1 Pulse -> IO (Vector S Pulse) forall r e ix (m :: * -> *). (Manifest r e, Index ix, PrimMonad m) => Comp -> MArray (PrimState m) r ix e -> m (Array r ix e) forall ix (m :: * -> *). (Index ix, PrimMonad m) => Comp -> MArray (PrimState m) S ix Pulse -> m (Array S ix Pulse) MU.unsafeFreeze Comp M.Seq MVector RealWorld S Pulse MArray (PrimState IO) S Ix1 Pulse dest let (ComputeSound SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo) compute) = Vector S Pulse -> ComputeSound a f Vector S Pulse samples (SoundResult a res, ComputationInfo _) <- SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo) compute SamplingInfo si MemoComputeSound memo SomeStableName stableF <- (Vector S Pulse -> ComputeSound a) -> IO SomeStableName forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName makeSomeStableName Vector S Pulse -> ComputeSound a f (SoundResult a, ComputationInfo) -> IO (SoundResult a, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (SoundResult a res, SomeStableName -> ComputationInfo -> ComputationInfo ComputationInfoWithSampledSound SomeStableName stableF ComputationInfo ci) {-# INLINE withSampledSoundPulseCS #-} withSampledSoundCS :: Duration -> ComputeSound a -> (M.Vector M.D a -> ComputeSound b) -> ComputeSound b withSampledSoundCS :: forall a b. Duration -> ComputeSound a -> (Vector D a -> ComputeSound b) -> ComputeSound b withSampledSoundCS Duration duration ComputeSound a cs Vector D a -> ComputeSound b f = (SamplingInfo -> MemoComputeSound -> IO (SoundResult b, ComputationInfo)) -> ComputeSound b forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult b, ComputationInfo)) -> ComputeSound b) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult b, ComputationInfo)) -> ComputeSound b forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound memo -> do let sampleSI :: SamplingInfo sampleSI = Hz -> Duration -> SamplingInfo makeSamplingInfo SamplingInfo si.sampleRate Duration duration (IO (Vector D a) delayedVector, ComputationInfo ci) <- ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) forall a. ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) asDelayedResult ComputeSound a cs SamplingInfo sampleSI MemoComputeSound memo let nextCS :: IO (ComputeSound b) nextCS = Vector D a -> ComputeSound b f (Vector D a -> ComputeSound b) -> IO (Vector D a) -> IO (ComputeSound b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO (Vector D a) delayedVector SomeStableName stableF <- (Vector D a -> ComputeSound b) -> IO SomeStableName forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName makeSomeStableName Vector D a -> ComputeSound b f (SoundResult b, ComputationInfo) -> IO (SoundResult b, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ( IO (Vector D b) -> SoundResult b forall a. IO (Vector D a) -> SoundResult a DelayedResult (IO (Vector D b) -> SoundResult b) -> IO (Vector D b) -> SoundResult b forall a b. (a -> b) -> a -> b $ do (IO (Vector D b) finalDelayedVector, ComputationInfo _) <- IO (IO (IO (Vector D b), ComputationInfo)) -> IO (IO (Vector D b), ComputationInfo) forall (m :: * -> *) a. Monad m => m (m a) -> m a join (IO (IO (IO (Vector D b), ComputationInfo)) -> IO (IO (Vector D b), ComputationInfo)) -> IO (IO (IO (Vector D b), ComputationInfo)) -> IO (IO (Vector D b), ComputationInfo) forall a b. (a -> b) -> a -> b $ ComputeSound b -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D b), ComputationInfo) forall a. ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) asDelayedResult (ComputeSound b -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D b), ComputationInfo)) -> IO (ComputeSound b) -> IO (SamplingInfo -> MemoComputeSound -> IO (IO (Vector D b), ComputationInfo)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO (ComputeSound b) nextCS IO (SamplingInfo -> MemoComputeSound -> IO (IO (Vector D b), ComputationInfo)) -> IO SamplingInfo -> IO (MemoComputeSound -> IO (IO (Vector D b), ComputationInfo)) forall a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> SamplingInfo -> IO SamplingInfo forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure SamplingInfo si IO (MemoComputeSound -> IO (IO (Vector D b), ComputationInfo)) -> IO MemoComputeSound -> IO (IO (IO (Vector D b), ComputationInfo)) forall a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> MemoComputeSound -> IO MemoComputeSound forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure MemoComputeSound memo IO (Vector D b) finalDelayedVector, SomeStableName -> ComputationInfo -> ComputationInfo ComputationInfoWithSampledSound SomeStableName stableF ComputationInfo ci ) {-# INLINE withSampledSoundCS #-} mergeDelayedResult :: (SamplingInfo -> M.Vector M.D a -> M.Vector M.D b -> M.Vector M.D c) -> ComputeSound a -> ComputeSound b -> ComputeSound c mergeDelayedResult :: forall a b c. (SamplingInfo -> Vector D a -> Vector D b -> Vector D c) -> ComputeSound a -> ComputeSound b -> ComputeSound c mergeDelayedResult SamplingInfo -> Vector D a -> Vector D b -> Vector D c merge ComputeSound a cs1 ComputeSound b cs2 = (SamplingInfo -> MemoComputeSound -> IO (SoundResult c, ComputationInfo)) -> ComputeSound c forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult c, ComputationInfo)) -> ComputeSound c) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult c, ComputationInfo)) -> ComputeSound c forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound memo -> do SomeStableName stableMerge <- (SamplingInfo -> Vector D a -> Vector D b -> Vector D c) -> IO SomeStableName forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName makeSomeStableName SamplingInfo -> Vector D a -> Vector D b -> Vector D c merge (IO (Vector D a) delayedResult1, ComputationInfo ci1) <- ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) forall a. ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) asDelayedResult ComputeSound a cs1 SamplingInfo si MemoComputeSound memo (IO (Vector D b) delayedResult2, ComputationInfo ci2) <- ComputeSound b -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D b), ComputationInfo) forall a. ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) asDelayedResult ComputeSound b cs2 SamplingInfo si MemoComputeSound memo let merge' :: Vector D a -> Vector D b -> Vector D c merge' = SamplingInfo -> Vector D a -> Vector D b -> Vector D c merge SamplingInfo si (SoundResult c, ComputationInfo) -> IO (SoundResult c, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (IO (Vector D c) -> SoundResult c forall a. IO (Vector D a) -> SoundResult a DelayedResult (IO (Vector D c) -> SoundResult c) -> IO (Vector D c) -> SoundResult c forall a b. (a -> b) -> a -> b $ Vector D a -> Vector D b -> Vector D c merge' (Vector D a -> Vector D b -> Vector D c) -> IO (Vector D a) -> IO (Vector D b -> Vector D c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO (Vector D a) delayedResult1 IO (Vector D b -> Vector D c) -> IO (Vector D b) -> IO (Vector D c) forall a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> IO (Vector D b) delayedResult2, SomeStableName -> ComputationInfo -> ComputationInfo -> ComputationInfo ComputationInfoMergeDelayedResult SomeStableName stableMerge ComputationInfo ci1 ComputationInfo ci2) {-# INLINE mergeDelayedResult #-} computeSequentially :: Percentage -> ComputeSound Pulse -> ComputeSound Pulse -> ComputeSound Pulse computeSequentially :: Percentage -> ComputeSound Pulse -> ComputeSound Pulse -> ComputeSound Pulse computeSequentially Percentage factor ComputeSound Pulse c1 ComputeSound Pulse c2 = (SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)) -> ComputeSound Pulse forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)) -> ComputeSound Pulse) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)) -> ComputeSound Pulse forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound memo -> do let splitIndex :: Ix1 splitIndex = Percentage -> Ix1 forall b. Integral b => Percentage -> b forall a b. (RealFrac a, Integral b) => a -> b round (Percentage -> Ix1) -> Percentage -> Ix1 forall a b. (a -> b) -> a -> b $ Percentage factor Percentage -> Percentage -> Percentage forall a. Num a => a -> a -> a * Ix1 -> Percentage forall a b. (Integral a, Num b) => a -> b fromIntegral SamplingInfo si.samples (MVector RealWorld S Pulse -> IO () writeResult1, ComputationInfo ci1) <- ComputeSound Pulse -> SamplingInfo -> MemoComputeSound -> IO (MVector RealWorld S Pulse -> IO (), ComputationInfo) asWriteResult ComputeSound Pulse c1 SamplingInfo si {samples = splitIndex} MemoComputeSound memo (MVector RealWorld S Pulse -> IO () writeResult2, ComputationInfo ci2) <- ComputeSound Pulse -> SamplingInfo -> MemoComputeSound -> IO (MVector RealWorld S Pulse -> IO (), ComputationInfo) asWriteResult ComputeSound Pulse c2 SamplingInfo si {samples = si.samples - splitIndex} MemoComputeSound memo (SoundResult Pulse, ComputationInfo) -> IO (SoundResult Pulse, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ( (MVector RealWorld S Pulse -> IO ()) -> SoundResult Pulse WriteResult ((MVector RealWorld S Pulse -> IO ()) -> SoundResult Pulse) -> (MVector RealWorld S Pulse -> IO ()) -> SoundResult Pulse forall a b. (a -> b) -> a -> b $ \MVector RealWorld S Pulse dest -> do MVector RealWorld S Pulse -> IO () writeResult1 (MVector RealWorld S Pulse -> IO ()) -> MVector RealWorld S Pulse -> IO () forall a b. (a -> b) -> a -> b $ Ix1 -> Sz Ix1 -> MVector RealWorld S Pulse -> MVector RealWorld S Pulse forall ix s. Index ix => Ix1 -> Sz Ix1 -> MArray s S ix Pulse -> MVector s S Pulse forall r e ix s. (Manifest r e, Index ix) => Ix1 -> Sz Ix1 -> MArray s r ix e -> MVector s r e MU.unsafeLinearSliceMArray Ix1 0 (Ix1 -> Sz Ix1 M.Sz1 Ix1 splitIndex) MVector RealWorld S Pulse dest MVector RealWorld S Pulse -> IO () writeResult2 (MVector RealWorld S Pulse -> IO ()) -> MVector RealWorld S Pulse -> IO () forall a b. (a -> b) -> a -> b $ Ix1 -> Sz Ix1 -> MVector RealWorld S Pulse -> MVector RealWorld S Pulse forall ix s. Index ix => Ix1 -> Sz Ix1 -> MArray s S ix Pulse -> MVector s S Pulse forall r e ix s. (Manifest r e, Index ix) => Ix1 -> Sz Ix1 -> MArray s r ix e -> MVector s r e MU.unsafeLinearSliceMArray Ix1 splitIndex (Ix1 -> Sz Ix1 M.Sz1 (Ix1 -> Sz Ix1) -> Ix1 -> Sz Ix1 forall a b. (a -> b) -> a -> b $ SamplingInfo si.samples Ix1 -> Ix1 -> Ix1 forall a. Num a => a -> a -> a - Ix1 splitIndex) MVector RealWorld S Pulse dest, Percentage -> ComputationInfo -> ComputationInfo -> ComputationInfo ComputationInfoSequentially Percentage factor ComputationInfo ci1 ComputationInfo ci2 ) {-# INLINE computeSequentially #-} computeParallel :: ComputeSound Pulse -> Percentage -> ComputeSound Pulse -> ComputeSound Pulse computeParallel :: ComputeSound Pulse -> Percentage -> ComputeSound Pulse -> ComputeSound Pulse computeParallel ComputeSound Pulse c1 Percentage factor ComputeSound Pulse c2 = (SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)) -> ComputeSound Pulse forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)) -> ComputeSound Pulse) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)) -> ComputeSound Pulse forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound memo -> do let c2N :: Ix1 c2N = Percentage -> Ix1 forall b. Integral b => Percentage -> b forall a b. (RealFrac a, Integral b) => a -> b round (Percentage -> Ix1) -> Percentage -> Ix1 forall a b. (a -> b) -> a -> b $ Percentage factor Percentage -> Percentage -> Percentage forall a. Num a => a -> a -> a * Ix1 -> Percentage forall a b. (Integral a, Num b) => a -> b fromIntegral SamplingInfo si.samples (IO (Vector D Pulse) delayedResult1, ComputationInfo p1) <- ComputeSound Pulse -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D Pulse), ComputationInfo) forall a. ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) asDelayedResult ComputeSound Pulse c1 SamplingInfo si MemoComputeSound memo (IO (Vector D Pulse) delayedResult2, ComputationInfo p2) <- ComputeSound Pulse -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D Pulse), ComputationInfo) forall a. ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) asDelayedResult ComputeSound Pulse c2 SamplingInfo si {samples = c2N} MemoComputeSound memo (SoundResult Pulse, ComputationInfo) -> IO (SoundResult Pulse, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ( if SamplingInfo si.samples Ix1 -> Ix1 -> Bool forall a. Eq a => a -> a -> Bool == Ix1 c2N then IO (Vector D Pulse) -> SoundResult Pulse forall a. IO (Vector D a) -> SoundResult a DelayedResult (IO (Vector D Pulse) -> SoundResult Pulse) -> IO (Vector D Pulse) -> SoundResult Pulse forall a b. (a -> b) -> a -> b $ (Pulse -> Pulse -> Pulse) -> Vector D Pulse -> Vector D Pulse -> Vector D Pulse forall ix r1 e1 r2 e2 e. (Index ix, Source r1 e1, Source r2 e2) => (e1 -> e2 -> e) -> Array r1 ix e1 -> Array r2 ix e2 -> Array D ix e M.zipWith Pulse -> Pulse -> Pulse forall a. Num a => a -> a -> a (+) (Vector D Pulse -> Vector D Pulse -> Vector D Pulse) -> IO (Vector D Pulse) -> IO (Vector D Pulse -> Vector D Pulse) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO (Vector D Pulse) delayedResult1 IO (Vector D Pulse -> Vector D Pulse) -> IO (Vector D Pulse) -> IO (Vector D Pulse) forall a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> IO (Vector D Pulse) delayedResult2 else IO (Vector D Pulse) -> SoundResult Pulse forall a. IO (Vector D a) -> SoundResult a DelayedResult (IO (Vector D Pulse) -> SoundResult Pulse) -> IO (Vector D Pulse) -> SoundResult Pulse forall a b. (a -> b) -> a -> b $ do Vector D Pulse dR1 <- IO (Vector D Pulse) delayedResult1 Vector D Pulse dR2 <- IO (Vector D Pulse) delayedResult2 Vector D Pulse -> IO (Vector D Pulse) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Vector D Pulse -> IO (Vector D Pulse)) -> Vector D Pulse -> IO (Vector D Pulse) forall a b. (a -> b) -> a -> b $ (Ix1 -> Pulse -> Pulse) -> Vector D Pulse -> Vector D Pulse forall r ix e a. (Index ix, Source r e) => (ix -> e -> a) -> Array r ix e -> Array D ix a M.imap (\Ix1 index -> Pulse -> Pulse -> Pulse forall a. Num a => a -> a -> a (+) (Pulse -> Pulse -> Pulse) -> Pulse -> Pulse -> Pulse forall a b. (a -> b) -> a -> b $ if Ix1 index Ix1 -> Ix1 -> Bool forall a. Ord a => a -> a -> Bool < Ix1 c2N then Vector D Pulse -> Ix1 -> Pulse forall ix. Index ix => Array D ix Pulse -> ix -> Pulse forall r e ix. (Source r e, Index ix) => Array r ix e -> ix -> e MU.unsafeIndex Vector D Pulse dR2 Ix1 index else Pulse 0) Vector D Pulse dR1, Percentage -> ComputationInfo -> ComputationInfo -> ComputationInfo ComputationInfoParallel Percentage factor ComputationInfo p1 ComputationInfo p2 ) {-# INLINE computeParallel #-} mapComputeSound :: (a -> b) -> ComputeSound a -> ComputeSound b mapComputeSound :: forall a b. (a -> b) -> ComputeSound a -> ComputeSound b mapComputeSound a -> b f ComputeSound a cs = (SamplingInfo -> MemoComputeSound -> IO (SoundResult b, ComputationInfo)) -> ComputeSound b forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult b, ComputationInfo)) -> ComputeSound b) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult b, ComputationInfo)) -> ComputeSound b forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound memo -> do SomeStableName stableF <- (a -> b) -> IO SomeStableName forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName makeSomeStableName a -> b f (IO (Vector D a) result, ComputationInfo ci) <- ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) forall a. ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) asDelayedResult ComputeSound a cs SamplingInfo si MemoComputeSound memo (SoundResult b, ComputationInfo) -> IO (SoundResult b, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (IO (Vector D b) -> SoundResult b forall a. IO (Vector D a) -> SoundResult a DelayedResult (IO (Vector D b) -> SoundResult b) -> IO (Vector D b) -> SoundResult b forall a b. (a -> b) -> a -> b $ (a -> b) -> Vector D a -> Vector D b forall ix r e' e. (Index ix, Source r e') => (e' -> e) -> Array r ix e' -> Array D ix e M.map a -> b f (Vector D a -> Vector D b) -> IO (Vector D a) -> IO (Vector D b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO (Vector D a) result, SomeStableName -> ComputationInfo -> ComputationInfo ComputationInfoMap SomeStableName stableF ComputationInfo ci) {-# INLINE mapComputeSound #-} asDelayedResult :: ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (M.Vector M.D a), ComputationInfo) asDelayedResult :: forall a. ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) asDelayedResult (ComputeSound SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo) compute) SamplingInfo si MemoComputeSound memo = do (SoundResult a result, ComputationInfo ci) <- SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo) compute SamplingInfo si MemoComputeSound memo case SoundResult a result of DelayedResult IO (Vector D a) vector -> (IO (Vector D a), ComputationInfo) -> IO (IO (Vector D a), ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (IO (Vector D a) vector, ComputationInfo ci) WriteResult MVector RealWorld S Pulse -> IO () writeResult -> (IO (Vector D a), ComputationInfo) -> IO (IO (Vector D a), ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ( do MVector RealWorld S Pulse marray <- Sz Ix1 -> IO (MArray (PrimState IO) S Ix1 Pulse) forall ix e (m :: * -> *). (Index ix, Storable e, PrimMonad m) => Sz ix -> m (MArray (PrimState m) S ix e) MU.unsafeMallocMArray (Ix1 -> Sz Ix1 M.Sz1 SamplingInfo si.samples) MVector RealWorld S Pulse -> IO () writeResult MVector RealWorld S Pulse marray Vector S Pulse array <- Comp -> MArray (PrimState IO) S Ix1 Pulse -> IO (Vector S Pulse) forall r e ix (m :: * -> *). (Manifest r e, Index ix, PrimMonad m) => Comp -> MArray (PrimState m) r ix e -> m (Array r ix e) forall ix (m :: * -> *). (Index ix, PrimMonad m) => Comp -> MArray (PrimState m) S ix Pulse -> m (Array S ix Pulse) MU.unsafeFreeze Comp M.Seq MVector RealWorld S Pulse MArray (PrimState IO) S Ix1 Pulse marray Vector D a -> IO (Vector D a) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Vector D a -> IO (Vector D a)) -> Vector D a -> IO (Vector D a) forall a b. (a -> b) -> a -> b $ Array S Ix1 a -> Vector D a forall ix r e. (Index ix, Source r e) => Array r ix e -> Array D ix e M.delay Array S Ix1 a Vector S Pulse array, ComputationInfo ci ) {-# INLINE asDelayedResult #-} asWriteResult :: ComputeSound Pulse -> SamplingInfo -> MemoComputeSound -> IO (M.MVector M.RealWorld M.S Pulse -> IO (), ComputationInfo) asWriteResult :: ComputeSound Pulse -> SamplingInfo -> MemoComputeSound -> IO (MVector RealWorld S Pulse -> IO (), ComputationInfo) asWriteResult (ComputeSound SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo) compute) SamplingInfo si MemoComputeSound memo = do (SoundResult Pulse result, ComputationInfo ci) <- SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo) compute SamplingInfo si MemoComputeSound memo case SoundResult Pulse result of WriteResult MVector RealWorld S Pulse -> IO () writeResult -> (MVector RealWorld S Pulse -> IO (), ComputationInfo) -> IO (MVector RealWorld S Pulse -> IO (), ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (MVector RealWorld S Pulse -> IO () writeResult, ComputationInfo ci) DelayedResult IO (Vector D Pulse) vector -> do let memoInfo :: MemoInfo memoInfo = SamplingInfo -> ComputationInfo -> MemoInfo MemoInfo SamplingInfo si ComputationInfo ci (MVector RealWorld S Pulse -> IO (), ComputationInfo) -> IO (MVector RealWorld S Pulse -> IO (), ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ( \MVector RealWorld S Pulse dest -> do Maybe (Vector S Pulse) memoized <- MemoComputeSound -> MemoInfo -> IO (Maybe (Vector S Pulse)) lookupMemoizedComputeSound MemoComputeSound memo MemoInfo memoInfo case Maybe (Vector S Pulse) memoized of Just Vector S Pulse memoSource -> do Vector S Pulse -> MVector RealWorld S Pulse -> IO () copyArrayIntoMArray Vector S Pulse memoSource MVector RealWorld S Pulse dest Maybe (Vector S Pulse) Nothing -> do IO (Vector D Pulse) vector IO (Vector D Pulse) -> (Vector D Pulse -> IO ()) -> IO () forall a b. IO a -> (a -> IO b) -> IO b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= MVector RealWorld S Pulse -> Vector D Pulse -> IO () forall r' ix' e r ix (m :: * -> *). (Load r' ix' e, Manifest r e, Index ix, MonadIO m) => MArray RealWorld r ix e -> Array r' ix' e -> m () M.computeInto MVector RealWorld S Pulse dest Vector S Pulse destArray <- Comp -> MArray (PrimState IO) S Ix1 Pulse -> IO (Vector S Pulse) forall r e ix (m :: * -> *). (Manifest r e, Index ix, PrimMonad m) => Comp -> MArray (PrimState m) r ix e -> m (Array r ix e) forall ix (m :: * -> *). (Index ix, PrimMonad m) => Comp -> MArray (PrimState m) S ix Pulse -> m (Array S ix Pulse) MU.unsafeFreeze Comp M.Seq MVector RealWorld S Pulse MArray (PrimState IO) S Ix1 Pulse dest MemoComputeSound -> MemoInfo -> Vector S Pulse -> IO () memoizeComputeSound MemoComputeSound memo MemoInfo memoInfo Vector S Pulse destArray, ComputationInfo ci ) {-# INLINE asWriteResult #-} zipWithCompute :: (a -> b -> c) -> ComputeSound a -> ComputeSound b -> ComputeSound c zipWithCompute :: forall a b c. (a -> b -> c) -> ComputeSound a -> ComputeSound b -> ComputeSound c zipWithCompute a -> b -> c f ComputeSound a cs1 ComputeSound b cs2 = (SamplingInfo -> MemoComputeSound -> IO (SoundResult c, ComputationInfo)) -> ComputeSound c forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult c, ComputationInfo)) -> ComputeSound c) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult c, ComputationInfo)) -> ComputeSound c forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound memo -> do (IO (Vector D a) dV1, ComputationInfo p1) <- ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) forall a. ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) asDelayedResult ComputeSound a cs1 SamplingInfo si MemoComputeSound memo (IO (Vector D b) dV2, ComputationInfo p2) <- ComputeSound b -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D b), ComputationInfo) forall a. ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) asDelayedResult ComputeSound b cs2 SamplingInfo si MemoComputeSound memo SomeStableName stableF <- (a -> b -> c) -> IO SomeStableName forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName makeSomeStableName a -> b -> c f (SoundResult c, ComputationInfo) -> IO (SoundResult c, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (IO (Vector D c) -> SoundResult c forall a. IO (Vector D a) -> SoundResult a DelayedResult (IO (Vector D c) -> SoundResult c) -> IO (Vector D c) -> SoundResult c forall a b. (a -> b) -> a -> b $ (a -> b -> c) -> Vector D a -> Vector D b -> Vector D c forall ix r1 e1 r2 e2 e. (Index ix, Source r1 e1, Source r2 e2) => (e1 -> e2 -> e) -> Array r1 ix e1 -> Array r2 ix e2 -> Array D ix e M.zipWith a -> b -> c f (Vector D a -> Vector D b -> Vector D c) -> IO (Vector D a) -> IO (Vector D b -> Vector D c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO (Vector D a) dV1 IO (Vector D b -> Vector D c) -> IO (Vector D b) -> IO (Vector D c) forall a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> IO (Vector D b) dV2, SomeStableName -> ComputationInfo -> ComputationInfo -> ComputationInfo ComputationInfoZip SomeStableName stableF ComputationInfo p1 ComputationInfo p2) {-# INLINE zipWithCompute #-} mapSoundFromMemory :: (M.Load r M.Ix1 Pulse) => (M.Vector M.S Pulse -> M.Vector r Pulse) -> ComputeSound Pulse -> ComputeSound Pulse mapSoundFromMemory :: forall r. Load r Ix1 Pulse => (Vector S Pulse -> Vector r Pulse) -> ComputeSound Pulse -> ComputeSound Pulse mapSoundFromMemory Vector S Pulse -> Vector r Pulse f ComputeSound Pulse cs = (SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)) -> ComputeSound Pulse forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)) -> ComputeSound Pulse) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)) -> ComputeSound Pulse forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound memo -> do (MVector RealWorld S Pulse -> IO () writeSamples, ComputationInfo ci) <- ComputeSound Pulse -> SamplingInfo -> MemoComputeSound -> IO (MVector RealWorld S Pulse -> IO (), ComputationInfo) asWriteResult ComputeSound Pulse cs SamplingInfo si MemoComputeSound memo SomeStableName stableF <- (Vector S Pulse -> Vector r Pulse) -> IO SomeStableName forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName makeSomeStableName Vector S Pulse -> Vector r Pulse f (SoundResult Pulse, ComputationInfo) -> IO (SoundResult Pulse, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ( (MVector RealWorld S Pulse -> IO ()) -> SoundResult Pulse WriteResult ((MVector RealWorld S Pulse -> IO ()) -> SoundResult Pulse) -> (MVector RealWorld S Pulse -> IO ()) -> SoundResult Pulse forall a b. (a -> b) -> a -> b $ \MVector RealWorld S Pulse dest -> do MVector RealWorld S Pulse wholeSoundMArray <- Sz Ix1 -> IO (MArray (PrimState IO) S Ix1 Pulse) forall ix e (m :: * -> *). (Index ix, Storable e, PrimMonad m) => Sz ix -> m (MArray (PrimState m) S ix e) MU.unsafeMallocMArray (Ix1 -> Sz Ix1 M.Sz1 SamplingInfo si.samples) MVector RealWorld S Pulse -> IO () writeSamples MVector RealWorld S Pulse wholeSoundMArray Vector S Pulse wholeSoundArray <- Comp -> MArray (PrimState IO) S Ix1 Pulse -> IO (Vector S Pulse) forall r e ix (m :: * -> *). (Manifest r e, Index ix, PrimMonad m) => Comp -> MArray (PrimState m) r ix e -> m (Array r ix e) forall ix (m :: * -> *). (Index ix, PrimMonad m) => Comp -> MArray (PrimState m) S ix Pulse -> m (Array S ix Pulse) MU.unsafeFreeze Comp M.Seq MVector RealWorld S Pulse MArray (PrimState IO) S Ix1 Pulse wholeSoundMArray MVector RealWorld S Pulse -> Vector r Pulse -> IO () forall r' ix' e r ix (m :: * -> *). (Load r' ix' e, Manifest r e, Index ix, MonadIO m) => MArray RealWorld r ix e -> Array r' ix' e -> m () M.computeInto MVector RealWorld S Pulse dest (Vector r Pulse -> IO ()) -> Vector r Pulse -> IO () forall a b. (a -> b) -> a -> b $ Vector S Pulse -> Vector r Pulse f Vector S Pulse wholeSoundArray, SomeStableName -> ComputationInfo -> ComputationInfo ComputationInfoMapMemory SomeStableName stableF ComputationInfo ci ) {-# INLINE mapSoundFromMemory #-} mapSoundFromMemoryIO :: (M.Vector M.S Pulse -> M.MVector M.RealWorld M.S Pulse -> IO ()) -> ComputeSound Pulse -> ComputeSound Pulse mapSoundFromMemoryIO :: (Vector S Pulse -> MVector RealWorld S Pulse -> IO ()) -> ComputeSound Pulse -> ComputeSound Pulse mapSoundFromMemoryIO Vector S Pulse -> MVector RealWorld S Pulse -> IO () f ComputeSound Pulse cs = (SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)) -> ComputeSound Pulse forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)) -> ComputeSound Pulse) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)) -> ComputeSound Pulse forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound memo -> do (MVector RealWorld S Pulse -> IO () writeSamples, ComputationInfo ci) <- ComputeSound Pulse -> SamplingInfo -> MemoComputeSound -> IO (MVector RealWorld S Pulse -> IO (), ComputationInfo) asWriteResult ComputeSound Pulse cs SamplingInfo si MemoComputeSound memo SomeStableName stableF <- (Vector S Pulse -> MVector RealWorld S Pulse -> IO ()) -> IO SomeStableName forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName makeSomeStableName Vector S Pulse -> MVector RealWorld S Pulse -> IO () f (SoundResult Pulse, ComputationInfo) -> IO (SoundResult Pulse, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ( (MVector RealWorld S Pulse -> IO ()) -> SoundResult Pulse WriteResult ((MVector RealWorld S Pulse -> IO ()) -> SoundResult Pulse) -> (MVector RealWorld S Pulse -> IO ()) -> SoundResult Pulse forall a b. (a -> b) -> a -> b $ \MVector RealWorld S Pulse dest -> do MVector RealWorld S Pulse wholeSoundMArray <- Sz Ix1 -> IO (MArray (PrimState IO) S Ix1 Pulse) forall ix e (m :: * -> *). (Index ix, Storable e, PrimMonad m) => Sz ix -> m (MArray (PrimState m) S ix e) MU.unsafeMallocMArray (Ix1 -> Sz Ix1 M.Sz1 SamplingInfo si.samples) MVector RealWorld S Pulse -> IO () writeSamples MVector RealWorld S Pulse wholeSoundMArray Vector S Pulse wholeSoundArray <- Comp -> MArray (PrimState IO) S Ix1 Pulse -> IO (Vector S Pulse) forall r e ix (m :: * -> *). (Manifest r e, Index ix, PrimMonad m) => Comp -> MArray (PrimState m) r ix e -> m (Array r ix e) forall ix (m :: * -> *). (Index ix, PrimMonad m) => Comp -> MArray (PrimState m) S ix Pulse -> m (Array S ix Pulse) MU.unsafeFreeze Comp M.Seq MVector RealWorld S Pulse MArray (PrimState IO) S Ix1 Pulse wholeSoundMArray Vector S Pulse -> MVector RealWorld S Pulse -> IO () f Vector S Pulse wholeSoundArray MVector RealWorld S Pulse dest, SomeStableName -> ComputationInfo -> ComputationInfo ComputationInfoMapMemory SomeStableName stableF ComputationInfo ci ) {-# INLINE mapSoundFromMemoryIO #-} fillSoundInMemoryIO :: (SamplingInfo -> M.MVector M.RealWorld M.S Pulse -> IO ()) -> ComputeSound Pulse fillSoundInMemoryIO :: (SamplingInfo -> MVector RealWorld S Pulse -> IO ()) -> ComputeSound Pulse fillSoundInMemoryIO SamplingInfo -> MVector RealWorld S Pulse -> IO () f = (SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)) -> ComputeSound Pulse forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)) -> ComputeSound Pulse) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)) -> ComputeSound Pulse forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound _ -> do SomeStableName stableF <- (SamplingInfo -> MVector RealWorld S Pulse -> IO ()) -> IO SomeStableName forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName makeSomeStableName SamplingInfo -> MVector RealWorld S Pulse -> IO () f let f' :: MVector RealWorld S Pulse -> IO () f' = SamplingInfo -> MVector RealWorld S Pulse -> IO () f SamplingInfo si (SoundResult Pulse, ComputationInfo) -> IO (SoundResult Pulse, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ( (MVector RealWorld S Pulse -> IO ()) -> SoundResult Pulse WriteResult ((MVector RealWorld S Pulse -> IO ()) -> SoundResult Pulse) -> (MVector RealWorld S Pulse -> IO ()) -> SoundResult Pulse forall a b. (a -> b) -> a -> b $ \MVector RealWorld S Pulse dest -> do MVector RealWorld S Pulse -> IO () f' MVector RealWorld S Pulse dest, SomeStableName -> ComputationInfo ComputationInfoFillMemory SomeStableName stableF ) {-# INLINE fillSoundInMemoryIO #-} embedIOCS :: IO (ComputeSound a) -> ComputeSound a embedIOCS :: forall a. IO (ComputeSound a) -> ComputeSound a embedIOCS IO (ComputeSound a) makeCS = (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound memo -> do SomeStableName stableIO <- IO (ComputeSound a) -> IO SomeStableName forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName makeSomeStableName IO (ComputeSound a) makeCS (ComputeSound SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo) compute) <- IO (ComputeSound a) makeCS (SoundResult a res, ComputationInfo _) <- SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo) compute SamplingInfo si MemoComputeSound memo (SoundResult a, ComputationInfo) -> IO (SoundResult a, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (SoundResult a res, SomeStableName -> ComputationInfo ComputationInfoIO SomeStableName stableIO) {-# INLINE embedIOCS #-} embedIOLazilyCS :: IO (ComputeSound a) -> ComputeSound a embedIOLazilyCS :: forall a. IO (ComputeSound a) -> ComputeSound a embedIOLazilyCS IO (ComputeSound a) makeCS = (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a forall a. (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a ComputeSound ((SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a) -> (SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo)) -> ComputeSound a forall a b. (a -> b) -> a -> b $ \SamplingInfo si MemoComputeSound memo -> do SomeStableName stableIO <- IO (ComputeSound a) -> IO SomeStableName forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName makeSomeStableName IO (ComputeSound a) makeCS (SoundResult a, ComputationInfo) -> IO (SoundResult a, ComputationInfo) forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ( IO (Vector D a) -> SoundResult a forall a. IO (Vector D a) -> SoundResult a DelayedResult (IO (Vector D a) -> SoundResult a) -> IO (Vector D a) -> SoundResult a forall a b. (a -> b) -> a -> b $ do (IO (Vector D a) res, ComputationInfo _) <- IO (IO (IO (Vector D a), ComputationInfo)) -> IO (IO (Vector D a), ComputationInfo) forall (m :: * -> *) a. Monad m => m (m a) -> m a join (IO (IO (IO (Vector D a), ComputationInfo)) -> IO (IO (Vector D a), ComputationInfo)) -> IO (IO (IO (Vector D a), ComputationInfo)) -> IO (IO (Vector D a), ComputationInfo) forall a b. (a -> b) -> a -> b $ ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) forall a. ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo) asDelayedResult (ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo)) -> IO (ComputeSound a) -> IO (SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> IO (ComputeSound a) makeCS IO (SamplingInfo -> MemoComputeSound -> IO (IO (Vector D a), ComputationInfo)) -> IO SamplingInfo -> IO (MemoComputeSound -> IO (IO (Vector D a), ComputationInfo)) forall a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> SamplingInfo -> IO SamplingInfo forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure SamplingInfo si IO (MemoComputeSound -> IO (IO (Vector D a), ComputationInfo)) -> IO MemoComputeSound -> IO (IO (IO (Vector D a), ComputationInfo)) forall a b. IO (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> MemoComputeSound -> IO MemoComputeSound forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure MemoComputeSound memo IO (Vector D a) res, SomeStableName -> ComputationInfo ComputationInfoIO SomeStableName stableIO ) {-# INLINE embedIOLazilyCS #-} pulseSize :: Int pulseSize :: Ix1 pulseSize = Pulse -> Ix1 forall a. Storable a => a -> Ix1 sizeOf (Pulse forall a. HasCallStack => a undefined :: Pulse) {-# INLINE pulseSize #-} sampleComputeSound :: SamplingInfo -> ComputeSound Pulse -> IO (M.Vector M.S Pulse) sampleComputeSound :: SamplingInfo -> ComputeSound Pulse -> IO (Vector S Pulse) sampleComputeSound SamplingInfo si ComputeSound Pulse cs = do HashTable RealWorld MemoInfo (Vector S Pulse) hashTable <- IO (HashTable RealWorld MemoInfo (Vector S Pulse)) IO (IOHashTable HashTable MemoInfo (Vector S Pulse)) forall (h :: * -> * -> * -> *) k v. HashTable h => IO (IOHashTable h k v) H.new MVector RealWorld S Pulse destArray <- Sz Ix1 -> IO (MArray (PrimState IO) S Ix1 Pulse) forall ix e (m :: * -> *). (Index ix, Storable e, PrimMonad m) => Sz ix -> m (MArray (PrimState m) S ix e) MU.unsafeMallocMArray (Sz Ix1 -> IO (MArray (PrimState IO) S Ix1 Pulse)) -> Sz Ix1 -> IO (MArray (PrimState IO) S Ix1 Pulse) forall a b. (a -> b) -> a -> b $ Ix1 -> Sz Ix1 M.Sz1 SamplingInfo si.samples (MVector RealWorld S Pulse -> IO () writeResult, ComputationInfo _) <- ComputeSound Pulse -> SamplingInfo -> MemoComputeSound -> IO (MVector RealWorld S Pulse -> IO (), ComputationInfo) asWriteResult ComputeSound Pulse cs SamplingInfo si (IOHashTable HashTable MemoInfo (Vector S Pulse) -> MemoComputeSound MemoComputeSound HashTable RealWorld MemoInfo (Vector S Pulse) IOHashTable HashTable MemoInfo (Vector S Pulse) hashTable) MVector RealWorld S Pulse -> IO () writeResult MVector RealWorld S Pulse destArray Comp -> MArray (PrimState IO) S Ix1 Pulse -> IO (Vector S Pulse) forall r e ix (m :: * -> *). (Manifest r e, Index ix, PrimMonad m) => Comp -> MArray (PrimState m) r ix e -> m (Array r ix e) forall ix (m :: * -> *). (Index ix, PrimMonad m) => Comp -> MArray (PrimState m) S ix Pulse -> m (Array S ix Pulse) MU.unsafeFreeze Comp M.Seq MVector RealWorld S Pulse MArray (PrimState IO) S Ix1 Pulse destArray {-# INLINE sampleComputeSound #-} newtype MemoComputeSound = MemoComputeSound (H.BasicHashTable MemoInfo (M.Vector M.S Pulse)) data MemoInfo = MemoInfo { MemoInfo -> SamplingInfo samplingInfo :: !SamplingInfo, MemoInfo -> ComputationInfo computationInfo :: !ComputationInfo } deriving (MemoInfo -> MemoInfo -> Bool (MemoInfo -> MemoInfo -> Bool) -> (MemoInfo -> MemoInfo -> Bool) -> Eq MemoInfo forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: MemoInfo -> MemoInfo -> Bool == :: MemoInfo -> MemoInfo -> Bool $c/= :: MemoInfo -> MemoInfo -> Bool /= :: MemoInfo -> MemoInfo -> Bool Eq, (forall x. MemoInfo -> Rep MemoInfo x) -> (forall x. Rep MemoInfo x -> MemoInfo) -> Generic MemoInfo forall x. Rep MemoInfo x -> MemoInfo forall x. MemoInfo -> Rep MemoInfo x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cfrom :: forall x. MemoInfo -> Rep MemoInfo x from :: forall x. MemoInfo -> Rep MemoInfo x $cto :: forall x. Rep MemoInfo x -> MemoInfo to :: forall x. Rep MemoInfo x -> MemoInfo Generic) instance Hashable MemoInfo lookupMemoizedComputeSound :: MemoComputeSound -> MemoInfo -> IO (Maybe (M.Vector M.S Pulse)) lookupMemoizedComputeSound :: MemoComputeSound -> MemoInfo -> IO (Maybe (Vector S Pulse)) lookupMemoizedComputeSound (MemoComputeSound IOHashTable HashTable MemoInfo (Vector S Pulse) memoTable) MemoInfo memoInfo = do IOHashTable HashTable MemoInfo (Vector S Pulse) -> MemoInfo -> IO (Maybe (Vector S Pulse)) forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> IO (Maybe v) H.lookup IOHashTable HashTable MemoInfo (Vector S Pulse) memoTable MemoInfo memoInfo {-# INLINE lookupMemoizedComputeSound #-} memoizeComputeSound :: MemoComputeSound -> MemoInfo -> M.Vector M.S Pulse -> IO () memoizeComputeSound :: MemoComputeSound -> MemoInfo -> Vector S Pulse -> IO () memoizeComputeSound (MemoComputeSound IOHashTable HashTable MemoInfo (Vector S Pulse) hashTable) MemoInfo memoInfo Vector S Pulse vec = do IOHashTable HashTable MemoInfo (Vector S Pulse) -> MemoInfo -> Vector S Pulse -> IO () forall (h :: * -> * -> * -> *) k v. (HashTable h, Eq k, Hashable k) => IOHashTable h k v -> k -> v -> IO () H.insert IOHashTable HashTable MemoInfo (Vector S Pulse) hashTable MemoInfo memoInfo Vector S Pulse vec {-# INLINE memoizeComputeSound #-} newtype ComputeSound a = ComputeSound { forall a. ComputeSound a -> SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo) compute :: SamplingInfo -> MemoComputeSound -> IO (SoundResult a, ComputationInfo) } data SoundResult a where WriteResult :: (M.MVector M.RealWorld M.S Pulse -> IO ()) -> SoundResult Pulse DelayedResult :: IO (M.Vector M.D a) -> SoundResult a data ComputationInfo = ComputationInfoZip SomeStableName ComputationInfo ComputationInfo | ComputationInfoMap SomeStableName ComputationInfo | ComputationInfoSequentially Percentage ComputationInfo ComputationInfo | ComputationInfoParallel Percentage ComputationInfo ComputationInfo | ComputationInfoMakeDelayedResult SomeStableName | ComputationInfoMapDelayedResult SomeStableName ComputationInfo | ComputationInfoMergeDelayedResult SomeStableName ComputationInfo ComputationInfo | ComputationInfoMapMemory SomeStableName ComputationInfo | ComputationInfoFillMemory SomeStableName | ComputationInfoChangeSamplingInfo SomeStableName ComputationInfo | ComputationInfoWithSampledSound SomeStableName ComputationInfo | ComputationInfoIO SomeStableName | ComputationInfoWithSamplingInfo SomeStableName deriving (ComputationInfo -> ComputationInfo -> Bool (ComputationInfo -> ComputationInfo -> Bool) -> (ComputationInfo -> ComputationInfo -> Bool) -> Eq ComputationInfo forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: ComputationInfo -> ComputationInfo -> Bool == :: ComputationInfo -> ComputationInfo -> Bool $c/= :: ComputationInfo -> ComputationInfo -> Bool /= :: ComputationInfo -> ComputationInfo -> Bool Eq, (forall x. ComputationInfo -> Rep ComputationInfo x) -> (forall x. Rep ComputationInfo x -> ComputationInfo) -> Generic ComputationInfo forall x. Rep ComputationInfo x -> ComputationInfo forall x. ComputationInfo -> Rep ComputationInfo x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cfrom :: forall x. ComputationInfo -> Rep ComputationInfo x from :: forall x. ComputationInfo -> Rep ComputationInfo x $cto :: forall x. Rep ComputationInfo x -> ComputationInfo to :: forall x. Rep ComputationInfo x -> ComputationInfo Generic, Ix1 -> ComputationInfo -> ShowS [ComputationInfo] -> ShowS ComputationInfo -> String (Ix1 -> ComputationInfo -> ShowS) -> (ComputationInfo -> String) -> ([ComputationInfo] -> ShowS) -> Show ComputationInfo forall a. (Ix1 -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Ix1 -> ComputationInfo -> ShowS showsPrec :: Ix1 -> ComputationInfo -> ShowS $cshow :: ComputationInfo -> String show :: ComputationInfo -> String $cshowList :: [ComputationInfo] -> ShowS showList :: [ComputationInfo] -> ShowS Show) instance Hashable ComputationInfo copyArrayIntoMArray :: M.Vector M.S Pulse -> M.MVector M.RealWorld M.S Pulse -> IO () copyArrayIntoMArray :: Vector S Pulse -> MVector RealWorld S Pulse -> IO () copyArrayIntoMArray Vector S Pulse source MVector RealWorld S Pulse dest = let (ForeignPtr Pulse sourceFPtr, Ix1 _) = Vector S Pulse -> (ForeignPtr Pulse, Ix1) forall ix e. Index ix => Array S ix e -> (ForeignPtr e, Ix1) MU.unsafeArrayToForeignPtr Vector S Pulse source (ForeignPtr Pulse destFPtr, Ix1 _) = MVector RealWorld S Pulse -> (ForeignPtr Pulse, Ix1) forall ix s e. Index ix => MArray s S ix e -> (ForeignPtr e, Ix1) MU.unsafeMArrayToForeignPtr MVector RealWorld S Pulse dest in IO () -> IO () forall a. IO a -> IO a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ ForeignPtr Pulse -> (Ptr Pulse -> IO ()) -> IO () forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b withForeignPtr ForeignPtr Pulse sourceFPtr ((Ptr Pulse -> IO ()) -> IO ()) -> (Ptr Pulse -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \Ptr Pulse sourcePtr -> ForeignPtr Pulse -> (Ptr Pulse -> IO ()) -> IO () forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b withForeignPtr ForeignPtr Pulse destFPtr ((Ptr Pulse -> IO ()) -> IO ()) -> (Ptr Pulse -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \Ptr Pulse destPtr -> Ptr Pulse -> Ptr Pulse -> Ix1 -> IO () forall a. Ptr a -> Ptr a -> Ix1 -> IO () copyBytes Ptr Pulse destPtr Ptr Pulse sourcePtr (Sz Ix1 -> Ix1 forall ix. Sz ix -> ix M.unSz (Vector S Pulse -> Sz Ix1 forall r ix e. Size r => Array r ix e -> Sz ix forall ix e. Array S ix e -> Sz ix M.size Vector S Pulse source) Ix1 -> Ix1 -> Ix1 forall a. Num a => a -> a -> a * Ix1 pulseSize) {-# INLINE copyArrayIntoMArray #-} copyMArrayIntoMArray :: M.MVector M.RealWorld M.S Pulse -> M.MVector M.RealWorld M.S Pulse -> IO () copyMArrayIntoMArray :: MVector RealWorld S Pulse -> MVector RealWorld S Pulse -> IO () copyMArrayIntoMArray MVector RealWorld S Pulse source MVector RealWorld S Pulse dest = let (ForeignPtr Pulse sourceFPtr, Ix1 _) = MVector RealWorld S Pulse -> (ForeignPtr Pulse, Ix1) forall ix s e. Index ix => MArray s S ix e -> (ForeignPtr e, Ix1) MU.unsafeMArrayToForeignPtr MVector RealWorld S Pulse source (ForeignPtr Pulse destFPtr, Ix1 _) = MVector RealWorld S Pulse -> (ForeignPtr Pulse, Ix1) forall ix s e. Index ix => MArray s S ix e -> (ForeignPtr e, Ix1) MU.unsafeMArrayToForeignPtr MVector RealWorld S Pulse dest in IO () -> IO () forall a. IO a -> IO a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $ ForeignPtr Pulse -> (Ptr Pulse -> IO ()) -> IO () forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b withForeignPtr ForeignPtr Pulse sourceFPtr ((Ptr Pulse -> IO ()) -> IO ()) -> (Ptr Pulse -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \Ptr Pulse sourcePtr -> ForeignPtr Pulse -> (Ptr Pulse -> IO ()) -> IO () forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b withForeignPtr ForeignPtr Pulse destFPtr ((Ptr Pulse -> IO ()) -> IO ()) -> (Ptr Pulse -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \Ptr Pulse destPtr -> Ptr Pulse -> Ptr Pulse -> Ix1 -> IO () forall a. Ptr a -> Ptr a -> Ix1 -> IO () copyBytes Ptr Pulse destPtr Ptr Pulse sourcePtr (Sz Ix1 -> Ix1 forall ix. Sz ix -> ix M.unSz (MVector RealWorld S Pulse -> Sz Ix1 forall ix s. Index ix => MArray s S ix Pulse -> Sz ix forall r e ix s. (Manifest r e, Index ix) => MArray s r ix e -> Sz ix M.sizeOfMArray MVector RealWorld S Pulse source) Ix1 -> Ix1 -> Ix1 forall a. Num a => a -> a -> a * Ix1 pulseSize) {-# INLINE copyMArrayIntoMArray #-}