module Synthesizer.Storable.Cut (
   arrange,

   -- for MIDI.CausalIO.Process
   addChunkToBuffer,

   -- for testing
   arrangeEquidist,
   arrangeAdaptive,
   arrangeList,
   ) where

import qualified Synthesizer.Storable.Signal as Sig

import qualified Data.StorableVector           as SV
import qualified Data.StorableVector.Lazy      as SVL
import qualified Data.StorableVector.ST.Strict as SVST
import Foreign.Storable (Storable)

import Control.Monad.ST.Strict (ST, runST, )
import Control.Monad.Trans.State (runState, modify, gets, put, )

import qualified Data.EventList.Relative.TimeBody  as EventList
import qualified Data.EventList.Relative.TimeMixed as EventListTM
import qualified Data.EventList.Absolute.TimeBody  as AbsEventList
import Data.Tuple.HT (mapSnd, )

import qualified Algebra.Additive as Additive
import qualified Number.NonNegative as NonNeg

import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()


{-# INLINE arrange #-}
arrange :: (Storable v, Additive.C v) =>
       Sig.ChunkSize
    -> EventList.T NonNeg.Int (Sig.T v)
            {-^ A list of pairs: (relative start time, signal part),
                The start time is relative to the start time
                of the previous event. -}
    -> Sig.T v
            {-^ The mixed signal. -}
arrange :: forall v. (Storable v, C v) => ChunkSize -> T Int (T v) -> T v
arrange =
   ChunkSize -> T Int (T v) -> T v
forall v. (Storable v, C v) => ChunkSize -> T Int (T v) -> T v
arrangeEquidist

{- |
Chunk sizes are adapted to the time differences.
Explicit ChunkSize parameter is only required for zero padding.
Since no ST monad is needed, this can be generalized to Generic.Signal.Transform class.
-}
arrangeAdaptive :: (Storable v, Additive.C v) =>
       Sig.ChunkSize
    -> EventList.T NonNeg.Int (Sig.T v)
            {-^ A list of pairs: (relative start time, signal part),
                The start time is relative to the start time
                of the previous event. -}
    -> Sig.T v
            {-^ The mixed signal. -}
arrangeAdaptive :: forall v. (Storable v, C v) => ChunkSize -> T Int (T v) -> T v
arrangeAdaptive ChunkSize
size =
   (Vector v -> Vector v -> Vector v)
-> (Vector v, Vector v) -> Vector v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Vector v -> Vector v -> Vector v
forall a. Storable a => Vector a -> Vector a -> Vector a
Sig.append ((Vector v, Vector v) -> Vector v)
-> (T Int (Vector v) -> (Vector v, Vector v))
-> T Int (Vector v)
-> Vector v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (State (Vector v) (Vector v) -> Vector v -> (Vector v, Vector v))
-> Vector v -> State (Vector v) (Vector v) -> (Vector v, Vector v)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (Vector v) (Vector v) -> Vector v -> (Vector v, Vector v)
forall s a. State s a -> s -> (a, s)
runState Vector v
forall a. Storable a => Vector a
Sig.empty (State (Vector v) (Vector v) -> (Vector v, Vector v))
-> (T Int (Vector v) -> State (Vector v) (Vector v))
-> T Int (Vector v)
-> (Vector v, Vector v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (T (Vector v) () -> Vector v)
-> StateT (Vector v) Identity (T (Vector v) ())
-> State (Vector v) (Vector v)
forall a b.
(a -> b)
-> StateT (Vector v) Identity a -> StateT (Vector v) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Vector v] -> Vector v
forall a. Storable a => [Vector a] -> Vector a
Sig.concat ([Vector v] -> Vector v)
-> (T (Vector v) () -> [Vector v]) -> T (Vector v) () -> Vector v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (Vector v) () -> [Vector v]
forall time body. T time body -> [time]
EventList.getTimes) (StateT (Vector v) Identity (T (Vector v) ())
 -> State (Vector v) (Vector v))
-> (T Int (Vector v)
    -> StateT (Vector v) Identity (T (Vector v) ()))
