{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Rank2Types #-}
module Synthesizer.LLVM.Causal.RingBufferForward (
T, track, trackSkip, trackSkipHold,
index, mapIndex,
) where
import qualified Synthesizer.LLVM.Causal.Private as CausalPriv
import qualified Synthesizer.LLVM.Causal.Process as Causal
import qualified Synthesizer.LLVM.Generator.Private as Sig
import Synthesizer.LLVM.RingBuffer (MemoryPtr)
import Synthesizer.LLVM.Causal.Process (($*#))
import Synthesizer.Causal.Class (($<), ($*))
import qualified LLVM.DSL.Expression as Expr
import LLVM.DSL.Expression (Exp)
import qualified LLVM.Extra.Multi.Value as MultiValue
import qualified LLVM.Extra.MaybeContinuation as MaybeCont
import qualified LLVM.Extra.Maybe 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 qualified Control.Arrow as Arrow
import Control.Arrow ((<<<), (<<^))
import Data.Tuple.HT (mapSnd, mapPair)
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
}
index :: (Memory.C a) => MultiValue.T Word -> T a -> CodeGenFunction r a
index :: forall a r. C a => T Word -> T a -> CodeGenFunction r a
index (MultiValue.Cons Repr 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) Repr Word
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, ())
mapIndex :: (Memory.C a) => Exp Word -> Causal.T (T a) a
mapIndex :: forall a. C a => Exp Word -> T (T a) a
mapIndex Exp Word
k = (forall r. T a -> CodeGenFunction r a) -> T (T a) a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
CausalPriv.map (\T a
buf -> (T Word -> T a -> CodeGenFunction r a)
-> T a -> T Word -> CodeGenFunction r a
forall a b c. (a -> b -> c) -> b -> a -> c
flip T Word -> T a -> CodeGenFunction r a
forall a r. C a => T Word -> T a -> CodeGenFunction r a
index T a
buf (T Word -> CodeGenFunction r a)
-> CodeGenFunction r (T Word) -> CodeGenFunction r a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Exp Word -> forall r. CodeGenFunction r (T Word)
forall a. Exp a -> forall r. CodeGenFunction r (T a)
Expr.unExp Exp Word
k)
track :: (Memory.C a) => Exp Word -> Sig.T a -> Sig.T (T a)
track :: forall a. C a => Exp Word -> T a -> T (T a)
track Exp Word
time T a
input = Exp Word -> T a -> T (T Word) (T a)
forall a. C a => Exp Word -> T a -> T (T Word) (T a)
trackSkip Exp Word
time T a
input T (T Word) (T a) -> SignalOf T (T Word) -> SignalOf T (T a)
forall (process :: * -> * -> *) a b.
C process =>
process a b -> SignalOf process a -> SignalOf process b
$* SignalOf T (T Word)
T (T Word)
1
trackSkip ::
(Memory.C a) =>
Exp Word -> Sig.T a -> Causal.T (MultiValue.T Word) (T a)
trackSkip :: forall a. C a => Exp Word -> T a -> T (T Word) (T a)
trackSkip Exp Word
time (Sig.Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (a, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) =
(forall r c.
Phi c =>
(global, (Value Word, Value (Ptr (Struct a))))
-> Value (Ptr local)
-> Value Word
-> (Value Word, (state, Value Word))
-> T r c (T a, (Value Word, (state, Value Word))))
-> (forall r.
CodeGenFunction
r
((global, (Value Word, Value (Ptr (Struct a)))),
(Value Word, (state, Value Word))))
-> (forall r.
(global, (Value Word, Value (Ptr (Struct a))))
-> CodeGenFunction r ())
-> T (Value Word) (T a)
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
CausalPriv.Cons
((forall z0.
Phi z0 =>
global -> Value (Ptr local) -> state -> T r z0 (a, state))
-> (global, (Value Word, Value (Ptr (Struct a))))
-> Value (Ptr local)
-> Value Word
-> (Value Word, (state, Value Word))
-> T r c (T a, (Value Word, (state, Value Word)))
forall al z state context local r.
(C al, Phi z, Phi state, Undefined state) =>
(forall z0.
Phi z0 =>
context -> local -> state -> T r z0 (al, state))
-> (context, (Value Word, Value (MemoryPtr al)))
-> local
-> Value Word
-> (Value Word, (state, Value Word))
-> T r z (T al, (Value Word, (state, Value Word)))
trackNext global -> Value (Ptr local) -> state -> T r z0 (a, state)
forall z0.
Phi z0 =>
global -> Value (Ptr local) -> state -> T r z0 (a, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (a, state)
next)
(CodeGenFunction r (global, state)
-> Exp Word
-> CodeGenFunction
r
((global, (Value Word, Value (Ptr (Struct a)))),
(Value Word, (state, Value Word)))
forall am state r context.
(IsSized am, Phi state, Undefined state) =>
CodeGenFunction r (context, state)
-> Exp Word
-> CodeGenFunction
r
((context, (Value Word, Value (Ptr am))),
(Value Word, (state, Value Word)))
trackStart CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start Exp Word
time)
((global -> CodeGenFunction r ())
-> (global, (Value Word, Value (Ptr (Struct a))))
-> CodeGenFunction r ()
forall am context r tl.
IsType am =>
(context -> CodeGenFunction r ())
-> (context, (tl, Value (Ptr am))) -> CodeGenFunction r ()
trackStop global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop)
T (Value Word) (T a) -> (T Word -> Value Word) -> T (T Word) (T a)
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
(\(MultiValue.Cons Repr Word
skip) -> Repr Word
Value Word
skip)
trackSkipHold ::
(Memory.C a) =>
Exp Word -> Sig.T a ->
Causal.T (MultiValue.T Word) ((MultiValue.T Bool, MultiValue.T Word), T a)
trackSkipHold :: forall a.
C a =>
Exp Word -> T a -> T (T Word) ((T Bool, T Word), T a)
trackSkipHold Exp Word
time T a
xs =
T (Value Bool, Value Word) (T Bool, T Word)
-> T ((Value Bool, Value Word), T a) ((T Bool, T Word), T a)
forall b c d. T b c -> T (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Arrow.first
(T (T Word) (T Word) -> T (T Bool, T Word) (T Bool, T Word)
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arrow.second T (T Word) (T Word)
forall a.
(PseudoRing a, Real a, IntegerConstant a, Select a) =>
MV a a
clearFirst T (T Bool, T Word) (T Bool, T Word)
-> ((Value Bool, Value Word) -> (T Bool, T Word))
-> T (Value Bool, Value Word) (T Bool, T Word)
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ (Value Bool -> T Bool, Value Word -> T Word)
-> (Value Bool, Value Word) -> (T Bool, T Word)
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (Repr Bool -> T Bool
Value Bool -> T Bool
forall a. Repr a -> T a
MultiValue.Cons, Repr Word -> T Word
Value Word -> T Word
forall a. Repr a -> T a
MultiValue.Cons))
T ((Value Bool, Value Word), T a) ((T Bool, T Word), T a)
-> T (T Word) ((Value Bool, Value Word), T a)
-> T (T Word) ((T Bool, T Word), T a)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
Exp Word -> T a -> T (Value Word) ((Value Bool, Value Word), T a)
forall a.
C a =>
Exp Word -> T a -> T (Value Word) ((Value Bool, Value Word), T a)
trackSkipHold_ Exp Word
time T a
xs
T (Value Word) ((Value Bool, Value Word), T a)
-> (T Word -> Value Word)
-> T (T Word) ((Value Bool, Value Word), T a)
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
(\(MultiValue.Cons Repr Word
skip) -> Repr Word
Value Word
skip)
clearFirst ::
(MultiValue.PseudoRing a, MultiValue.Real a,
MultiValue.IntegerConstant a, MultiValue.Select a) =>
Causal.MV a a
clearFirst :: forall a.
(PseudoRing a, Real a, IntegerConstant a, Select a) =>
MV a a
clearFirst =
(Exp Bool -> Exp a -> Exp a) -> T (T Bool, T a) (T a)
forall ae a be b ce c.
(Aggregate ae a, Aggregate be b, Aggregate ce c) =>
(ae -> be -> ce) -> T (a, b) c
Causal.zipWith (\Exp Bool
b Exp a
x -> Exp Bool -> Exp a -> Exp a -> Exp a
forall a. Select a => Exp Bool -> Exp a -> Exp a -> Exp a
Expr.select Exp Bool
b Exp a
x Exp a
0)
T (T Bool, T a) (T a) -> SignalOf T (T Bool) -> T (T a) (T a)
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process a -> process b c
$< (Exp Bool -> T (T Bool) (T Bool)
forall ae a. (Aggregate ae a, C a) => ae -> T a a
Causal.delay1 Exp Bool
Expr.false T (T Bool) (T Bool) -> Bool -> T (T Bool)
forall (process :: * -> * -> *) (signal :: * -> *) a b.
(C process, SignalOf process ~ signal, C a) =>
process (T a) b -> a -> signal b
$*# Bool
True)
trackSkipHold_ ::
(Memory.C a) =>
Exp Word -> Sig.T a ->
Causal.T (Value Word) ((Value Bool, Value Word), T a)
trackSkipHold_ :: forall a.
C a =>
Exp Word -> T a -> T (Value Word) ((Value Bool, Value Word), T a)
trackSkipHold_ Exp Word
time (Sig.Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (a, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) =
(forall r c.
Phi c =>
(global, (Value Word, Value (Ptr (Struct a))))
-> Value (Ptr local)
-> Value Word
-> (Value Word, (T state, Value Word))
-> T r
c
(((Value Bool, Value Word), T a),
(Value Word, (T state, Value Word))))
-> (forall r.
CodeGenFunction
r
((global, (Value Word, Value (Ptr (Struct a)))),
(Value Word, (T state, Value Word))))
-> (forall r.
(global, (Value Word, Value (Ptr (Struct a))))
-> CodeGenFunction r ())
-> T (Value Word) ((Value Bool, Value Word), T a)
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
CausalPriv.Cons
((forall z0.
Phi z0 =>
global -> Value (Ptr local) -> state -> T r z0 (a, state))
-> (global, (Value Word, Value (Ptr (Struct a))))
-> Value (Ptr local)
-> Value Word
-> (Value Word, (T state, Value Word))
-> T r
c
(((Value Bool, Value Word), T a),
(Value Word, (T state, Value Word)))
forall al z state context local r.
(C al, Phi z, Phi state, Undefined state) =>
(forall z0.
Phi z0 =>
context -> local -> state -> T r z0 (al, state))
-> (context, (Value Word, Value (MemoryPtr al)))
-> local
-> Value Word
-> (Value Word, (T state, Value Word))
-> T r
z
(((Value Bool, Value Word), T al),
(Value Word, (T state, Value Word)))
trackNextHold global -> Value (Ptr local) -> state -> T r z0 (a, state)
forall z0.
Phi z0 =>
global -> Value (Ptr local) -> state -> T r z0 (a, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (a, state)
next)
(CodeGenFunction r (global, state)
-> Exp Word
-> CodeGenFunction
r
((global, (Value Word, Value (Ptr (Struct a)))),
(Value Word, (T state, Value Word)))
forall am state r context.
(IsSized am, Phi state, Undefined state) =>
CodeGenFunction r (context, state)
-> Exp Word
-> CodeGenFunction
r
((context, (Value Word, Value (Ptr am))),
(Value Word, (T state, Value Word)))
trackStartHold CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start Exp Word
time)
((global -> CodeGenFunction r ())
-> (global, (Value Word, Value (Ptr (Struct a))))
-> CodeGenFunction r ()
forall am context r.
IsType am =>
(context -> CodeGenFunction r ())
-> (context, (Value Word, Value (Ptr am))) -> CodeGenFunction r ()
trackStopHold global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop)
trackNext ::
(Memory.C al, Tuple.Phi z,
Tuple.Phi state, Tuple.Undefined state) =>
(forall z0. (Tuple.Phi z0) =>
context -> local -> state -> MaybeCont.T r z0 (al, state)) ->
(context, (Value Word, Value (MemoryPtr al))) -> local ->
Value Word ->
(Value Word, (state, Value Word)) ->
MaybeCont.T r z (T al, (Value Word, (state, Value Word)))
trackNext :: forall al z state context local r.
(C al, Phi z, Phi state, Undefined state) =>
(forall z0.
Phi z0 =>
context -> local -> state -> T r z0 (al, state))
-> (context, (Value Word, Value (MemoryPtr al)))
-> local
-> Value Word
-> (Value Word, (state, Value Word))
-> T r z (T al, (Value Word, (state, Value Word)))
trackNext forall z0.
Phi z0 =>
context -> local -> state -> T r z0 (al, state)
next (context
context, (Value Word
size0,Value (MemoryPtr al)
ptr)) local
local Value Word
n1 (Value Word
n0, (state, Value Word)
statePos) = do
(state
state3, Value Word
pos3) <-
CodeGenFunction r (T (state, Value Word))
-> T r z (state, Value Word)
forall z r a. Phi z => CodeGenFunction r (T a) -> T r z a
MaybeCont.fromMaybe (CodeGenFunction r (T (state, Value Word))
-> T r z (state, Value Word))
-> CodeGenFunction r (T (state, Value Word))
-> T r z (state, Value Word)
forall a b. (a -> b) -> a -> b
$ ((Value Word, T (state, Value Word)) -> T (state, Value Word))
-> CodeGenFunction r (Value Word, T (state, Value Word))
-> CodeGenFunction r (T (state, Value Word))
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value Word, T (state, Value Word)) -> T (state, Value Word)
forall a b. (a, b) -> b
snd (CodeGenFunction r (Value Word, T (state, Value Word))
-> CodeGenFunction r (T (state, Value Word)))
-> CodeGenFunction r (Value Word, T (state, Value Word))
-> CodeGenFunction r (T (state, Value Word))
forall a b. (a -> b) -> a -> b
$
Value Word
-> (state, Value Word)
-> ((state, Value Word)
-> T r (T (state, Value Word)) (state, Value Word))
-> CodeGenFunction r (Value Word, T (state, Value Word))
forall s i r.
(Phi s, Undefined s, Num i, IsConst i, IsInteger i, CmpRet i,
IsPrimitive i) =>
Value i
-> s -> (s -> T r (T s) s) -> CodeGenFunction r (Value i, T s)
MaybeCont.fixedLengthLoop Value Word
n0 (state, Value Word)
statePos (((state, Value Word)
-> T r (T (state, Value Word)) (state, Value Word))
-> CodeGenFunction r (Value Word, T (state, Value Word)))
-> ((state, Value Word)
-> T r (T (state, Value Word)) (state, Value Word))
-> CodeGenFunction r (Value Word, T (state, Value Word))
forall a b. (a -> b) -> a -> b
$ \(state
state0, Value Word
pos0) -> do
(al
a, state
state1) <- context
-> local -> state -> T r (T (state, Value Word)) (al, state)
forall z0.
Phi z0 =>
context -> local -> state -> T r z0 (al, state)
next context
context local
local state
state0
CodeGenFunction r (state, Value Word)
-> T r (T (state, Value Word)) (state, Value Word)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r (state, Value Word)
-> T r (T (state, Value Word)) (state, Value Word))
-> CodeGenFunction r (state, Value Word)
-> T r (T (state, Value Word)) (state, Value Word)
forall a b. (a -> b) -> a -> b
$
(Value Word -> (state, Value Word))
-> CodeGenFunction r (Value Word)
-> CodeGenFunction r (state, Value Word)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) state
state1) (CodeGenFunction r (Value Word)
-> CodeGenFunction r (state, Value Word))
-> CodeGenFunction r (Value Word)
-> CodeGenFunction r (state, Value Word)
forall a b. (a -> b) -> a -> b
$ (Value Word, Value (MemoryPtr al))
-> al -> Value Word -> CodeGenFunction r (Value Word)
forall al r.
C al =>
(Value Word, Value (MemoryPtr al))
-> al -> Value Word -> CodeGenFunction r (Value Word)
storeNext (Value Word
size0,Value (MemoryPtr al)
ptr) al
a Value Word
pos0
(T al, (Value Word, (state, Value Word)))
-> T r z (T al, (Value Word, (state, Value Word)))
forall a. a -> T r z a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (MemoryPtr al) -> Value Word -> Value Word -> T al
forall a. Value (MemoryPtr a) -> Value Word -> Value Word -> T a
Cons Value (MemoryPtr al)
ptr Value Word
size0 Value Word
pos3, (Value Word
n1, (state
state3, Value Word
pos3)))
trackStart ::
(LLVM.IsSized am, Tuple.Phi state, Tuple.Undefined state) =>
CodeGenFunction r (context, state) ->
Exp Word ->
CodeGenFunction r
((context, (Value Word, Value (LLVM.Ptr am))),
(Value Word, (state, Value Word)))
trackStart :: forall am state r context.
(IsSized am, Phi state, Undefined state) =>
CodeGenFunction r (context, state)
-> Exp Word
-> CodeGenFunction
r
((context, (Value Word, Value (Ptr am))),
(Value Word, (state, Value Word)))
trackStart CodeGenFunction r (context, state)
start Exp Word
size = do
(context
context, state
state) <- CodeGenFunction r (context, state)
start
~(MultiValue.Cons Repr Word
size0) <- Exp Word -> forall r. CodeGenFunction r (T Word)
forall a. Exp a -> forall r. CodeGenFunction r (T a)
Expr.unExp Exp Word
size
Value (Ptr am)
ptr <- Value Word -> CodeGenFunction r (Value (Ptr am))
forall a r s.
(IsSized a, AllocArg s) =>
s -> CodeGenFunction r (Value (Ptr a))
LLVM.arrayMalloc Repr Word
Value Word
size0
((context, (Value Word, Value (Ptr am))),
(Value Word, (state, Value Word)))
-> CodeGenFunction
r
((context, (Value Word, Value (Ptr am))),
(Value Word, (state, Value Word)))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ((context
context, (Repr Word
Value Word
size0,Value (Ptr am)
ptr)), (Repr Word
Value Word
size0, (state
state, Value Word
forall a. Additive a => a
A.zero)))
trackStop ::
(LLVM.IsType am) =>
(context -> CodeGenFunction r ()) ->
(context, (tl, Value (LLVM.Ptr am))) ->
CodeGenFunction r ()
trackStop :: forall am context r tl.
IsType am =>
(context -> CodeGenFunction r ())
-> (context, (tl, Value (Ptr am))) -> CodeGenFunction r ()
trackStop context -> CodeGenFunction r ()
stop (context
context, (tl
_size,Value (Ptr am)
ptr)) = do
Value (Ptr am) -> CodeGenFunction r ()
forall a r. IsType a => Value (Ptr a) -> CodeGenFunction r ()
LLVM.free Value (Ptr am)
ptr
context -> CodeGenFunction r ()
stop context
context
trackNextHold ::
(Memory.C al, Tuple.Phi z,
Tuple.Phi state, Tuple.Undefined state) =>
(forall z0. (Tuple.Phi z0) =>
context -> local -> state -> MaybeCont.T r z0 (al, state)) ->
(context, (Value Word, Value (MemoryPtr al))) -> local ->
Value Word ->
(Value Word, (Maybe.T state, Value Word)) ->
MaybeCont.T r z
(((Value Bool, Value Word), T al),
(Value Word, (Maybe.T state, Value Word)))
trackNextHold :: forall al z state context local r.
(C al, Phi z, Phi state, Undefined state) =>
(forall z0.
Phi z0 =>
context -> local -> state -> T r z0 (al, state))
-> (context, (Value Word, Value (MemoryPtr al)))
-> local
-> Value Word
-> (Value Word, (T state, Value Word))
-> T r
z
(((Value Bool, Value Word), T al),
(Value Word, (T state, Value Word)))
trackNextHold forall z0.
Phi z0 =>
context -> local -> state -> T r z0 (al, state)
next (context
context, (Value Word
size0,Value (MemoryPtr al)
ptr)) local
local Value Word
nNext (Value Word
n0, (T state
mstate0, Value Word
pos0)) =
CodeGenFunction
r
(((Value Bool, Value Word), T al),
(Value Word, (T state, Value Word)))
-> T r
z
(((Value Bool, Value Word), T al),
(Value Word, (T state, Value Word)))
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction
r
(((Value Bool, Value Word), T al),
(Value Word, (T state, Value Word)))
-> T r
z
(((Value Bool, Value Word), T al),
(Value Word, (T state, Value Word))))
-> CodeGenFunction
r
(((Value Bool, Value Word), T al),
(Value Word, (T state, Value Word)))
-> T r
z
(((Value Bool, Value Word), T al),
(Value Word, (T state, Value Word)))
forall a b. (a -> b) -> a -> b
$ do
(Value Word
n3, (Value Word
pos3, T state
state3)) <-
T state
-> CodeGenFunction r (Value Word, (Value Word, T state))
-> (state -> CodeGenFunction r (Value Word, (Value Word, T state)))
-> CodeGenFunction r (Value Word, (Value Word, T state))
forall b a r.
Phi b =>
T a
-> CodeGenFunction r b
-> (a -> CodeGenFunction r b)
-> CodeGenFunction r b
Maybe.run T state
mstate0
((Value Word, (Value Word, T state))
-> CodeGenFunction r (Value Word, (Value Word, T state))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value Word
n0, (Value Word
pos0, T state
mstate0)))
(\state
state0 ->
(Value Word, (state, Value Word))
-> ((Value Word, (state, Value Word))
-> CodeGenFunction
r (T (al, state), (Value Word, (Value Word, T state))))
-> (((al, state), (Value Word, (Value Word, T state)))
-> CodeGenFunction r (Value Word, (state, Value Word)))
-> CodeGenFunction r (Value Word, (Value Word, T state))
forall a r c b.
Phi a =>
a
-> (a -> CodeGenFunction r (T c, b))
-> ((c, b) -> CodeGenFunction r a)
-> CodeGenFunction r b
Maybe.loopWithExit (Value Word
n0, (state
state0, Value Word
pos0))
(\(Value Word
n1, (state
state1, Value Word
pos1)) -> do
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
n1 Value Word
forall a. Additive a => a
A.zero
((T (al, state), T state)
-> (T (al, state), (Value Word, (Value Word, T state))))
-> CodeGenFunction r (T (al, state), T state)
-> CodeGenFunction
r (T (al, state), (Value Word, (Value Word, T state)))
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((T state -> (Value Word, (Value Word, T state)))
-> (T (al, state), T state)
-> (T (al, state), (Value Word, (Value Word, T state)))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((,) Value Word
n1 ((Value Word, T state) -> (Value Word, (Value Word, T state)))
-> (T state -> (Value Word, T state))
-> T state
-> (Value Word, (Value Word, T state))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) Value Word
pos1)) (CodeGenFunction r (T (al, state), T state)
-> CodeGenFunction
r (T (al, state), (Value Word, (Value Word, T state))))
-> CodeGenFunction r (T (al, state), T state)
-> CodeGenFunction
r (T (al, state), (Value Word, (Value Word, T state)))
forall a b. (a -> b) -> a -> b
$
Value Bool
-> (T (al, state), T state)
-> CodeGenFunction r (T (al, state), T state)
-> CodeGenFunction r (T (al, state), T state)
forall a r.
Phi a =>
Value Bool -> a -> CodeGenFunction r a -> CodeGenFunction r a
C.ifThen Value Bool
cont
(T (al, state)
forall a. Undefined a => T a
Maybe.nothing, state -> T state
forall a. a -> T a
Maybe.just state
state1)
(do T (al, state)
aState <-
T r (T (al, state)) (al, state)
-> CodeGenFunction r (T (al, state))
forall a r. Undefined a => T r (T a) a -> CodeGenFunction r (T a)
MaybeCont.toMaybe (T r (T (al, state)) (al, state)
-> CodeGenFunction r (T (al, state)))
-> T r (T (al, state)) (al, state)
-> CodeGenFunction r (T (al, state))
forall a b. (a -> b) -> a -> b
$ context -> local -> state -> T r (T (al, state)) (al, state)
forall z0.
Phi z0 =>
context -> local -> state -> T r z0 (al, state)
next context
context local
local state
state1
(T (al, state), T state)
-> CodeGenFunction r (T (al, state), T state)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (T (al, state)
aState, ((al, state) -> state) -> T (al, state) -> T state
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (al, state) -> state
forall a b. (a, b) -> b
snd T (al, state)
aState)))
(\((al
a,state
state), (Value Word
n1, (Value Word
pos1, T state
_mstate))) -> do
Value Word
pos2 <- (Value Word, Value (MemoryPtr al))
-> al -> Value Word -> CodeGenFunction r (Value Word)
forall al r.
C al =>
(Value Word, Value (MemoryPtr al))
-> al -> Value Word -> CodeGenFunction r (Value Word)
storeNext (Value Word
size0,Value (MemoryPtr al)
ptr) al
a Value Word
pos1
Value Word
n2 <- 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
n1
(Value Word, (state, Value Word))
-> CodeGenFunction r (Value Word, (state, Value Word))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value Word
n2, (state
state, Value Word
pos2))))
Value Word
skipped <- 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.sub Value Word
n0 Value Word
n3
(((Value Bool, Value Word), T al),
(Value Word, (T state, Value Word)))
-> CodeGenFunction
r
(((Value Bool, Value Word), T al),
(Value Word, (T state, Value Word)))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (((T state -> Value Bool
forall a. T a -> Value Bool
Maybe.isJust T state
state3, Value Word
skipped), Value (MemoryPtr al) -> Value Word -> Value Word -> T al
forall a. Value (MemoryPtr a) -> Value Word -> Value Word -> T a
Cons Value (MemoryPtr al)
ptr Value Word
size0 Value Word
pos3),
(Value Word
nNext, (T state
state3, Value Word
pos3)))
storeNext ::
(Memory.C al) =>
(Value Word, Value (MemoryPtr al)) ->
al -> Value Word -> CodeGenFunction r (Value Word)
storeNext :: forall al r.
C al =>
(Value Word, Value (MemoryPtr al))
-> al -> Value Word -> CodeGenFunction r (Value Word)
storeNext (Value Word
size0,Value (MemoryPtr al)
ptr) al
a Value Word
pos0 = 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
pos0, ())
Value Word
pos1 <- 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
pos0
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.CmpLT Value Word
pos1 Value Word
size0
Value Bool
-> Value Word -> Value Word -> CodeGenFunction r (Value Word)
forall a r. Select a => Value Bool -> a -> a -> CodeGenFunction r a
forall r.
Value Bool
-> Value Word -> Value Word -> CodeGenFunction r (Value Word)
C.select Value Bool
cont Value Word
pos1 Value Word
forall a. Additive a => a
A.zero
trackStartHold ::
(LLVM.IsSized am,
Tuple.Phi state, Tuple.Undefined state) =>
CodeGenFunction r (context, state) ->
Exp Word ->
CodeGenFunction r
((context, (Value Word, Value (LLVM.Ptr am))),
(Value Word, (Maybe.T state, Value Word)))
trackStartHold :: forall am state r context.
(IsSized am, Phi state, Undefined state) =>
CodeGenFunction r (context, state)
-> Exp Word
-> CodeGenFunction
r
((context, (Value Word, Value (Ptr am))),
(Value Word, (T state, Value Word)))
trackStartHold CodeGenFunction r (context, state)
start Exp Word
size = do
(context
context, state
state) <- CodeGenFunction r (context, state)
start
~(MultiValue.Cons Repr Word
size0) <- Exp Word -> forall r. CodeGenFunction r (T Word)
forall a. Exp a -> forall r. CodeGenFunction r (T a)
Expr.unExp Exp Word
size
Value (Ptr am)
ptr <- Value Word -> CodeGenFunction r (Value (Ptr am))
forall a r s.
(IsSized a, AllocArg s) =>
s -> CodeGenFunction r (Value (Ptr a))
LLVM.arrayMalloc Repr Word
Value Word
size0
((context, (Value Word, Value (Ptr am))),
(Value Word, (T state, Value Word)))
-> CodeGenFunction
r
((context, (Value Word, Value (Ptr am))),
(Value Word, (T state, Value Word)))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ((context
context, (Repr Word
Value Word
size0,Value (Ptr am)
ptr)), (Repr Word
Value Word
size0, (state -> T state
forall a. a -> T a
Maybe.just state
state, Value Word
forall a. Additive a => a
A.zero)))
trackStopHold ::
(LLVM.IsType am) =>
(context -> CodeGenFunction r ()) ->
(context, (Value Word, Value (LLVM.Ptr am))) ->
CodeGenFunction r ()
trackStopHold :: forall am context r.
IsType am =>
(context -> CodeGenFunction r ())
-> (context, (Value Word, Value (Ptr am))) -> CodeGenFunction r ()
trackStopHold context -> CodeGenFunction r ()
stop (context
context, (Value Word
_size,Value (Ptr am)
ptr)) = do
Value (Ptr am) -> CodeGenFunction r ()
forall a r. IsType a => Value (Ptr a) -> CodeGenFunction r ()
LLVM.free Value (Ptr am)
ptr
context -> CodeGenFunction r ()
stop context
context