synthesizer-llvm-0.9: src/Synthesizer/LLVM/CausalParameterized/RingBuffer.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module Synthesizer.LLVM.CausalParameterized.RingBuffer (
   T, track, trackConst,
   index, oldest,
   ) where

import Synthesizer.LLVM.RingBuffer

import qualified Synthesizer.LLVM.CausalParameterized.ProcessPrivate as CausalP
import qualified LLVM.DSL.Parameter as Param

import qualified LLVM.Extra.Marshal as Marshal
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Tuple as Tuple


{- |
@track initial time@ tracks the last @time@ sample values
including the current one.
The values before the actual input data are filled with @initial@.
The values can be accessed using 'index' with indices
ranging from 0 to @time@.

The @time@ parameter must be non-negative.

The initial value is also needed for determining the ring buffer element type.
-}
track ::
   (Marshal.C a, Tuple.ValueOf a ~ al) =>
   Param.T p a -> Param.T p Int -> CausalP.T p al (T al)
track initial time =
   Param.withValue initial $ \getInitial valueInitial ->
   Param.withValue (Param.wordInt time) $ \getTime valueTime ->
      CausalP.Cons
         (trackNext valueTime)
         (return ())
         (\(x, size) -> trackStart valueTime (valueInitial x, size))
         trackStop
         (trackCreate getInitial getTime)
         trackDelete

{- |
Initialize with zero without the need of a Haskell zero value.

We cannot get rid of the type 'a' so easily,
because we need its Storable instance
for allocating the buffer on the Haskell side.
-}
trackConst :: (Memory.C al) => al -> Param.T p Int -> CausalP.T p al (T al)
trackConst initial time =
   Param.withValue (Param.wordInt time) $ \getTime valueTime ->
      CausalP.Cons
         (trackNext valueTime)
         (return ())
         (\size -> trackStart valueTime (initial, size))
         trackStop
         (trackConstCreate getTime)
         trackDelete