-> T Int (Vector v)
-> State (Vector v) (Vector v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (Int -> State (Vector v) (Vector v))
-> (Vector v -> StateT (Vector v) Identity ())
-> T Int (Vector v)
-> StateT (Vector v) Identity (T (Vector v) ())
forall (m :: * -> *) time0 time1 body0 body1.
Monad m =>
(time0 -> m time1)
-> (body0 -> m body1) -> T time0 body0 -> m (T time1 body1)
EventList.mapM
      (\Int
timeNN ->
           let time :: Int
time = Int -> Int
forall a. T a -> a
NonNeg.toNumber Int
timeNN
           in  do (Vector v
prefix,Vector v
suffix) <- (Vector v -> (Vector v, Vector v))
-> StateT (Vector v) Identity (Vector v, Vector v)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (ChunkSize -> Int -> Vector v -> (Vector v, Vector v)
forall x.
(C x, Storable x) =>
ChunkSize -> Int -> T x -> (T x, T x)
Sig.splitAtPad ChunkSize
size Int
time)
                  Vector v -> StateT (Vector v) Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Vector v
suffix
                  Vector v -> State (Vector v) (Vector v)
forall a. a -> StateT (Vector v) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Vector v
prefix)
      (\Vector v
body ->
           (Vector v -> Vector v) -> StateT (Vector v) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (Vector v -> Vector v -> Vector v
forall x. (C x, Storable x) => T x -> T x -> T x
Sig.mixSndPattern Vector v
body))


{- |
This function also uses the time differences as chunk sizes,
but may occasionally use smaller chunk sizes due to the chunk structure
of an input signal until the next signal starts.
-}
arrangeList :: (Storable v, Additive.C v) =>
       Sig.ChunkSize
    -> EventList.T NonNeg.Int (Sig.T v)
            {-^ A list of pairs: (relative start time, signal part),
                The start time is relative to the start time
                of the previous event. -}
    -> Sig.T v
            {-^ The mixed signal. -}
arrangeList :: forall v. (Storable v, C v) => ChunkSize -> T Int (T v) -> T v
arrangeList ChunkSize
size T Int (T v)
evs =
   let xs :: [T v]
xs = T Int (T v) -> [T v]
forall time body. T time body -> [body]
EventList.getBodies T Int (T v)
evs
   in  case T Int (T v) -> [Int]
forall time body. T time body -> [time]
EventList.getTimes T Int (T v)
evs of
          Int
t:[Int]
ts -> ChunkSize -> Int -> v -> T v
forall a. Storable a => ChunkSize -> Int -> a -> Vector a
Sig.replicate ChunkSize
size (Int -> Int
forall a. T a -> a
NonNeg.toNumber Int
t) v
forall a. C a => a
zero T v -> T v -> T v
forall a. Storable a => Vector a -> Vector a -> Vector a
`Sig.append`
                  ChunkSize -> [Int] -> [T v] -> T v
forall a. (Storable a, C a) => ChunkSize -> [Int] -> [T a] -> T a
addShiftedMany ChunkSize
size [Int]
ts [T v]
xs
          []   -> T v
forall a. Storable a => Vector a
Sig.empty


addShiftedMany :: (Storable a, Additive.C a) =>
   Sig.ChunkSize -> [NonNeg.Int] -> [Sig.T a] -> Sig.T a
addShiftedMany :: forall a. (Storable a, C a) => ChunkSize -> [Int] -> [T a] -> T a
addShiftedMany ChunkSize
size [Int]
ds [T a]
xss =
   ((Int, T a) -> T a -> T a) -> T a -> [(Int, T a)] -> T a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Int -> T a -> T a -> T a) -> (Int, T a) -> T a -> T a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ChunkSize -> Int -> T a -> T a -> T a
