{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
{- |
Functions on lazy storable vectors that are implemented using LLVM.
-}
module Synthesizer.LLVM.Storable.Process (
   makeArranger,
   continuePacked,
   ) where

import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
import qualified Synthesizer.LLVM.Storable.Signal as SigStL
import qualified Synthesizer.CausalIO.Process as PIO

import qualified Synthesizer.Generic.Cut as CutG

import qualified Data.StorableVector as SV
import qualified Data.StorableVector.Base as SVB

import qualified Data.EventList.Relative.TimeBody  as EventList
import qualified Data.EventList.Relative.TimeTime  as EventListTT
import qualified Data.EventList.Relative.TimeMixed as EventListTM
import qualified Data.EventList.Absolute.TimeBody  as AbsEventList
import qualified Number.NonNegative as NonNeg

import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Extra.Storable as Storable
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Core as LLVM

import qualified Type.Data.Num.Decimal as TypeNum

import qualified Control.Arrow as Arr
import qualified Data.Foldable as Fold
import Foreign.Marshal.Array (advancePtr)

import qualified System.Unsafe as Unsafe

import NumericPrelude.Numeric
import NumericPrelude.Base



{-
Same algorithm as in Synthesizer.Storable.Cut.arrangeEquidist
-}
{- |
The element vectors in the event lists
must fit into the length of the event list.
-}
makeArranger ::
   (Arr.Arrow arrow, Storable.C a, Tuple.ValueOf a ~ value, A.Additive value) =>
   IO (arrow
          (EventListTT.T NonNeg.Int (SV.Vector a))
          (SV.Vector a))
makeArranger = do
   mixer <- SigStL.makeMixer A.add
   fill <- SigStL.fillBuffer A.zero
   return $ Arr.arr $ \ now ->
      let -- summation is done twice, for 'sz' and for 'xs'
          sznn = EventListTT.duration now
          sz = NonNeg.toNumber sznn
          xs =
             AbsEventList.toPairList $
             AbsEventList.mapTime NonNeg.toNumber $
             EventList.toAbsoluteEventList 0 $
             EventListTM.switchTimeR const now
      in  Unsafe.performIO $
          SVB.createAndTrim sz $ \dstPtr -> do
             fill (fromIntegral sz) dstPtr
             Fold.forM_ xs $ \(i,s) ->
                SVB.withStartPtr s $ \srcPtr len ->
                let llen =
                       if len <= sz-i
                         then fromIntegral len
                         else error "Process.arrange: chunk larger that event list"
                in  mixer llen srcPtr (advancePtr dstPtr i)
             return sz


continuePacked ::
   (CutG.Transform a, Storable.C b, LLVM.IsPrimitive b, TypeNum.Positive n) =>
   PIO.T a (SV.Vector (Serial.Plain n b)) ->
   (b -> PIO.T a (SV.Vector (Serial.Plain n b))) ->
   PIO.T a (SV.Vector (Serial.Plain n b))
continuePacked proc0 proc1 =
   PIO.continueChunk proc0
      (proc1 Arr.<<^ SV.last . SigStL.unpackStrict)