{-# 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)
data T a =
Cons {
forall a. T a -> Value (MemoryPtr a)
buffer :: Value (MemoryPtr a),
forall a. T a -> Value Word
length :: Value Word,
forall a. T a -> Value Word
current :: Value Word,
forall a. T a -> 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 :: forall a r. C a => Value Word -> T a -> CodeGenFunction r a
index Value Word
i T a
rb = do
Value Word
k <- (Value Word -> Value Word -> CodeGenFunction r (Value Word))
-> Value Word -> Value Word -> CodeGenFunction r (Value Word)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value Word -> Value Word -> CodeGenFunction r (Value Word)
forall a r.
IsInteger a =>
Value a -> Value a -> CodeGenFunction r (Value a)
A.irem (T a -> Value Word
forall a. T a -> Value Word
length T a
rb) (Value Word -> CodeGenFunction r (Value Word))
-> CodeGenFunction r (Value Word) -> CodeGenFunction r (Value Word)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value Word -> Value Word -> CodeGenFunction r (Value Word)
forall a r. Additive a => a -> a -> CodeGenFunction r a
forall r.
Value Word -> Value Word -> CodeGenFunction r (Value Word)
A.add (T a -> Value Word
forall a. T a -> Value Word
current T a
rb) Value Word
i
Value (Ptr (Struct a)) -> CodeGenFunction r a
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r. Value (Ptr (Struct a)) -> CodeGenFunction r a
Memory.load (Value (Ptr (Struct a)) -> CodeGenFunction r a)
-> CodeGenFunction r (Value (Ptr (Struct a)))
-> CodeGenFunction r a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Ptr (Struct a))
-> (Value Word, ())
-> CodeGenFunction r (Value (Ptr (ElementPtrType (Struct a) ())))
forall a o i r.
(GetElementPtr o i, IsIndexArg a) =>
Value (Ptr o)
-> (a, i) -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr (T a -> Value (Ptr (Struct a))
forall a. T a -> Value (MemoryPtr a)
buffer T a
rb) (Value Word
k, ())
oldest :: (Memory.C a) => T a -> CodeGenFunction r a
oldest :: forall a r. C a => T a -> CodeGenFunction r a
oldest T a
rb =
Value (Ptr (Struct a)) -> CodeGenFunction r a
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r. Value (Ptr (Struct a)) -> CodeGenFunction r a
Memory.load (Value (Ptr (Struct a)) -> CodeGenFunction r a)
-> CodeGenFunction r (Value (Ptr (Struct a)))
-> CodeGenFunction r a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Ptr (Struct a))
-> (Value Word, ())
-> CodeGenFunction r (Value (Ptr (ElementPtrType (Struct a) ())))
forall a o i r.
(GetElementPtr o i, IsIndexArg a) =>
Value (Ptr o)
-> (a, i) -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr (T a -> Value (Ptr (Struct a))
forall a. T a -> Value (MemoryPtr a)
buffer T a
rb) (T a -> Value Word
forall a. T a -> Value Word
oldest_ T a
rb, ())
trackConstCreate :: (p -> t) -> p -> IO ((), t)
trackConstCreate :: forall p t. (p -> t) -> p -> IO ((), t)
trackConstCreate p -> t
getTime p
p = ((), t) -> IO ((), t)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((), p -> t
getTime p
p)
trackNext ::
(Memory.C al) =>
(tl -> Value Word) ->
(tl, Value (MemoryPtr al)) -> () ->
al -> Value Word ->
Maybe.T r z (T al, Value Word)
trackNext :: forall al tl r z.
C al =>
(tl -> Value Word)
-> (tl, Value (MemoryPtr al))
-> ()
-> al
-> Value Word
-> T r z (T al, Value Word)
trackNext tl -> Value Word
valueTime (tl
size,Value (MemoryPtr al)
ptr) () al
a Value Word
remain0 = CodeGenFunction r (T al, Value Word) -> T r z (T al, Value Word)
forall r a z. CodeGenFunction r a -> T r z a
Maybe.lift (CodeGenFunction r (T al, Value Word) -> T r z (T al, Value Word))
-> CodeGenFunction r (T al, Value Word) -> T r z (T al, Value Word)
forall a b. (a -> b) -> a -> b
$ do
al -> Value (MemoryPtr al) -> CodeGenFunction r ()
forall r. al -> Value (MemoryPtr al) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store al
a (Value (MemoryPtr al) -> CodeGenFunction r ())
-> CodeGenFunction r (Value (MemoryPtr al)) -> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (MemoryPtr al)
-> (Value Word, ())
-> CodeGenFunction r (Value (Ptr (ElementPtrType (Struct al) ())))
forall a o i r.
(GetElementPtr o i, IsIndexArg a) =>
Value (Ptr o)
-> (a, i) -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr Value (MemoryPtr al)
ptr (Value Word
remain0, ())
Value Bool
cont <- CmpPredicate
-> Value Word
-> Value Word
-> CodeGenFunction r (CmpResult (Value Word))
forall r.
CmpPredicate
-> Value Word
-> Value Word
-> CodeGenFunction r (CmpResult (Value Word))
forall a r.
Comparison a =>
CmpPredicate -> a -> a -> CodeGenFunction r (CmpResult a)
A.cmp CmpPredicate
LLVM.CmpGT Value Word
remain0 Value Word
forall a. Additive a => a
A.zero
let size0 :: Value Word
size0 = tl -> Value Word
valueTime tl
size
Value Word
remain1 <- Value Bool
-> Value Word
-> CodeGenFunction r (Value Word)
-> CodeGenFunction r (Value Word)
forall a r.
Select a =>
Value Bool -> a -> CodeGenFunction r a -> CodeGenFunction r a
C.ifThenSelect Value Bool
cont Value Word
size0 (Value Word -> CodeGenFunction r (Value Word)
forall a r.
(IsArithmetic a, IsConst a, Num a) =>
Value a -> CodeGenFunction r (Value a)
A.dec Value Word
remain0)
Value Word
size1 <- Value Word -> CodeGenFunction r (Value Word)
forall a r.
(IsArithmetic a, IsConst a, Num a) =>
Value a -> CodeGenFunction r (Value a)
A.inc Value Word
size0
(T al, Value Word) -> CodeGenFunction r (T al, Value Word)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (MemoryPtr al)
-> Value Word -> Value Word -> Value Word -> T al
forall a.
Value (MemoryPtr a)
-> Value Word -> Value Word -> Value Word -> T a
Cons Value (MemoryPtr al)
ptr Value Word
size1 Value Word
remain0 Value Word
remain1, Value Word
remain1)
trackStart ::
(Memory.C al) =>
(tl -> Value Word) ->
(al, tl) ->
CodeGenFunction r ((tl, Value (MemoryPtr al)), Value Word)
trackStart :: forall al tl r.
C al =>
(tl -> Value Word)
-> (al, tl)
-> CodeGenFunction r ((tl, Value (MemoryPtr al)), Value Word)
trackStart tl -> Value Word
valueTime (al
initial, tl
size) = do
let size0 :: Value Word
size0 = tl -> Value Word
valueTime tl
size
Value Word
size1 <- Value Word -> CodeGenFunction r (Value Word)
forall a r.
(IsArithmetic a, IsConst a, Num a) =>
Value a -> CodeGenFunction r (Value a)
A.inc Value Word
size0
Value (MemoryPtr al)
ptr <- Value Word -> CodeGenFunction r (Value (MemoryPtr al))
forall a r s.
(IsSized a, AllocArg s) =>
s -> CodeGenFunction r (Value (Ptr a))
LLVM.arrayMalloc Value Word
size1
Value Word
-> Value (MemoryPtr al)
-> ()
-> (Value (MemoryPtr al) -> () -> CodeGenFunction r ())
-> CodeGenFunction r ()
forall a b i r.
(Phi a, IsType b, Num i, IsConst i, IsInteger i, CmpRet i,
IsPrimitive i) =>
Value i
-> Value (Ptr b)
-> a
-> (Value (Ptr b) -> a -> CodeGenFunction r a)
-> CodeGenFunction r a
C.arrayLoop Value Word
size1 Value (MemoryPtr al)
ptr () ((Value (MemoryPtr al) -> () -> CodeGenFunction r ())
-> CodeGenFunction r ())
-> (Value (MemoryPtr al) -> () -> CodeGenFunction r ())
-> CodeGenFunction r ()
forall a b. (a -> b) -> a -> b
$ \ Value (MemoryPtr al)
ptri () ->
al -> Value (MemoryPtr al) -> CodeGenFunction r ()
forall r. al -> Value (MemoryPtr al) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store al
initial Value (MemoryPtr al)
ptri
((tl, Value (MemoryPtr al)), Value Word)
-> CodeGenFunction r ((tl, Value (MemoryPtr al)), Value Word)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ((tl
size,Value (MemoryPtr al)
ptr), Value Word
size0)
trackStop ::
(LLVM.IsType am) =>
(tl, Value (LLVM.Ptr am)) ->
Value Word ->
CodeGenFunction r ()
trackStop :: forall am tl r.
IsType am =>
(tl, Value (Ptr am)) -> Value Word -> CodeGenFunction r ()
trackStop (tl
_size,Value (Ptr am)
ptr) Value Word
_remain = Value (Ptr am) -> CodeGenFunction r ()
forall a r. IsType a => Value (Ptr a) -> CodeGenFunction r ()
LLVM.free Value (Ptr am)
ptr
trackCreate ::
(Tuple.Value a) =>
(p -> a) ->
(p -> t) ->
p ->
IO ((), (a, t))
trackCreate :: forall a p t.
Value a =>
(p -> a) -> (p -> t) -> p -> IO ((), (a, t))
trackCreate p -> a
getInitial p -> t
getTime p
p =
((), (a, t)) -> IO ((), (a, t))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((), (p -> a
getInitial p
p, p -> t
getTime p
p))
trackDelete :: () -> IO ()
trackDelete :: () -> IO ()
trackDelete () = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()