module LambdaSound.Sound.ComputeSound where

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 (Vector D a -> SoundResult a
forall a. Vector D a -> SoundResult a
DelayedResult (Vector D a -> SoundResult a) -> Vector D a -> SoundResult 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
  (Vector D a
delayedVector, ComputationInfo
ci) <- ComputeSound a
-> SamplingInfo
-> MemoComputeSound
-> IO (Vector D a, ComputationInfo)
forall a.
ComputeSound a
-> SamplingInfo
-> MemoComputeSound
-> 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 (Vector D b -> SoundResult b
forall a. Vector D a -> SoundResult a
DelayedResult (Vector D b -> SoundResult b) -> Vector D b -> SoundResult b
forall a b. (a -> b) -> a -> b
$ Vector D a -> Vector D b
mapVector' 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 ->
  let (ComputeSound SamplingInfo
-> MemoComputeSound -> IO (SoundResult a, ComputationInfo)
compute) = SamplingInfo -> ComputeSound a
f SamplingInfo
si
   in SamplingInfo
-> MemoComputeSound -> IO (SoundResult a, ComputationInfo)
compute SamplingInfo
si MemoComputeSound
memo
{-# INLINE withSamplingInfoCS #-}

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
  (Vector D a
delayedResult1, ComputationInfo
ci1) <- ComputeSound a
-> SamplingInfo
-> MemoComputeSound
-> IO (Vector D a, ComputationInfo)
forall a.
ComputeSound a
-> SamplingInfo
-> MemoComputeSound
-> IO (Vector D a, ComputationInfo)
asDelayedResult ComputeSound a
cs1 SamplingInfo
si MemoComputeSound
memo
  (Vector D b
delayedResult2, ComputationInfo
ci2) <- ComputeSound b
-> SamplingInfo
-> MemoComputeSound
-> IO (Vector D b, ComputationInfo)
forall a.
ComputeSound a
-> SamplingInfo
-> MemoComputeSound
-> 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 (Vector D c -> SoundResult c
forall a. Vector D a -> SoundResult a
DelayedResult (Vector D c -> SoundResult c) -> 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
delayedResult1 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 {$sel:samples:SamplingInfo :: Ix1
samples = Ix1
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 {$sel:samples:SamplingInfo :: Ix1
samples = SamplingInfo
si.samples Ix1 -> Ix1 -> Ix1
forall a. Num a => a -> a -> a
- Ix1
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,
      ComputationInfo -> ComputationInfo -> ComputationInfo
ComputationInfoSequentially ComputationInfo
ci1 ComputationInfo
ci2
    )
{-# INLINE computeSequentially #-}

computeParallel :: ComputeSound Pulse -> Float -> ComputeSound Pulse -> ComputeSound Pulse
computeParallel :: ComputeSound Pulse
-> Float -> ComputeSound Pulse -> ComputeSound Pulse
computeParallel ComputeSound Pulse
c1 Float
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 = Float -> Ix1
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Ix1) -> Float -> Ix1
forall a b. (a -> b) -> a -> b
$ Float
factor Float -> Float -> Float
forall a. Num a => a -> a -> a
* Ix1 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral SamplingInfo
si.samples
  (Vector D Pulse
delayedResult1, ComputationInfo
p1) <- ComputeSound Pulse
-> SamplingInfo
-> MemoComputeSound
-> IO (Vector D Pulse, ComputationInfo)
forall a.
ComputeSound a
-> SamplingInfo
-> MemoComputeSound
-> IO (Vector D a, ComputationInfo)
asDelayedResult ComputeSound Pulse
c1 SamplingInfo
si MemoComputeSound
memo
  (Vector D Pulse
delayedResult2, ComputationInfo
p2) <- ComputeSound Pulse
-> SamplingInfo
-> MemoComputeSound
-> IO (Vector D Pulse, ComputationInfo)
forall a.
ComputeSound a
-> SamplingInfo
-> MemoComputeSound
-> IO (Vector D a, ComputationInfo)
asDelayedResult ComputeSound Pulse
c2 SamplingInfo
si {$sel:samples:SamplingInfo :: Ix1
samples = Ix1
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 Vector D Pulse -> SoundResult Pulse
forall a. Vector D a -> SoundResult a
DelayedResult (Vector D Pulse -> SoundResult Pulse)
-> 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
delayedResult1 Vector D Pulse
delayedResult2
        else Vector D Pulse -> SoundResult Pulse
forall a. Vector D a -> SoundResult a
DelayedResult (Vector D Pulse -> SoundResult Pulse)
-> Vector D Pulse -> SoundResult 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
delayedResult2 Ix1
index else Pulse
0) Vector D Pulse
delayedResult1,
      ComputationInfo -> ComputationInfo -> ComputationInfo
ComputationInfoParallel 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
  (Vector D a
result, ComputationInfo
ci) <- ComputeSound a
-> SamplingInfo
-> MemoComputeSound
-> IO (Vector D a, ComputationInfo)
forall a.
ComputeSound a
-> SamplingInfo
-> MemoComputeSound
-> 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 (Vector D b -> SoundResult b
forall a. Vector D a -> SoundResult a
DelayedResult (Vector D b -> SoundResult b) -> 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
result, SomeStableName -> ComputationInfo -> ComputationInfo
ComputationInfoMap SomeStableName
stableF ComputationInfo
ci)
{-# INLINE mapComputeSound #-}

asDelayedResult ::
  ComputeSound a ->
  SamplingInfo ->
  MemoComputeSound ->
  IO (M.Vector M.D a, ComputationInfo)
asDelayedResult :: forall a.
ComputeSound a
-> SamplingInfo
-> MemoComputeSound
-> 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 Vector D a
vector -> (Vector D a, ComputationInfo) -> IO (Vector D a, ComputationInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector D a
vector, ComputationInfo
ci)
    WriteResult MVector RealWorld S Pulse -> IO ()
writeResult -> 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
      Array S Ix1 Pulse
array <- Comp -> MArray (PrimState IO) S Ix1 Pulse -> IO (Array S Ix1 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, ComputationInfo) -> IO (Vector D a, ComputationInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
Array S Ix1 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 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 (Array S Ix1 Pulse)
memoized <- MemoComputeSound -> MemoInfo -> IO (Maybe (Array S Ix1 Pulse))
lookupMemoizedComputeSound MemoComputeSound
memo MemoInfo
memoInfo
            case Maybe (Array S Ix1 Pulse)
memoized of
              Just Array S Ix1 Pulse
memoSource ->
                Array S Ix1 Pulse -> MVector RealWorld S Pulse -> IO ()
copyArrayIntoMArray Array S Ix1 Pulse
memoSource MVector RealWorld S Pulse
dest
              Maybe (Array S Ix1 Pulse)
Nothing -> do
                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 D Pulse
vector
                Array S Ix1 Pulse
destArray <- Comp -> MArray (PrimState IO) S Ix1 Pulse -> IO (Array S Ix1 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 -> Array S Ix1 Pulse -> IO ()
memoizeComputeSound MemoComputeSound
memo MemoInfo
memoInfo Array S Ix1 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
  (Vector D a
dV1, ComputationInfo
p1) <- ComputeSound a
-> SamplingInfo
-> MemoComputeSound
-> IO (Vector D a, ComputationInfo)
forall a.
ComputeSound a
-> SamplingInfo
-> MemoComputeSound
-> IO (Vector D a, ComputationInfo)
asDelayedResult ComputeSound a
cs1 SamplingInfo
si MemoComputeSound
memo
  (Vector D b
dV2, ComputationInfo
p2) <- ComputeSound b
-> SamplingInfo
-> MemoComputeSound
-> IO (Vector D b, ComputationInfo)
forall a.
ComputeSound a
-> SamplingInfo
-> MemoComputeSound
-> 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 (Vector D c -> SoundResult c
forall a. Vector D a -> SoundResult a
DelayedResult (Vector D c -> SoundResult c) -> 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
dV1 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 =>
(Array S Ix1 Pulse -> Vector r Pulse)
-> ComputeSound Pulse -> ComputeSound Pulse
mapSoundFromMemory Array S Ix1 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 <- (Array S Ix1 Pulse -> Vector r Pulse) -> IO SomeStableName
forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName
makeSomeStableName Array S Ix1 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
        Array S Ix1 Pulse
wholeSoundArray <- Comp -> MArray (PrimState IO) S Ix1 Pulse -> IO (Array S Ix1 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
$ Array S Ix1 Pulse -> Vector r Pulse
f Array S Ix1 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 :: (Array S Ix1 Pulse -> MVector RealWorld S Pulse -> IO ())
-> ComputeSound Pulse -> ComputeSound Pulse
mapSoundFromMemoryIO Array S Ix1 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 <- (Array S Ix1 Pulse -> MVector RealWorld S Pulse -> IO ())
-> IO SomeStableName
forall (m :: * -> *) a. MonadIO m => a -> m SomeStableName
makeSomeStableName Array S Ix1 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
        Array S Ix1 Pulse
wholeSoundArray <- Comp -> MArray (PrimState IO) S Ix1 Pulse -> IO (Array S Ix1 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
        Array S Ix1 Pulse -> MVector RealWorld S Pulse -> IO ()
f Array S Ix1 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 #-}

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 (Array S Ix1 Pulse)
sampleComputeSound SamplingInfo
si ComputeSound Pulse
cs = do
  HashTable RealWorld MemoInfo (Array S Ix1 Pulse)
hashTable <- IO (HashTable RealWorld MemoInfo (Array S Ix1 Pulse))
IO (IOHashTable HashTable MemoInfo (Array S Ix1 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 (Array S Ix1 Pulse)
-> MemoComputeSound
MemoComputeSound HashTable RealWorld MemoInfo (Array S Ix1 Pulse)
IOHashTable HashTable MemoInfo (Array S Ix1 Pulse)
hashTable)
  MVector RealWorld S Pulse -> IO ()
writeResult MVector RealWorld S Pulse
destArray
  Comp -> MArray (PrimState IO) S Ix1 Pulse -> IO (Array S Ix1 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 (Array S Ix1 Pulse))
lookupMemoizedComputeSound (MemoComputeSound IOHashTable HashTable MemoInfo (Array S Ix1 Pulse)
memoTable) MemoInfo
memoInfo = do
  IOHashTable HashTable MemoInfo (Array S Ix1 Pulse)
-> MemoInfo -> IO (Maybe (Array S Ix1 Pulse))
forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO (Maybe v)
H.lookup IOHashTable HashTable MemoInfo (Array S Ix1 Pulse)
memoTable MemoInfo
memoInfo
{-# INLINE lookupMemoizedComputeSound #-}

memoizeComputeSound :: MemoComputeSound -> MemoInfo -> M.Vector M.S Pulse -> IO ()
memoizeComputeSound :: MemoComputeSound -> MemoInfo -> Array S Ix1 Pulse -> IO ()
memoizeComputeSound (MemoComputeSound IOHashTable HashTable MemoInfo (Array S Ix1 Pulse)
hashTable) MemoInfo
memoInfo Array S Ix1 Pulse
vec = do
  IOHashTable HashTable MemoInfo (Array S Ix1 Pulse)
-> MemoInfo -> Array S Ix1 Pulse -> IO ()
forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> v -> IO ()
H.insert IOHashTable HashTable MemoInfo (Array S Ix1 Pulse)
hashTable MemoInfo
memoInfo Array S Ix1 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 :: M.Vector M.D a -> SoundResult a

data ComputationInfo
  = ComputationInfoZip SomeStableName ComputationInfo ComputationInfo
  | ComputationInfoMap SomeStableName ComputationInfo
  | ComputationInfoSequentially ComputationInfo ComputationInfo
  | ComputationInfoParallel ComputationInfo ComputationInfo
  | ComputationInfoMakeDelayedResult SomeStableName
  | ComputationInfoMapDelayedResult SomeStableName ComputationInfo
  | ComputationInfoMergeDelayedResult SomeStableName ComputationInfo ComputationInfo
  | ComputationInfoMapMemory SomeStableName ComputationInfo
  | ComputationInfoFillMemory SomeStableName
  | ComputationInfoChangeSamplingInfo SomeStableName ComputationInfo
  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 :: Array S Ix1 Pulse -> MVector RealWorld S Pulse -> IO ()
copyArrayIntoMArray Array S Ix1 Pulse
source MVector RealWorld S Pulse
dest =
  let (ForeignPtr Pulse
sourceFPtr, Ix1
_) = Array S Ix1 Pulse -> (ForeignPtr Pulse, Ix1)
forall ix e. Index ix => Array S ix e -> (ForeignPtr e, Ix1)
MU.unsafeArrayToForeignPtr Array S Ix1 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 (Array S Ix1 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 Array S Ix1 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 #-}