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.Class as Class
import qualified LLVM.Core as LLVM
import LLVM.Core (CodeGenFunction, Value, )
import Data.Word (Word32, )
import Foreign.Storable.Tuple ()
import Foreign.Ptr (Ptr, )
import Prelude hiding (length, )
data T a =
Cons {
buffer :: Value (Ptr (Memory.Struct a)),
length :: Value Word32,
current :: Value Word32,
oldest_ :: Value Word32
}
index ::
(Memory.C a) =>
Value Word32 -> 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, ())
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, Memory.Struct al ~ am) =>
(tl -> Value Word32) ->
(tl, Value (Ptr am)) -> () ->
al -> Value Word32 ->
Maybe.T r z (T al, Value Word32)
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, Memory.Struct al ~ am) =>
(tl -> Value Word32) ->
(al, tl) ->
CodeGenFunction r ((tl, Value (Ptr am)), Value Word32)
trackStart valueTime (initial, size) = do
let size0 = valueTime size
size1 <- A.inc size0
ptr <- LLVM.arrayMalloc size1
C.arrayLoop size1 ptr () $ \ ptri () ->
Memory.store initial ptri
return ((size,ptr), size0)
trackStop ::
(LLVM.IsType am) =>
(tl, Value (Ptr am)) ->
Value Word32 ->
CodeGenFunction r ()
trackStop (_size,ptr) _remain = LLVM.free ptr
trackCreate ::
(Class.MakeValueTuple a, Class.ValueTuple a ~ al,
Memory.C al, Memory.Struct al ~ am) =>
(p -> a) ->
(p -> t) ->
p ->
IO ((), (a, t))
trackCreate getInitial getTime p =
return ((), (getInitial p, getTime p))
trackDelete :: () -> IO ()
trackDelete () = return ()