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