{-# LANGUAGE TypeFamilies #-}
module Synthesizer.LLVM.RingBuffer where

import qualified LLVM.Extra.MaybeContinuation as Maybe
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Control as C
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Extra.Tuple as Tuple

import qualified LLVM.Core as LLVM
import LLVM.Core (CodeGenFunction, Value)

import Data.Word (Word)

import Prelude hiding (length)


{-
I have chosen this type parameter
in order make sure that you can only retrieve from the buffer
what you have put into it.
E.g. if you store a SerialVector in it,
you can only load a SerialVector from it, but not a Vector,
although both of them use the same type for storage.
-}
data T a =
   Cons {
      buffer :: Value (MemoryPtr a),
      length :: Value Word,
      current :: Value Word,
      oldest_ :: Value Word
   }

type MemoryPtr a = LLVM.Ptr (Memory.Struct a)

{- |
This function does not check for range violations.
If the ring buffer was generated by @track initial time@,
then the minimum index is zero and the maximum index is @time@.
Index zero refers to the current sample
and index @time@ refers to the oldest one.
-}
index :: (Memory.C a) => Value Word -> T a -> CodeGenFunction r a
index i rb = do
   k <- flip A.irem (length rb) =<< A.add (current rb) i
   Memory.load =<< LLVM.getElementPtr (buffer rb) (k, ())

{- |
Fetch the oldest value in the ring buffer.
For the result of @track initial time@
this is equivalent to @index time@ but more efficient.
-}
oldest :: (Memory.C a) => T a -> CodeGenFunction r a
oldest rb =
   Memory.load =<< LLVM.getElementPtr (buffer rb) (oldest_ rb, ())


trackConstCreate :: (p -> t) -> p -> IO ((), t)
trackConstCreate getTime p = return ((), getTime p)


trackNext ::
   (Memory.C al) =>
   (tl -> Value Word) ->
   (tl, Value (MemoryPtr al)) -> () ->
   al -> Value Word ->
   Maybe.T r z (T al, Value Word)
trackNext valueTime (size,ptr) () a remain0 = Maybe.lift $ do
   Memory.store a =<< LLVM.getElementPtr ptr (remain0, ())
   cont <- A.cmp LLVM.CmpGT remain0 A.zero
   let size0 = valueTime size
   remain1 <- C.ifThenSelect cont size0 (A.dec remain0)
   size1 <- A.inc size0
   return (Cons ptr size1 remain0 remain1, remain1)

trackStart ::
   (Memory.C al) =>
   (tl -> Value Word) ->
   (al, tl) ->
   CodeGenFunction r ((tl, Value (MemoryPtr al)), Value Word)
trackStart valueTime (initial, size) = do
   let size0 = valueTime size
   size1 <- A.inc size0
   ptr <- LLVM.arrayMalloc size1
   -- cf. LLVM.Storable.Signal.fill
   C.arrayLoop size1 ptr () $ \ ptri () ->
      Memory.store initial ptri
   return ((size,ptr), size0)

trackStop ::
   (LLVM.IsType am) =>
   (tl, Value (LLVM.Ptr am)) ->
   Value Word ->
   CodeGenFunction r ()
trackStop (_size,ptr) _remain = LLVM.free ptr

trackCreate ::
   (Tuple.Value a) =>
   (p -> a) ->
   (p -> t) ->
   p ->
   IO ((), (a, t))
trackCreate getInitial getTime p =
   return ((), (getInitial p, getTime p))

trackDelete :: () -> IO ()
trackDelete () = return ()