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