{-# 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)



{- |
This type is very similar to 'Synthesizer.LLVM.RingBuffer.T'
but differs in several details:

* It stores values in time order,
  whereas 'Synthesizer.LLVM.RingBuffer.T' stores in opposite order.

* Since it stores future values it is not causal
  and can only track signal generators.

* There is no need for an initial value.

* It stores one value less than 'Synthesizer.LLVM.RingBuffer.T'
  since it is meant to provide infixes of the signal
  rather than providing the basis for a delay line.

Those differences in detail would not justify a new type,
you could achieve the same by a combination of
'Synthesizer.LLVM.RingBuffer.track'
and
'Synthesizer.LLVM.CausalParameterized.Process.skip'.
The fundamental problem of this combination is
that it requires to keep the ring buffer alive
longer than the providing signal exists.
This is not possible with the current design.
That's why we provide the combination of @track@ and @skip@
in a way that does not suffer from that problem.
This functionality is critical for
'Synthesizer.LLVM.CausalParameterized.Helix.dynamic'.
-}
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
   }

{- |
This function does not check for range violations.
If the ring buffer was generated by @track time@,
then the minimum index is zero and the maximum index is @time-1@.
Index zero refers to the current sample
and index @time-1@ refers to the one that is farthermost in the future.
-}
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 time signal@ bundles @time@ successive values of @signal@.
The values can be accessed using 'index' with indices
ranging from 0 to @time-1@.

The @time@ parameter must be non-negative.
-}
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 time input $* skips@
is like
@Process.skip (track time input) $* skips@
but this composition would require a @Memory@ constraint for 'T'
which we cannot provide.
-}
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)

{- |
Like @trackSkip@ but repeats the last buffer content
when the end of the input signal is reached.
The returned 'Bool' flag is 'True' if a skip could be performed completely
and it is 'False' if the skip exceeds the end of the input.
That is, once a 'False' is returned all following values are tagged with 'False'.
The returned 'Word' value is the number of actually skipped values.
This lags one step behind the input of skip values.
The number of an actual number of skips
is at most the number of requested skips.
If the flag is 'False', then the number of actual skips is zero.
The converse does not apply.

If the input signal is too short, the output is undefined.
(Before the available data the buffer will be filled with arbitrary values.)
We could fill the buffer with zeros,
but this would require an Arithmetic constraint
and the generated signal would not be very meaningful.
We could also return an empty signal if the input is too short.
However this would require a permanent check.
-}
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