forall a.
(Storable a, C a) =>
ChunkSize -> Int -> T a -> T a -> T a
addShifted ChunkSize
size)) T a
forall a. Storable a => Vector a
Sig.empty ([Int] -> [T a] -> [(Int, T a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int]
ds[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++[Int
0]) [T a]
xss)


{-
It is crucial that 'mix' uses the chunk size structure of the second operand.
This way we avoid unnecessary and even infinite look-ahead.
-}
addShifted :: (Storable a, Additive.C a) =>
   Sig.ChunkSize -> NonNeg.Int -> Sig.T a -> Sig.T a -> Sig.T a
addShifted :: forall a.
(Storable a, C a) =>
ChunkSize -> Int -> T a -> T a -> T a
addShifted ChunkSize
size Int
delNN T a
px T a
py =
   let del :: Int
del = Int -> Int
forall a. T a -> a
NonNeg.toNumber Int
delNN
   in  (T a -> T a -> T a) -> (T a, T a) -> T a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry T a -> T a -> T a
forall a. Storable a => Vector a -> Vector a -> Vector a
Sig.append ((T a, T a) -> T a) -> (T a, T a) -> T a
forall a b. (a -> b) -> a -> b
$
       (T a -> T a) -> (T a, T a) -> (T a, T a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((T a -> T a -> T a) -> T a -> T a -> T a
forall a b c. (a -> b -> c) -> b -> a -> c
flip T a -> T a -> T a
forall x. (C x, Storable x) => T x -> T x -> T x
Sig.mixSndPattern T a
py) ((T a, T a) -> (T a, T a)) -> (T a, T a) -> (T a, T a)
forall a b. (a -> b) -> a -> b
$
       ChunkSize -> Int -> T a -> (T a, T a)
forall x.
(C x, Storable x) =>
ChunkSize -> Int -> T x -> (T x, T x)
Sig.splitAtPad ChunkSize
size Int
del T a
px


{-
arrangeEquidist (Sig.chunkSize 2) (EventList.fromPairList [(10, SVL.pack SVL.defaultChunkSize [1..8::Double]), (2, SVL.pack (Sig.chunkSize 2) $ [4,3,2,1::Double] ++ undefined)])
-}
{- |
The result is a Lazy StorableVector with chunks of the given size.
-}
{-# INLINE arrangeEquidist #-}
arrangeEquidist :: (Storable v, Additive.C v) =>
       Sig.ChunkSize
    -> EventList.T NonNeg.Int (Sig.T v)
            {-^ A list of pairs: (relative start time, signal part),
                The start time is relative to the start time
                of the previous event. -}
    -> Sig.T v
            {-^ The mixed signal. -}
arrangeEquidist :: forall v. (Storable v, C v) => ChunkSize -> T Int (T v) -> T v
arrangeEquidist (SVL.ChunkSize Int
sz) =
   let sznn :: Int
sznn = String -> Int -> Int
forall a. (Ord a, C a) => String -> a -> T a
NonNeg.fromNumberMsg String
"arrangeEquidist" Int
sz
       go :: [Vector a] -> T Int (Vector a) -> [Vector a]
go [Vector a]
acc T Int (Vector a)
evs =
          let (T Int (Vector a)
now,T Int (Vector a)
future) = Int -> T Int (Vector a) -> (T Int (Vector a), T Int (Vector a))
forall time body.
C time =>
time -> T time body -> (T time body, T time body)
EventListTM.splitAtTime Int
sznn T Int (Vector a)
evs
              xs :: [(Int, Vector a)]
xs =
                 T Int (Vector a) -> [(Int, Vector a)]
forall a b. T a b -> [(a, b)]
AbsEventList.toPairList (T Int (Vector a) -> [(Int, Vector a)])
-> T Int (Vector a) -> [(Int, Vector a)]
forall a b. (a -> b) -> a -> b
$
                 Int -> T Int (Vector a) -> T Int (Vector a)
forall time body. Num time => time -> T time body -> T time body
EventList.toAbsoluteEventList Int
0 (T Int (Vector a) -> T Int (Vector a))
-> T Int (Vector a) -> T Int (Vector a)
forall a b. (a -> b) -> a -> b
$
                 (T Int (Vector a) -> Int -> T Int (Vector a))
-> T Int (Vector a) -> T Int (Vector a)
forall time body a. (T time body -> time -> a) -> T time body -> a
EventListTM.switchTimeR T Int (Vector a) -> Int -> T Int (Vector a)
forall a b. a -> b -> a
const T Int (Vector a)
now
              (Vector a
chunk,[(Int, Vector a)]
newAcc) =
                 (forall s. ST s (Vector a, [(Int, Vector a)]))
-> (Vector a, [(Int, Vector a)])
forall a. (forall s. ST s a) -> a
runST
                    (do Vector s a
v <- Int -> a -> ST s (Vector s a)
forall e s. Storable e => Int -> e -> ST s (Vector s e)
SVST.new Int
sz a
forall a. C a => a
zero
                        [(Int, Vector a)]
newAcc0 <- (Vector a -> ST s (Int, Vector a))
-> [Vector a] -> ST s [(Int, Vector a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Vector s a -> Int -> Vector a -> ST s (Int, Vector a)
forall a s.
(Storable a, C a) =>
Vector s a -> Int -> T a -> ST s (Int, T a)
addToBuffer Vector s a
v Int
0) [Vector a]
acc
--                        newAcc1 <- AbsEventList.mapM (addToBuffer v) xs
                        [(Int, Vector a)]
newAcc1 <-
                           ((Int, Vector a) -> ST s (Int, Vector a))
-> [(Int, Vector a)] -> ST s [(Int, Vector a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Int
i,Vector a
s) -> Vector s a -> Int -> Vector a -> ST s (Int, Vector a)
forall a s.
(Storable a, C a) =>
Vector s a -> Int -> T a -> ST s (Int, T a)
addToBuffer Vector s a
v (Int -> Int
forall a. T a -> a
NonNeg.toNumber Int
i) Vector a
s) [(Int, Vector a)]
xs
                        Vector a
vf <- Vector s a -> ST s (Vector a)
forall e s. Storable e => Vector s e -> ST s (Vector e)
SVST.freeze Vector s a
v
                        (Vector a, [(Int, Vector a)]) -> ST s (Vector a, [(Int, Vector a)])
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector a
vf, [(Int, Vector a)]
newAcc0[(Int, Vector a)] -> [(Int, Vector a)] -> [(Int, Vector a)]
forall a. [a] -> [a] -> [a]
++[(Int, Vector a)]
newAcc1))
              ([Int]
ends, [Vector a]
suffixes) = [(Int, Vector a)] -> ([Int], [Vector a])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Int, Vector a)] -> ([Int], [Vector a]))
-> [(Int, Vector a)] -> ([Int], [Vector a])
forall a b. (a -> b) -> a -> b
$ [(Int, Vector a)]
newAcc
              prefix :: Vector a
