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, zipWith, zipWithSimple,
   takeWhile,
   ) where

import Synthesizer.LLVM.CausalParameterized.ProcessPrivate (T, )
import qualified Synthesizer.LLVM.CausalParameterized.ProcessPrivate as CausalP
import qualified Synthesizer.LLVM.Causal.ProcessValue as CausalV
import qualified Synthesizer.LLVM.Simple.Value as Value
import qualified Synthesizer.LLVM.Parameter as Param

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

import qualified LLVM.Core as LLVM

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

import Prelude hiding (map, zipWith, takeWhile, )


{-
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 =
   CausalP.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 = CausalP.map (Value.unlift2 f)

mapSimple ::
   (Value.T a -> Value.T b) ->
   T p a b
mapSimple = CausalV.map

zipWith ::
   (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl) =>
   (Value.T pl -> Value.T a -> Value.T b -> Value.T c) ->
   Param.T p ph -> T p (a,b) c
zipWith f =
   CausalP.zipWith (Value.unlift3 f)

zipWithSimple ::
   (Value.T a -> Value.T b -> Value.T c) ->
   T p (a,b) c
zipWithSimple = CausalV.zipWith

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 =
   CausalP.mapAccum
      (Value.unlift3 next)
      (Value.unlift1 start)

takeWhile ::
   (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl) =>
   (Value.T pl -> Value.T a -> Value.T (LLVM.Value Bool)) ->
   Param.T p ph ->
   T p a a
takeWhile check =
   CausalP.takeWhile (Value.unlift2 check)