module Synthesizer.LLVM.Parameterized.SignalPrivate where
import qualified Synthesizer.LLVM.Parameter as Param
import qualified LLVM.Extra.MaybeContinuation as Maybe
import qualified LLVM.Extra.Representation as Rep
import LLVM.Core (MakeValueTuple, IsSized, CodeGenFunction, )
import LLVM.Util.Loop (Phi, )
import Control.Arrow ((&&&), )
import Foreign.Storable.Tuple ()
import Foreign.Storable (Storable, )
import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, )
data T p a =
forall state packed size ioContext
startParamTuple startParamValue startParamPacked startParamSize
nextParamTuple nextParamValue nextParamPacked nextParamSize.
(Storable startParamTuple,
Storable nextParamTuple,
MakeValueTuple startParamTuple startParamValue,
MakeValueTuple nextParamTuple nextParamValue,
Rep.Memory startParamValue startParamPacked,
Rep.Memory nextParamValue nextParamPacked,
IsSized startParamPacked startParamSize,
IsSized nextParamPacked nextParamSize,
Rep.Memory state packed,
IsSized packed size) =>
Cons
(forall r c.
(Phi c) =>
nextParamValue ->
state -> Maybe.T r c (a, state))
(forall r.
startParamValue ->
CodeGenFunction r state)
(p -> IO (ioContext, (nextParamTuple, startParamTuple)))
(ioContext -> IO ())
simple ::
(Storable startParamTuple,
Storable nextParamTuple,
MakeValueTuple startParamTuple startParamValue,
MakeValueTuple nextParamTuple nextParamValue,
Rep.Memory startParamValue startParamPacked,
Rep.Memory nextParamValue nextParamPacked,
IsSized startParamPacked startParamSize,
IsSized nextParamPacked nextParamSize,
Rep.Memory state packed,
IsSized packed size) =>
(forall r c.
(Phi c) =>
nextParamValue ->
state -> Maybe.T r c (al, state)) ->
(forall r.
startParamValue ->
CodeGenFunction r state) ->
Param.T p nextParamTuple ->
Param.T p startParamTuple -> T p al
simple f start selectParam initial = Cons
(f . Param.value selectParam)
(start . Param.value initial)
(return . (,) () . Param.get (selectParam &&& initial))
(const $ return ())
map ::
(Storable ph, MakeValueTuple ph pl, Rep.Memory pl pp, IsSized pp ps) =>
(forall r. pl -> a -> CodeGenFunction r b) ->
Param.T p ph ->
T p a -> T p b
map f selectParamF
(Cons next start createIOContext deleteIOContext) =
Cons
(\(parameterF, parameter) sa0 -> do
(a,sa1) <- next parameter sa0
b <- Maybe.lift $ f (Param.value selectParamF parameterF) a
return (b, sa1))
start
(\p -> do
(ioContext, (nextParam, startParam)) <- createIOContext p
return (ioContext, ((Param.get selectParamF p, nextParam), startParam)))
deleteIOContext
mapSimple ::
(forall r. a -> CodeGenFunction r b) ->
T p a -> T p b
mapSimple f = map (const f) (return ())
instance Functor (T p) where
fmap f = mapSimple (return . f)
iterate ::
(Storable ph, MakeValueTuple ph pl,
Rep.Memory pl pp, IsSized pp ps,
Storable a, MakeValueTuple a al,
Rep.Memory al packed, IsSized packed s) =>
(forall r. pl -> al -> CodeGenFunction r al) ->
Param.T p ph ->
Param.T p a -> T p al
iterate f selectParam initial = simple
(\pl al0 ->
Maybe.lift $ fmap (\al1 -> (al0,al1)) (f pl al0))
return
selectParam
initial