prefix =
                 {- if there are more events to come,
                    we must pad with zeros -}
                 if T Int (Vector a) -> Bool
forall time body. T time body -> Bool
EventList.null T Int (Vector a)
future
                   then Int -> Vector a -> Vector a
forall a. Storable a => Int -> Vector a -> Vector a
SV.take ((Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 [Int]
ends) Vector a
chunk
                   else Vector a
chunk
          in  if Vector a -> Bool
forall a. Vector a -> Bool
SV.null Vector a
prefix
                then []
                else Vector a
prefix Vector a -> [Vector a] -> [Vector a]
forall a. a -> [a] -> [a]
: [Vector a] -> T Int (Vector a) -> [Vector a]
go ((Vector a -> Bool) -> [Vector a] -> [Vector a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Vector a -> Bool) -> Vector a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Bool
forall a. Storable a => Vector a -> Bool
Sig.null) [Vector a]
suffixes) T Int (Vector a)
future
   in  [Vector v] -> Vector v
forall a. Storable a => [Vector a] -> Vector a
Sig.fromChunks ([Vector v] -> Vector v)
-> (T Int (Vector v) -> [Vector v]) -> T Int (Vector v) -> Vector v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vector v] -> T Int (Vector v) -> [Vector v]
forall {a}.
(C a, Storable a) =>
[Vector a] -> T Int (Vector a) -> [Vector a]
go []


