{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Rank2Types #-}
module Synthesizer.LLVM.Causal.ProcessValue (
   Causal.T,
   mapAccum,
   fromModifier,
   ) where

import qualified Synthesizer.LLVM.Causal.Private as Causal

import qualified Synthesizer.LLVM.Value as Value

import qualified Synthesizer.Plain.Modifier as Modifier

import qualified LLVM.Extra.MaybeContinuation as MaybeCont
import qualified LLVM.Extra.Memory as Memory

import qualified LLVM.Core as LLVM

import Control.Monad.Trans.State (runState)



mapAccum ::
   (Memory.C state) =>
   (forall r. a -> state -> LLVM.CodeGenFunction r (b, state)) ->
   (forall r. LLVM.CodeGenFunction r state) ->
   Causal.T a b
mapAccum :: forall state a b.
C state =>
(forall r. a -> state -> CodeGenFunction r (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
mapAccum forall r. a -> state -> CodeGenFunction r (b, state)
next = (forall r c. Phi c => a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
forall state a b.
C state =>
(forall r c. Phi c => a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
Causal.simple (\a
a state
s -> CodeGenFunction r (b, state) -> T r c (b, state)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r (b, state) -> T r c (b, state))
-> CodeGenFunction r (b, state) -> T r c (b, state)
forall a b. (a -> b) -> a -> b
$ a -> state -> CodeGenFunction r (b, state)
forall r. a -> state -> CodeGenFunction r (b, state)
next a
a state
s)

fromModifier ::
   (Value.Flatten ah, Value.Registers ah ~ al,
    Value.Flatten bh, Value.Registers bh ~ bl,
    Value.Flatten ch, Value.Registers ch ~ cl,
    Value.Flatten sh, Value.Registers sh ~ sl,
    Memory.C sl) =>
   Modifier.Simple sh ch ah bh -> Causal.T (cl,al) bl
fromModifier :: forall ah al bh bl ch cl sh sl.
(Flatten ah, Registers ah ~ al, Flatten bh, Registers bh ~ bl,
 Flatten ch, Registers ch ~ cl, Flatten sh, Registers sh ~ sl,
 C sl) =>
Simple sh ch ah bh -> T (cl, al) bl
fromModifier (Modifier.Simple sh
initial ch -> ah -> State sh bh
step) =
   (forall r. (cl, al) -> sl -> CodeGenFunction r (bl, sl))
-> (forall r. CodeGenFunction r sl) -> T (cl, al) bl
forall state a b.
C state =>
(forall r. a -> state -> CodeGenFunction r (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
mapAccum
      (\(cl
c,al
a) sl
s ->
         (bh, sh) -> CodeGenFunction r (Registers (bh, sh))
forall value r.
Flatten value =>
value -> CodeGenFunction r (Registers value)
Value.flatten ((bh, sh) -> CodeGenFunction r (Registers (bh, sh)))
-> (bh, sh) -> CodeGenFunction r (Registers (bh, sh))
forall a b. (a -> b) -> a -> b
$
         State sh bh -> sh -> (bh, sh)
forall s a. State s a -> s -> (a, s)
runState
            (ch -> ah -> State sh bh
step (Registers ch -> ch
forall value. Flatten value => Registers value -> value
Value.unfold cl
Registers ch
c) (Registers ah -> ah
forall value. Flatten value => Registers value -> value
Value.unfold al
Registers ah
a))
            (Registers sh -> sh
forall value. Flatten value => Registers value -> value
Value.unfold sl
Registers sh
s))
      (sh -> CodeGenFunction r (Registers sh)
forall value r.
Flatten value =>
value -> CodeGenFunction r (Registers value)
Value.flatten sh
initial)