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)
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)
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, ())
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
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 ()