{-
{-# INLINE addToBuffer #-}
addToBuffer :: (Storable a, Additive.C a) =>
   SVST.Vector s a -> Int -> Sig.T a -> ST s (Int, Sig.T a)
addToBuffer v start =
   let n = SVST.length v
       go i [] = return (i, [])
       go i (c:cs) =
          let end = i + SV.length c
          in  addChunkToBuffer v i c >>
              if end<n
                then go end cs
                else return (n, SV.drop (end-n) c : cs)
   in  fmap (mapSnd SigSt.fromChunks) . go start . SigSt.chunks

addChunkToBuffer :: (Storable a, Additive.C a) =>
   SVST.Vector s a -> Int -> SV.Vector a -> ST s ()
addChunkToBuffer v start xs =
   let n = SVST.length v
   in  SV.foldr
          (\x continue i ->
             SVST.modify v i (x +) >>
             continue (succ i))
          (\_i -> return ())
          (Sig.take (n Additive.- start) xs)
          start
-}

{-# INLINE addToBuffer #-}
addToBuffer :: (Storable a, Additive.C a) =>
   SVST.Vector s a -> Int -> Sig.T a -> ST s (Int, Sig.T a)
addToBuffer :: forall a s.
(Storable a, C a) =>
Vector s a -> Int -> T a -> ST s (Int, T a)
addToBuffer Vector s a
v Int
start T a
xs =
   let n :: Int
n = Vector s a -> Int
forall s e. Vector s e -> Int
SVST.length Vector s a
v
       (T a
now,T a
future) = Int -> T a -> (T a, T a)
forall a. Storable a => Int -> Vector a -> (Vector a, Vector a)
Sig.splitAt (Int
n Int -> Int -> Int
forall a. C a => a -> a -> a
Additive.- Int
start) T a
xs
       go :: Int -> [Vector a] -> ST s Int
go Int
i [] = Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
       go Int
i (Vector a
c:[Vector a]
cs) =
          Vector s a -> Int -> Vector a -> ST s ()
forall a s.
(Storable a, C a) =>
Vector s a -> Int -> Vector a -> ST s ()
unsafeAddChunkToBuffer Vector s a
v Int
i Vector a
c ST s () -> ST s Int -> ST s Int
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
          Int -> [Vector a] -> ST s Int
go (Int
i Int -> Int -> Int
forall a. C a => a -> a -> a
+ Vector a -> Int
forall a. Vector a -> Int
SV.length Vector a
c) [Vector a]
cs
   in  (Int -> (Int, T a)) -> ST s Int -> ST s (Int, T a)
forall a b. (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> T a -> (Int, T a)) -> T a -> Int -> (Int, T a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) T a
future) (ST s Int -> ST s (Int, T a))
-> (T a -> ST s Int) -> T a -> ST s (Int, T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Vector a] -> ST s Int
go Int
start ([Vector a] -> ST s Int) -> (T a -> [Vector a]) -> T a -> ST s Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T a -> [Vector a]
forall a. Vector a -> [Vector a]
Sig.chunks (T a -> ST s (Int, T a)) -> T a -> ST s (Int, T a)
forall a b. (a -> b) -> a -> b
$ T a
now

{-# INLINE addChunkToBuffer #-}
addChunkToBuffer :: (Storable a, Additive.C a) =>
   SVST.Vector s a -> Int -> SV.Vector a -> ST s ()
addChunkToBuffer :: forall a s.
(Storable a, C a) =>
Vector s a -> Int -> Vector a -> ST s ()
addChunkToBuffer Vector s a
v Int
start Vector a
xs =
   if Int
start Int -> Int -> Int
forall a. C a => a -> a -> a
+ Vector a -> Int
forall a. Vector a -> Int
SV.length Vector a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Vector s a -> Int
forall s e. Vector s e -> Int
SVST.length Vector s a
v
     then Vector s a -> Int -> Vector a -> ST s ()
forall a s.
(Storable a, C a) =>
Vector s a -> Int -> Vector a -> ST s ()
unsafeAddChunkToBuffer Vector s a
v Int
start Vector a
xs
     else String -> ST s ()
forall a. HasCallStack => String -> a
error String
"Storable.addChunkToBuffer: chunk too large"

{- | chunk must fit into the buffer -}
{- This implementation will be faster as long as 'SV.foldr' is inefficient. -}
{-# INLINE unsafeAddChunkToBuffer #-}
unsafeAddChunkToBuffer :: (Storable a, Additive.C a) =>
   SVST.Vector s a -> Int -> SV.Vector a -> ST s ()
unsafeAddChunkToBuffer :: forall a s.
(Storable a, C a) =>
Vector s a -> Int -> Vector a -> ST s ()
unsafeAddChunkToBuffer Vector s a
v Int
start Vector a
xs =
   let go :: Int -> Int -> ST s ()
go Int
i Int
j =
          if Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Vector a -> Int
forall a. Vector a -> Int
SV.length Vector a
xs
            then () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            else
              Vector s a -> Int -> (a -> a) -> ST s ()
forall e s. Storable e => Vector s e -> Int -> (e -> e) -> ST s ()
SVST.unsafeModify Vector s a
v Int
i (Vector a -> Int -> a
forall a. Storable a => Vector a -> Int -> a
SV.index Vector a
xs Int
j a -> a -> a
forall a. C a => a -> a -> a
+) ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              Int -> Int -> ST s ()
go (Int
i Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
1) (Int
j Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
1)
   in  Int -> Int -> ST s ()
go Int
start Int
0

{- | chunk must fit into the buffer -}
{-# INLINE _unsafeAddChunkToBufferFoldr #-}
_unsafeAddChunkToBufferFoldr :: (Storable a, Additive.C a) =>
   SVST.Vector s a -> Int -> SV.Vector a -> ST s ()
_unsafeAddChunkToBufferFoldr :: forall a s.
(Storable a, C a) =>
Vector s a -> Int -> Vector a -> ST s ()
_unsafeAddChunkToBufferFoldr Vector s a
v Int
start Vector a
xs =
   (a -> (Int -> ST s ()) -> Int -> ST s ())
-> (Int -> ST s ()) -> Vector a -> Int -> ST s ()
forall a b. Storable a => (a -> b -> b) -> b -> Vector a -> b
SV.foldr
      (\a
x Int -> ST s ()
continue Int
i ->
         Vector s a -> Int -> (a -> a) -> ST s ()
forall e s. Storable e => Vector s e -> Int -> (e -> e) -> ST s ()
SVST.unsafeModify Vector s a
v Int
i (a
x a -> a -> a
forall a. C a => a -> a -> a
+) ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
         Int -> ST s ()
continue (Int -> Int
forall a. Enum a => a -> a
succ Int
i))
      (\Int
_i -> () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
      Vector a
xs Int
start


-- most elegant solution, but slow because StorableVector.foldr is slow
{-# INLINE _addToBufferFoldr #-}
_addToBufferFoldr :: (Storable a, Additive.C a) =>
   SVST.Vector s a -> Int -> Sig.T a -> ST s (Int, Sig.T a)
_addToBufferFoldr :: forall a s.
(Storable a, C a) =>
Vector s a -> Int -> T a -> ST s (Int, T a)
_addToBufferFoldr Vector s a
v Int
start T a
xs =
   let n :: Int
n = Vector s a -> Int
forall s e. Vector s e -> Int
SVST.length Vector s a
v
       (T a
now,T a
future) = Int -> T a -> (T a, T a)
forall a. Storable a => Int -> Vector a -> (Vector a, Vector a)
Sig.splitAt (Int
n Int -> Int -> Int
forall a. C a => a -> a -> a
Additive.- Int
start) T a
xs
   in  (a -> (Int -> ST s (Int, T a)) -> Int -> ST s (Int, T a))
-> (Int -> ST s (Int, T a)) -> T a -> Int -> ST s (Int, T a)
forall b a. Storable b => (b -> a -> a) -> a -> Vector b -> a
Sig.foldr
          (\a
x Int -> ST s (Int, T a)
continue Int
i ->
             Vector s a -> Int -> (a -> a) -> ST s ()
forall e s. Storable e => Vector s e -> Int -> (e -> e) -> ST s ()
SVST.modify Vector s a
v Int
i (a
x a -> a -> a
forall a. C a => a -> a -> a
+) ST s () -> ST s (Int, T a) -> ST s (Int, T a)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
             Int -> ST s (Int, T a)
continue (Int -> Int
forall a. Enum a => a -> a
succ Int
i))
          (\Int
i -> (Int, T a) -> ST s (Int, T a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, T a
future))
          T a
now Int
start


{-
Using @Sig.switchL@ in an inner loop
is slower than using @Sig.foldr@.
Using a StorableVectorPointer would be faster,
but I think still slower than @foldr@.
-}
_addToBufferSwitchL :: (Storable a, Additive.C a) =>
   SVST.Vector s a -> Int -> Sig.T a -> ST s (Int, Sig.T a)
_addToBufferSwitchL :: forall a s.
(Storable a, C a) =>
Vector s a -> Int -> T a -> ST s (Int, T a)
_addToBufferSwitchL Vector s a
v Int
start =
   let n :: Int
n = Vector s a -> Int
forall s e. Vector s e -> Int
SVST.length Vector s a
v
       {-# INLINE go #-}
       go :: Int -> Vector a -> ST s (Int, Vector a)
go Int
i =
          if Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
n
            then (Int, Vector a) -> ST s (Int, Vector a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Vector a) -> ST s (Int, Vector a))
-> (Vector a -> (Int, Vector a))
-> Vector a
-> ST s (Int, Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) Int
i
            else
              ST s (Int, Vector a)
-> (a -> Vector a -> ST s (Int, Vector a))
-> Vector a
-> ST s (Int, Vector a)
forall a b.
Storable a =>
b -> (a -> Vector a -> b) -> Vector a -> b
Sig.switchL
                 ((Int, Vector a) -> ST s (Int, Vector a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i, Vector a
forall a. Storable a => Vector a
Sig.empty))
                 (\a
x Vector a
xs ->
                     Vector s a -> Int -> (a -> a) -> ST s ()
forall e s. Storable e => Vector s e -> Int -> (e -> e) -> ST s ()
SVST.modify Vector s a
v Int
i (a
x a -> a -> a
forall a. C a => a -> a -> a
+) ST s () -> ST s (Int, Vector a) -> ST s (Int, Vector a)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                     Int -> Vector a -> ST s (Int, Vector a)
go (Int -> Int
forall a. Enum a => a -> a
succ Int
i) Vector a
xs)
   in  Int -> Vector a -> ST s (Int, Vector a)
go Int
start