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
  stableF <- (SamplingInfo -> Vector D a) -> IO SomeStableName
forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName
makeSomeStableName SamplingInfo -> Vector D a
f
  pure (DelayedResult $ pure $ f si, ComputationInfoMakeDelayedResult 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
  stableChangeSI <- (SamplingInfo -> SamplingInfo) -> IO SomeStableName
forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName
makeSomeStableName SamplingInfo -> SamplingInfo
changeSI
  (result, ci) <- compute (changeSI si) memo
  pure (result, ComputationInfoChangeSamplingInfo stableChangeSI 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
  (delayedVector, 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
  stableMapVector <- makeSomeStableName mapVector
  let mapVector' = SamplingInfo -> Vector D a -> Vector D b
mapVector SamplingInfo
si
  pure (DelayedResult $ fmap mapVector' delayedVector, ComputationInfoMapDelayedResult stableMapVector 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
  stableF <- (SamplingInfo -> ComputeSound a) -> IO SomeStableName
forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName
makeSomeStableName SamplingInfo -> ComputeSound a
f
  let (ComputeSound compute) = f si
  (res, _) <- compute si memo
  pure (res, ComputationInfoWithSamplingInfo 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
  (writeSamples, ci) <- ComputeSound Pulse
-> SamplingInfo
-> MemoComputeSound
-> IO (MVector RealWorld S Pulse -> IO (), ComputationInfo)
asWriteResult ComputeSound Pulse
cs SamplingInfo
sampleSI MemoComputeSound
memo
  dest <- MU.unsafeMallocMArray (M.Sz1 sampleSI.samples)
  writeSamples dest
  samples <- MU.unsafeFreeze M.Seq dest
  let (ComputeSound compute) = f samples
  (res, _) <- compute si memo
  stableF <- makeSomeStableName f
  pure (res, ComputationInfoWithSampledSound stableF 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
  (delayedVector, 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 = 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
  stableF <- makeSomeStableName f
  pure
    ( DelayedResult $ do
        (finalDelayedVector, _) <- join $ asDelayedResult <$> nextCS <*> pure si <*> pure memo
        finalDelayedVector,
      ComputationInfoWithSampledSound stableF 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
  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
  (delayedResult1, ci1) <- asDelayedResult cs1 si memo
  (delayedResult2, ci2) <- asDelayedResult cs2 si memo
  let merge' = SamplingInfo -> Vector D a -> Vector D b -> Vector D c
merge SamplingInfo
si
  pure (DelayedResult $ merge' <$> delayedResult1 <*> delayedResult2, ComputationInfoMergeDelayedResult stableMerge ci1 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
  (writeResult1, ci1) <- ComputeSound Pulse
-> SamplingInfo
-> MemoComputeSound
-> IO (MVector RealWorld S Pulse -> IO (), ComputationInfo)
asWriteResult ComputeSound Pulse
c1 SamplingInfo
si {samples = splitIndex} MemoComputeSound
memo
  (writeResult2, ci2) <- asWriteResult c2 si {samples = si.samples - splitIndex} memo
  pure
    ( WriteResult $ \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,
      ComputationInfoSequentially factor ci1 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
  (delayedResult1, 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
  (delayedResult2, p2) <- asDelayedResult c2 si {samples = c2N} memo
  pure
    ( if si.samples == c2N
        then DelayedResult $ M.zipWith (+) <$> delayedResult1 <*> delayedResult2
        else DelayedResult $ do
          dR1 <- delayedResult1
          dR2 <- delayedResult2
          pure $ 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) dR1,
      ComputationInfoParallel factor p1 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
  stableF <- (a -> b) -> IO SomeStableName
forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName
makeSomeStableName a -> b
f
  (result, ci) <- asDelayedResult cs si memo
  pure (DelayedResult $ M.map f <$> result, ComputationInfoMap stableF 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
  (result, ci) <- SamplingInfo
-> MemoComputeSound -> IO (SoundResult a, ComputationInfo)
compute SamplingInfo
si MemoComputeSound
memo
  case 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
            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)
            writeResult marray
            array <- MU.unsafeFreeze M.Seq marray
            pure $ M.delay 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
  (result, ci) <- SamplingInfo
-> MemoComputeSound -> IO (SoundResult Pulse, ComputationInfo)
compute SamplingInfo
si MemoComputeSound
memo
  case 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
            memoized <- MemoComputeSound -> MemoInfo -> IO (Maybe (Vector S Pulse))
lookupMemoizedComputeSound MemoComputeSound
memo MemoInfo
memoInfo

            case 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
                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
                memoizeComputeSound memo memoInfo 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
  (dV1, 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
  (dV2, p2) <- asDelayedResult cs2 si memo
  stableF <- makeSomeStableName f
  pure (DelayedResult $ M.zipWith f <$> dV1 <*> dV2, ComputationInfoZip stableF p1 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
  (writeSamples, ci) <- ComputeSound Pulse
-> SamplingInfo
-> MemoComputeSound
-> IO (MVector RealWorld S Pulse -> IO (), ComputationInfo)
asWriteResult ComputeSound Pulse
cs SamplingInfo
si MemoComputeSound
memo
  stableF <- makeSomeStableName f
  pure
    ( WriteResult $ \MVector RealWorld S Pulse
dest -> do
        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)
        writeSamples wholeSoundMArray
        wholeSoundArray <- MU.unsafeFreeze M.Seq wholeSoundMArray
        M.computeInto dest $ f wholeSoundArray,
      ComputationInfoMapMemory stableF 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
  (writeSamples, ci) <- ComputeSound Pulse
-> SamplingInfo
-> MemoComputeSound
-> IO (MVector RealWorld S Pulse -> IO (), ComputationInfo)
asWriteResult ComputeSound Pulse
cs SamplingInfo
si MemoComputeSound
memo
  stableF <- makeSomeStableName f
  pure
    ( WriteResult $ \MVector RealWorld S Pulse
dest -> do
        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)
        writeSamples wholeSoundMArray
        wholeSoundArray <- MU.unsafeFreeze M.Seq wholeSoundMArray
        f wholeSoundArray dest,
      ComputationInfoMapMemory stableF 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
  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' = SamplingInfo -> MVector RealWorld S Pulse -> IO ()
f SamplingInfo
si
  pure
    ( WriteResult $ \MVector RealWorld S Pulse
dest -> do
        MVector RealWorld S Pulse -> IO ()
f' MVector RealWorld S Pulse
dest,
      ComputationInfoFillMemory 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
  stableIO <- IO (ComputeSound a) -> IO SomeStableName
forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName
makeSomeStableName IO (ComputeSound a)
makeCS
  (ComputeSound compute) <- makeCS
  (res, _) <- compute si memo
  pure (res, ComputationInfoIO 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
  stableIO <- IO (ComputeSound a) -> IO SomeStableName
forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName
makeSomeStableName IO (ComputeSound a)
makeCS
  pure
    ( DelayedResult $ do
        (res, _) <- join $ asDelayedResult <$> makeCS <*> pure si <*> pure memo
        res,
      ComputationInfoIO 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 <- 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
  destArray <- MU.unsafeMallocMArray $ M.Sz1 si.samples
  (writeResult, _) <- asWriteResult cs si (MemoComputeSound hashTable)
  writeResult destArray
  MU.unsafeFreeze M.Seq 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 #-}