{-# 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 LLVM.DSL.Parameter as Param

import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Extra.Marshal as Marshal
import qualified LLVM.Extra.Memory as Memory

import qualified LLVM.Core as LLVM

import Prelude hiding (map, zipWith, takeWhile)


{-
simple ::
   (Storable startParamTuple,
    Storable nextParamTuple,
    Tuple.Value startParamTuple, Tuple.ValueOf startParamTuple ~ startParamValue,
    Tuple.Value nextParamTuple, Tuple.ValueOf 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 ::
   (Marshal.C ph, Tuple.ValueOf ph ~ 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 ::
   (Marshal.C ph, Tuple.ValueOf ph ~ 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 ::
   (Marshal.C pnh, Tuple.ValueOf pnh ~ pnl,
    Marshal.C psh, Tuple.ValueOf psh ~ 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 ::
   (Marshal.C ph, Tuple.ValueOf ph ~ 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)