synthesizer-llvm-0.5: src/Synthesizer/LLVM/CausalParameterized/ProcessValue.hs

{-# LANGUAGE TypeFamilies #-}
{- |
This module provides functions similar to
"Synthesizer.LLVM.CausalParameterized.Process"
but expects functions that operate on 'Value.T'.
This way you can use common arithmetic operators
instead of LLVM assembly functions.
-}
module Synthesizer.LLVM.CausalParameterized.ProcessValue (
--   simple,
   mapAccum, map, mapSimple,
   ) where

import Synthesizer.LLVM.CausalParameterized.ProcessPrivate (T, )
import qualified Synthesizer.LLVM.CausalParameterized.ProcessPrivate as Causal
import qualified Synthesizer.LLVM.Parameter as Param

import qualified Synthesizer.LLVM.Simple.Value as Value

import qualified LLVM.Extra.Memory as Memory
import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )

import Foreign.Storable.Tuple ()
import Foreign.Storable (Storable, )

import Prelude hiding (map, )


{-
simple ::
   (Storable startParamTuple,
    Storable nextParamTuple,
    MakeValueTuple startParamTuple, ValueTuple startParamTuple ~ startParamValue,
    MakeValueTuple nextParamTuple, ValueTuple nextParamTuple ~ nextParamValue,
    Memory.C startParamValue,
    Memory.C nextParamValue,
    Memory.C state) =>
   (Value.T nextParamValue ->
    Value.T a -> Value.T state -> Value.Maybe (Value.T b, Value.T state)) ->
   (Value.T startParamValue -> Value.T state) ->
   Param.T p nextParamTuple ->
   Param.T p startParamTuple -> T p a b
simple f start =
   Causal.simple
      (\p a s ->
         Value.flattenMaybe $
         next
            (Value.constantValue p)
            (Value.constantValue a)
            (Value.constantValue s))
      (Value.unlift1 start)
-}

map ::
   (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl) =>
   (Value.T pl -> Value.T a -> Value.T b) ->
   Param.T p ph ->
   T p a b
map f = Causal.map (Value.unlift2 f)

mapSimple ::
   (Value.T a -> Value.T b) ->
   T p a b
mapSimple f =
   Causal.mapSimple (Value.unlift1 f)

mapAccum ::
   (Storable pnh, MakeValueTuple pnh, ValueTuple pnh ~ pnl, Memory.C pnl,
    Storable psh, MakeValueTuple psh, ValueTuple psh ~ psl, Memory.C psl,
    Memory.C s) =>
   (Value.T pnl -> Value.T a -> Value.T s -> (Value.T b, Value.T s)) ->
   (Value.T psl -> Value.T s) ->
   Param.T p pnh ->
   Param.T p psh ->
   T p a b
mapAccum next start =
   Causal.mapAccum
      (\p a s ->
         Value.flatten $
         next
            (Value.constantValue p)
            (Value.constantValue a)
            (Value.constantValue s))
      (Value.unlift1 start)