{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
module Synthesizer.LLVM.Causal.Private where

import qualified Synthesizer.LLVM.Generator.Private as Sig
import Synthesizer.LLVM.Private (getPairPtrs, noLocalPtr, unbool)

import qualified Synthesizer.Causal.Class as CausalClass
import qualified Synthesizer.Causal.Utility as ArrowUtil
import Synthesizer.Causal.Class (($>))

import qualified LLVM.DSL.Expression as Expr
import LLVM.DSL.Expression (Exp)

import qualified LLVM.Extra.Multi.Value.Marshal as Marshal
import qualified LLVM.Extra.Multi.Value as MultiValue
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.MaybeContinuation as MaybeCont
import qualified LLVM.Extra.Control as C
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Extra.Tuple as Tuple

import qualified LLVM.Core as LLVM
import LLVM.Core (CodeGenFunction)

import qualified Type.Data.Num.Decimal as TypeNum

import qualified Control.Category as Cat
import Control.Arrow (Arrow, arr, first, (&&&), (<<<))
import Control.Category (Category)
import Control.Applicative (Applicative, pure, liftA2, (<*>), (<$>))

import Data.Tuple.Strict (mapFst, zipPair)
import Data.Word (Word)

import qualified Number.Ratio as Ratio
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive

import NumericPrelude.Base hiding (map, zip, zipWith, init)

import qualified Prelude as P


data T a b =
   forall global local state.
      (Memory.C global, LLVM.IsSized local, Memory.C state) =>
      Cons (forall r c.
            (Tuple.Phi c) =>
            global -> LLVM.Value (LLVM.Ptr local) ->
            a -> state -> MaybeCont.T r c (b, state))
               -- compute next value
           (forall r. CodeGenFunction r (global, state))
               -- initial state
           (forall r. global -> CodeGenFunction r ())
               -- cleanup


type instance CausalClass.ProcessOf Sig.T = T

instance CausalClass.C T where
   type SignalOf T = Sig.T
   toSignal :: forall a. T () a -> SignalOf T a
toSignal (Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> () -> state -> T r c (a, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) = (forall r c.
 Phi c =>
 global -> Value (Ptr local) -> state -> T r c (a, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a
forall a global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> state -> T r c (a, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a
Sig.Cons
      (\global
global Value (Ptr local)
local -> global -> Value (Ptr local) -> () -> state -> T r c (a, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> () -> state -> T r c (a, state)
next global
global Value (Ptr local)
local ())
      CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start
      global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop
   fromSignal :: forall b a. SignalOf T b -> T a b
fromSignal (Sig.Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (b, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) = (forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
Cons
      (\global
global Value (Ptr local)
local a
_ -> global -> Value (Ptr local) -> state -> T r c (b, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (b, state)
next global
global Value (Ptr local)
local)
      CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start
      global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop


noGlobal ::
   (LLVM.IsSized local, Memory.C state) =>
   (forall r c.
    (Tuple.Phi c) =>
    LLVM.Value (LLVM.Ptr local) -> a -> state -> MaybeCont.T r c (b, state)) ->
   (forall r. CodeGenFunction r state) ->
   T a b
noGlobal :: forall local state a b.
(IsSized local, C state) =>
(forall r c.
 Phi c =>
 Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
noGlobal forall r c.
Phi c =>
Value (Ptr local) -> a -> state -> T r c (b, state)
next forall r. CodeGenFunction r state
start =
   (forall r c.
 Phi c =>
 () -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r ((), state))
-> (forall r. () -> CodeGenFunction r ())
-> T a b
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
Cons ((Value (Ptr local) -> a -> state -> T r c (b, state))
-> () -> Value (Ptr local) -> a -> state -> T r c (b, state)
forall a b. a -> b -> a
const Value (Ptr local) -> a -> state -> T r c (b, state)
forall r c.
Phi c =>
Value (Ptr local) -> a -> state -> T r c (b, state)
next) ((state -> ((), state))
-> CodeGenFunction r state -> CodeGenFunction r ((), state)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) ()) CodeGenFunction r state
forall r. CodeGenFunction r state
start) () -> CodeGenFunction r ()
forall a. a -> CodeGenFunction r a
forall r. () -> CodeGenFunction r ()
forall (m :: * -> *) a. Monad m => a -> m a
return

simple ::
   (Memory.C state) =>
   (forall r c. (Tuple.Phi c) => a -> state -> MaybeCont.T r c (b, state)) ->
   (forall r. CodeGenFunction r state) ->
   T a b
simple :: 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
simple forall r c. Phi c => a -> state -> T r c (b, state)
next forall r. CodeGenFunction r state
start = (forall r c.
 Phi c =>
 Value (Ptr (Struct ())) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
forall local state a b.
(IsSized local, C state) =>
(forall r c.
 Phi c =>
 Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
noGlobal ((a -> state -> T r c (b, state))
-> Value (Ptr (Struct ())) -> a -> state -> T r c (b, state)
forall f. f -> Value (Ptr (Struct ())) -> f
noLocalPtr a -> state -> T r c (b, state)
forall r c. Phi c => a -> state -> T r c (b, state)
next) CodeGenFunction r state
forall r. CodeGenFunction r state
start

mapAccum ::
   (Memory.C state) =>
   (forall r. a -> state -> CodeGenFunction r (b, state)) ->
   (forall r. CodeGenFunction r state) ->
   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
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)

map ::
   (forall r. a -> CodeGenFunction r b) ->
   T a b
map :: forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
map forall r. a -> CodeGenFunction r b
f =
   (forall r. a -> () -> CodeGenFunction r (b, ()))
-> (forall r. CodeGenFunction r ()) -> T a b
forall state a b.
C state =>
(forall r. a -> state -> CodeGenFunction r (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
mapAccum (\a
a ()
s -> (b -> (b, ())) -> CodeGenFunction r b -> CodeGenFunction r (b, ())
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> () -> (b, ())) -> () -> b -> (b, ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) ()
s) (CodeGenFunction r b -> CodeGenFunction r (b, ()))
-> CodeGenFunction r b -> CodeGenFunction r (b, ())
forall a b. (a -> b) -> a -> b
$ a -> CodeGenFunction r b
forall r. a -> CodeGenFunction r b
f a
a) (() -> CodeGenFunction r ()
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

zipWith ::
   (forall r. a -> b -> CodeGenFunction r c) ->
   T (a,b) c
zipWith :: forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
zipWith forall r. a -> b -> CodeGenFunction r c
f = (forall r. (a, b) -> CodeGenFunction r c) -> T (a, b) c
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
map ((a -> b -> CodeGenFunction r c) -> (a, b) -> CodeGenFunction r c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> CodeGenFunction r c
forall r. a -> b -> CodeGenFunction r c
f)


instance Category T where
   id :: forall a. T a a
id = (forall r. a -> CodeGenFunction r a) -> T a a
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
map a -> CodeGenFunction r a
forall a. a -> CodeGenFunction r a
forall r. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return
   Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> b -> state -> T r c (c, state)
nextB forall r. CodeGenFunction r (global, state)
startB forall r. global -> CodeGenFunction r ()
stopB . :: forall b c a. T b c -> T a b -> T a c
. Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state)
nextA forall r. CodeGenFunction r (global, state)
startA forall r. global -> CodeGenFunction r ()
stopA = (forall r c.
 Phi c =>
 (global, global)
 -> Value (Ptr (Struct (local, (local, ()))))
 -> a
 -> (state, state)
 -> T r c (c, (state, state)))
-> (forall r. CodeGenFunction r ((global, global), (state, state)))
-> (forall r. (global, global) -> CodeGenFunction r ())
-> T a c
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
Cons
      (\(global
globalA, global
globalB) Value (Ptr (Struct (local, (local, ()))))
local a
a (state
sa0,state
sb0) -> do
         (Value (Ptr local)
localA,Value (Ptr local)
localB) <- Value (Ptr (Struct (local, (local, ()))))
-> T r c (Value (Ptr local), Value (Ptr local))
forall a b r c.
Value (Ptr (Struct (a, (b, ()))))
-> T r c (Value (Ptr a), Value (Ptr b))
getPairPtrs Value (Ptr (Struct (local, (local, ()))))
local
         (b
b,state
sa1) <- global -> Value (Ptr local) -> a -> state -> T r c (b, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state)
nextA global
globalA Value (Ptr local)
localA a
a state
sa0
         (c
c,state
sb1) <- global -> Value (Ptr local) -> b -> state -> T r c (c, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> b -> state -> T r c (c, state)
nextB global
globalB Value (Ptr local)
localB b
b state
sb0
         (c, (state, state)) -> T r c (c, (state, state))
forall a. a -> T r c a
forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, (state
sa1,state
sb1)))
      (((global, state)
 -> (global, state) -> ((global, global), (state, state)))
-> CodeGenFunction r (global, state)
-> CodeGenFunction r (global, state)
-> CodeGenFunction r ((global, global), (state, state))
forall a b c.
(a -> b -> c)
-> CodeGenFunction r a
-> CodeGenFunction r b
-> CodeGenFunction r c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (global, state)
-> (global, state) -> ((global, global), (state, state))
forall a b c d. (a, b) -> (c, d) -> ((a, c), (b, d))
zipPair CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
startA CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
startB)
      (\(global
globalA, global
globalB) -> global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stopA global
globalA CodeGenFunction r ()
-> CodeGenFunction r () -> CodeGenFunction r ()
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stopB global
globalB)

instance Arrow T where
   arr :: forall b c. (b -> c) -> T b c
arr b -> c
f = (forall r. b -> CodeGenFunction r c) -> T b c
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
map (c -> CodeGenFunction r c
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> CodeGenFunction r c) -> (b -> c) -> b -> CodeGenFunction r c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
f)
   first :: forall b c d. T b c -> T (b, d) (c, d)
first (Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> b -> state -> T r c (c, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) = (forall r c.
 Phi c =>
 global
 -> Value (Ptr local) -> (b, d) -> state -> T r c ((c, d), state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T (b, d) (c, d)
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
Cons ((global -> Value (Ptr local) -> b -> state -> T r c (c, state))
-> global
-> Value (Ptr local)
-> (b, d)
-> state
-> T r c ((c, d), state)
forall (m :: * -> *) global local a s b c.
Functor m =>
(global -> local -> a -> s -> m (b, s))
-> global -> local -> (a, c) -> s -> m ((b, c), s)
firstNext global -> Value (Ptr local) -> b -> state -> T r c (c, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> b -> state -> T r c (c, state)
next) CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop

firstNext ::
   (Functor m) =>
   (global -> local -> a -> s -> m (b, s)) ->
   global -> local ->  (a, c) -> s -> m ((b, c), s)
firstNext :: forall (m :: * -> *) global local a s b c.
Functor m =>
(global -> local -> a -> s -> m (b, s))
-> global -> local -> (a, c) -> s -> m ((b, c), s)
firstNext global -> local -> a -> s -> m (b, s)
next global
global local
local (a
b,c
d) s
s0 =
   ((b, s) -> ((b, c), s)) -> m (b, s) -> m ((b, c), s)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      (\(b
c,s
s1) -> ((b
c,c
d), s
s1))
      (global -> local -> a -> s -> m (b, s)
next global
global local
local a
b s
s0)


instance Functor (T a) where
   fmap :: forall a b. (a -> b) -> T a a -> T a b
fmap = (T a a -> (a -> b) -> T a b) -> (a -> b) -> T a a -> T a b
forall a b c. (a -> b -> c) -> b -> a -> c
flip T a a -> (a -> b) -> T a b
forall a b c. T a b -> (b -> c) -> T a c
(>>^)

instance Applicative (T a) where
   pure :: forall a. a -> T a a
pure = a -> T a a
forall (arrow :: * -> * -> *) b a. Arrow arrow => b -> arrow a b
ArrowUtil.pure
   <*> :: forall a b. T a (a -> b) -> T a a -> T a b
(<*>) = T a (a -> b) -> T a a -> T a b
forall (arrow :: * -> * -> *) a b c.
Arrow arrow =>
arrow a (b -> c) -> arrow a b -> arrow a c
ArrowUtil.apply


infixr 1 >>^, ^>>

(>>^) :: T a b -> (b -> c) -> T a c
Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop >>^ :: forall a b c. T a b -> (b -> c) -> T a c
>>^ b -> c
f =
   (forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (c, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a c
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
Cons
      (\global
global Value (Ptr local)
local a
a state
state -> (b -> c) -> (b, state) -> (c, state)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst b -> c
f ((b, state) -> (c, state)) -> T r c (b, state) -> T r c (c, state)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> global -> Value (Ptr local) -> a -> state -> T r c (b, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state)
next global
global Value (Ptr local)
local a
a state
state)
      CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop

(^>>) :: (a -> b) -> T b c -> T a c
a -> b
f ^>> :: forall a b c. (a -> b) -> T b c -> T a c
^>> Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> b -> state -> T r c (c, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop =
   (forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (c, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a c
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
Cons
      (\global
global Value (Ptr local)
local -> global -> Value (Ptr local) -> b -> state -> T r c (c, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> b -> state -> T r c (c, state)
next global
global Value (Ptr local)
local (b -> state -> T r c (c, state))
-> (a -> b) -> a -> state -> T r c (c, state)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
      CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop


mapProc ::
   (forall r. b -> CodeGenFunction r c) ->
   T a b -> T a c
mapProc :: forall b c a.
(forall r. b -> CodeGenFunction r c) -> T a b -> T a c
mapProc forall r. b -> CodeGenFunction r c
f T a b
x = (forall r. b -> CodeGenFunction r c) -> T b c
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
map b -> CodeGenFunction r c
forall r. b -> CodeGenFunction r c
f T b c -> T a b -> T a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< T a b
x

zipProcWith ::
   (forall r. b -> c -> CodeGenFunction r d) ->
   T a b -> T a c -> T a d
zipProcWith :: forall b c d a.
(forall r. b -> c -> CodeGenFunction r d)
-> T a b -> T a c -> T a d
zipProcWith forall r. b -> c -> CodeGenFunction r d
f T a b
x T a c
y = (forall r. b -> c -> CodeGenFunction r d) -> T (b, c) d
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
zipWith b -> c -> CodeGenFunction r d
forall r. b -> c -> CodeGenFunction r d
f T (b, c) d -> T a (b, c) -> T a d
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< T a b
xT a b -> T a c -> T a (b, c)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&T a c
y


instance (A.Additive b) => Additive.C (T a b) where
   zero :: T a b
zero = b -> T a b
forall a. a -> T a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Additive a => a
A.zero
   negate :: T a b -> T a b
negate = (forall r. b -> CodeGenFunction r b) -> T a b -> T a b
forall b c a.
(forall r. b -> CodeGenFunction r c) -> T a b -> T a c
mapProc b -> CodeGenFunction r b
forall r. b -> CodeGenFunction r b
forall a r. Additive a => a -> CodeGenFunction r a
A.neg
   + :: T a b -> T a b -> T a b
(+) = (forall r. b -> b -> CodeGenFunction r b)
-> T a b -> T a b -> T a b
forall b c d a.
(forall r. b -> c -> CodeGenFunction r d)
-> T a b -> T a c -> T a d
zipProcWith b -> b -> CodeGenFunction r b
forall r. b -> b -> CodeGenFunction r b
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.add
   (-) = (forall r. b -> b -> CodeGenFunction r b)
-> T a b -> T a b -> T a b
forall b c d a.
(forall r. b -> c -> CodeGenFunction r d)
-> T a b -> T a c -> T a d
zipProcWith b -> b -> CodeGenFunction r b
forall r. b -> b -> CodeGenFunction r b
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.sub

instance (A.PseudoRing b, A.IntegerConstant b) => Ring.C (T a b) where
   one :: T a b
one = b -> T a b
forall a. a -> T a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. IntegerConstant a => a
A.one
   fromInteger :: Integer -> T a b
fromInteger Integer
n = b -> T a b
forall a. a -> T a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> b
forall a. IntegerConstant a => Integer -> a
A.fromInteger' Integer
n)
   * :: T a b -> T a b -> T a b
(*) = (forall r. b -> b -> CodeGenFunction r b)
-> T a b -> T a b -> T a b
forall b c d a.
(forall r. b -> c -> CodeGenFunction r d)
-> T a b -> T a c -> T a d
zipProcWith b -> b -> CodeGenFunction r b
forall r. b -> b -> CodeGenFunction r b
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
A.mul

instance (A.Field b, A.RationalConstant b) => Field.C (T a b) where
   fromRational' :: Rational -> T a b
fromRational' Rational
x = b -> T a b
forall a. a -> T a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> b
forall a. RationalConstant a => Rational -> a
A.fromRational' (Rational -> b) -> Rational -> b
forall a b. (a -> b) -> a -> b
$ Rational -> Rational
forall a. Integral a => T a -> Ratio a
Ratio.toRational98 Rational
x)
   / :: T a b -> T a b -> T a b
(/) = (forall r. b -> b -> CodeGenFunction r b)
-> T a b -> T a b -> T a b
forall b c d a.
(forall r. b -> c -> CodeGenFunction r d)
-> T a b -> T a c -> T a d
zipProcWith b -> b -> CodeGenFunction r b
forall r. b -> b -> CodeGenFunction r b
forall a r. Field a => a -> a -> CodeGenFunction r a
A.fdiv


instance (A.PseudoRing b, A.Real b, A.IntegerConstant b) => P.Num (T a b) where
   fromInteger :: Integer -> T a b
fromInteger Integer
n = b -> T a b
forall a. a -> T a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> b
forall a. IntegerConstant a => Integer -> a
A.fromInteger' Integer
n)
   negate :: T a b -> T a b
negate = (forall r. b -> CodeGenFunction r b) -> T a b -> T a b
forall b c a.
(forall r. b -> CodeGenFunction r c) -> T a b -> T a c
mapProc b -> CodeGenFunction r b
forall r. b -> CodeGenFunction r b
forall a r. Additive a => a -> CodeGenFunction r a
A.neg
   + :: T a b -> T a b -> T a b
(+) = (forall r. b -> b -> CodeGenFunction r b)
-> T a b -> T a b -> T a b
forall b c d a.
(forall r. b -> c -> CodeGenFunction r d)
-> T a b -> T a c -> T a d
zipProcWith b -> b -> CodeGenFunction r b
forall r. b -> b -> CodeGenFunction r b
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.add
   (-) = (forall r. b -> b -> CodeGenFunction r b)
-> T a b -> T a b -> T a b
forall b c d a.
(forall r. b -> c -> CodeGenFunction r d)
-> T a b -> T a c -> T a d
zipProcWith b -> b -> CodeGenFunction r b
forall r. b -> b -> CodeGenFunction r b
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.sub
   * :: T a b -> T a b -> T a b
(*) = (forall r. b -> b -> CodeGenFunction r b)
-> T a b -> T a b -> T a b
forall b c d a.
(forall r. b -> c -> CodeGenFunction r d)
-> T a b -> T a c -> T a d
zipProcWith b -> b -> CodeGenFunction r b
forall r. b -> b -> CodeGenFunction r b
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
A.mul
   abs :: T a b -> T a b
abs = (forall r. b -> CodeGenFunction r b) -> T a b -> T a b
forall b c a.
(forall r. b -> CodeGenFunction r c) -> T a b -> T a c
mapProc b -> CodeGenFunction r b
forall r. b -> CodeGenFunction r b
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: T a b -> T a b
signum = (forall r. b -> CodeGenFunction r b) -> T a b -> T a b
forall b c a.
(forall r. b -> CodeGenFunction r c) -> T a b -> T a c
mapProc b -> CodeGenFunction r b
forall r. b -> CodeGenFunction r b
forall a r. Real a => a -> CodeGenFunction r a
A.signum

instance
      (A.Field b, A.Real b, A.RationalConstant b) => P.Fractional (T a b) where
   fromRational :: Rational -> T a b
fromRational Rational
x = b -> T a b
forall a. a -> T a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> b
forall a. RationalConstant a => Rational -> a
A.fromRational' Rational
x)
   / :: T a b -> T a b -> T a b
(/) = (forall r. b -> b -> CodeGenFunction r b)
-> T a b -> T a b -> T a b
forall b c d a.
(forall r. b -> c -> CodeGenFunction r d)
-> T a b -> T a c -> T a d
zipProcWith b -> b -> CodeGenFunction r b
forall r. b -> b -> CodeGenFunction r b
forall a r. Field a => a -> a -> CodeGenFunction r a
A.fdiv


{- |
Not quite the loop of ArrowLoop
because we need a delay of one time step
and thus an initialization value.

For a real ArrowLoop.loop, that is a zero-delay loop,
we would formally need a MonadFix instance of CodeGenFunction.
But this will not become reality, since LLVM is not able to re-order code
in a way that allows to access a result before creating the input.
-}
loop ::
   (Memory.C c) =>
   (forall r. CodeGenFunction r c) -> T (a,c) (b,c) -> T a b
loop :: forall c a b.
C c =>
(forall r. CodeGenFunction r c) -> T (a, c) (b, c) -> T a b
loop forall r. CodeGenFunction r c
initial (Cons forall r c.
Phi c =>
global
-> Value (Ptr local) -> (a, c) -> state -> T r c ((b, c), state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) = (forall r c.
 Phi c =>
 global
 -> Value (Ptr local) -> a -> (c, state) -> T r c (b, (c, state)))
-> (forall r. CodeGenFunction r (global, (c, state)))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
Cons
   (\global
global Value (Ptr local)
local a
a0 (c
c0,state
s0) -> do
      ((b
b1,c
c1), state
s1) <- global
-> Value (Ptr local) -> (a, c) -> state -> T r c ((b, c), state)
forall r c.
Phi c =>
global
-> Value (Ptr local) -> (a, c) -> state -> T r c ((b, c), state)
next global
global Value (Ptr local)
local (a
a0,c
c0) state
s0
      (b, (c, state)) -> T r c (b, (c, state))
forall a. a -> T r c a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b1,(c
c1,state
s1)))
   ((c -> (global, state) -> (global, (c, state)))
-> CodeGenFunction r c
-> CodeGenFunction r (global, state)
-> CodeGenFunction r (global, (c, state))
forall a b c.
(a -> b -> c)
-> CodeGenFunction r a
-> CodeGenFunction r b
-> CodeGenFunction r c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\c
ini (global
global,state
s) -> (global
global,(c
ini,state
s))) CodeGenFunction r c
forall r. CodeGenFunction r c
initial CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start)
   global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop


replicateSerial ::
   (Tuple.Undefined a, Tuple.Phi a) =>
   Exp Word -> T a a -> T a a
replicateSerial :: forall a. (Undefined a, Phi a) => Exp Word -> T a a -> T a a
replicateSerial Exp Word
n T a a
proc =
   (\a
a -> ((),a
a)) (a -> ((), a)) -> T ((), a) a -> T a a
forall a b c. (a -> b) -> T b c -> T a c
^>> Exp Word -> T ((), a) a -> T ((), a) a
forall a c.
(Undefined a, Phi a) =>
Exp Word -> T (c, a) a -> T (c, a) a
replicateControlled Exp Word
n (((), a) -> a
forall a b. (a, b) -> b
snd(((), a) -> a) -> T a a -> T ((), a) a
forall a b c. (a -> b) -> T b c -> T a c
^>>T a a
proc)

replicateControlled ::
   (Tuple.Undefined a, Tuple.Phi a) =>
   Exp Word -> T (c,a) a -> T (c,a) a
replicateControlled :: forall a c.
(Undefined a, Phi a) =>
Exp Word -> T (c, a) a -> T (c, a) a
replicateControlled Exp Word
n (Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> (c, a) -> state -> T r c (a, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) = (forall r c.
 Phi c =>
 (Value Word,
  Value (Ptr (Struct (Struct global, (Struct state, ())))))
 -> Value (Ptr local) -> (c, a) -> () -> T r c (a, ()))
-> (forall r.
    CodeGenFunction
      r
      ((Value Word,
        Value (Ptr (Struct (Struct global, (Struct state, ()))))),
       ()))
-> (forall r.
    (Value Word,
     Value (Ptr (Struct (Struct global, (Struct state, ())))))
    -> CodeGenFunction r ())
-> T (c, a) a
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
Cons
   (\(Value Word
len,Value (Ptr (Struct (Struct global, (Struct state, ()))))
globalStates) Value (Ptr local)
local (c
c,a
a) () ->
      CodeGenFunction r (T (a, ())) -> T r c (a, ())
forall z r a. Phi z => CodeGenFunction r (T a) -> T r z a
MaybeCont.fromMaybe (CodeGenFunction r (T (a, ())) -> T r c (a, ()))
-> CodeGenFunction r (T (a, ())) -> T r c (a, ())
forall a b. (a -> b) -> a -> b
$ ((Value Word, T a) -> T (a, ()))
-> CodeGenFunction r (Value Word, T a)
-> CodeGenFunction r (T (a, ()))
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Value Word
_,T a
ms) -> (a -> () -> (a, ())) -> () -> a -> (a, ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) () (a -> (a, ())) -> T a -> T (a, ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> T a
ms) (CodeGenFunction r (Value Word, T a)
 -> CodeGenFunction r (T (a, ())))
-> CodeGenFunction r (Value Word, T a)
-> CodeGenFunction r (T (a, ()))
forall a b. (a -> b) -> a -> b
$
         Value Word
-> Value (Ptr (Struct (Struct global, (Struct state, ()))))
-> a
-> (Value (Ptr (Struct (Struct global, (Struct state, ()))))
    -> a
    -> T r
         (T (Value (Ptr (Struct (Struct global, (Struct state, ())))), a))
         a)
-> CodeGenFunction r (Value Word, T a)
forall s a i r.
(Phi s, Undefined s, IsType a, Num i, IsConst i, IsInteger i,
 CmpRet i, IsPrimitive i) =>
Value i
-> Value (Ptr a)
-> s
-> (Value (Ptr a) -> s -> T r (T (Value (Ptr a), s)) s)
-> CodeGenFunction r (Value i, T s)
MaybeCont.arrayLoop Value Word
len Value (Ptr (Struct (Struct global, (Struct state, ()))))
globalStates a
a ((Value (Ptr (Struct (Struct global, (Struct state, ()))))
  -> a
  -> T r
       (T (Value (Ptr (Struct (Struct global, (Struct state, ())))), a))
       a)
 -> CodeGenFunction r (Value Word, T a))
-> (Value (Ptr (Struct (Struct global, (Struct state, ()))))
    -> a
    -> T r
         (T (Value (Ptr (Struct (Struct global, (Struct state, ())))), a))
         a)
-> CodeGenFunction r (Value Word, T a)
forall a b. (a -> b) -> a -> b
$
               \Value (Ptr (Struct (Struct global, (Struct state, ()))))
globalStatePtr a
a0 -> do
            (global
global, state
s0) <- CodeGenFunction r (global, state)
-> T r
     (T (Value (Ptr (Struct (Struct global, (Struct state, ())))), a))
     (global, state)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r (global, state)
 -> T r
      (T (Value (Ptr (Struct (Struct global, (Struct state, ())))), a))
      (global, state))
-> CodeGenFunction r (global, state)
-> T r
     (T (Value (Ptr (Struct (Struct global, (Struct state, ())))), a))
     (global, state)
forall a b. (a -> b) -> a -> b
$ Value (Ptr (Struct (global, state)))
-> CodeGenFunction r (global, state)
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r.
Value (Ptr (Struct (global, state)))
-> CodeGenFunction r (global, state)
Memory.load Value (Ptr (Struct (global, state)))
Value (Ptr (Struct (Struct global, (Struct state, ()))))
globalStatePtr
            (a
a1,state
s1) <- global
-> Value (Ptr local)
-> (c, a)
-> state
-> T r
     (T (Value (Ptr (Struct (Struct global, (Struct state, ())))), a))
     (a, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> (c, a) -> state -> T r c (a, state)
next global
global Value (Ptr local)
local (c
c,a
a0) state
s0
            CodeGenFunction r ()
-> T r
     (T (Value (Ptr (Struct (Struct global, (Struct state, ())))), a))
     ()
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r ()
 -> T r
      (T (Value (Ptr (Struct (Struct global, (Struct state, ())))), a))
      ())
-> CodeGenFunction r ()
-> T r
     (T (Value (Ptr (Struct (Struct global, (Struct state, ())))), a))
     ()
forall a b. (a -> b) -> a -> b
$
               state -> Value (Ptr (Struct state)) -> CodeGenFunction r ()
forall r.
state -> Value (Ptr (Struct state)) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store state
s1 (Value (Ptr (Struct state)) -> CodeGenFunction r ())
-> CodeGenFunction r (Value (Ptr (Struct state)))
-> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
               Value (Ptr (Struct (Struct global, (Struct state, ()))))
-> (Proxy D1, ())
-> CodeGenFunction
     r
     (Value
        (Ptr
           (ElementPtrType
              (Struct (Struct global, (Struct state, ()))) (Proxy D1, ()))))
forall o i r.
GetElementPtr o i =>
Value (Ptr o)
-> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr0 Value (Ptr (Struct (Struct global, (Struct state, ()))))
globalStatePtr (Proxy D1
TypeNum.d1, ())
            a
-> T r
     (T (Value (Ptr (Struct (Struct global, (Struct state, ())))), a))
     a
forall a.
a
-> T r
     (T (Value (Ptr (Struct (Struct global, (Struct state, ())))), a))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a1)
   (do
      MultiValue.Cons Repr Word
len <- Exp Word -> forall r. CodeGenFunction r (T Word)
forall a. Exp a -> forall r. CodeGenFunction r (T a)
Expr.unExp Exp Word
n
      Value (Ptr (Struct (Struct global, (Struct state, ()))))
globalStates <- Value Word
-> CodeGenFunction
     r (Value (Ptr (Struct (Struct global, (Struct state, ())))))
forall a r s.
(IsSized a, AllocArg s) =>
s -> CodeGenFunction r (Value (Ptr a))
LLVM.arrayMalloc Repr Word
Value Word
len
      Value Word
-> Value (Ptr (Struct (Struct global, (Struct state, ()))))
-> ()
-> (Value (Ptr (Struct (Struct global, (Struct state, ()))))
    -> () -> CodeGenFunction r ())
-> CodeGenFunction r ()
forall a b i r.
(Phi a, IsType b, Num i, IsConst i, IsInteger i, CmpRet i,
 IsPrimitive i) =>
Value i
-> Value (Ptr b)
-> a
-> (Value (Ptr b) -> a -> CodeGenFunction r a)
-> CodeGenFunction r a
C.arrayLoop Repr Word
Value Word
len Value (Ptr (Struct (Struct global, (Struct state, ()))))
globalStates () ((Value (Ptr (Struct (Struct global, (Struct state, ()))))
  -> () -> CodeGenFunction r ())
 -> CodeGenFunction r ())
-> (Value (Ptr (Struct (Struct global, (Struct state, ()))))
    -> () -> CodeGenFunction r ())
-> CodeGenFunction r ()
forall a b. (a -> b) -> a -> b
$ \Value (Ptr (Struct (Struct global, (Struct state, ()))))
globalStatePtr () ->
         ((global, state)
 -> Value (Ptr (Struct (Struct global, (Struct state, ()))))
 -> CodeGenFunction r ())
-> Value (Ptr (Struct (Struct global, (Struct state, ()))))
-> (global, state)
-> CodeGenFunction r ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (global, state)
-> Value (Ptr (Struct (global, state))) -> CodeGenFunction r ()
(global, state)
-> Value (Ptr (Struct (Struct global, (Struct state, ()))))
-> CodeGenFunction r ()
forall r.
(global, state)
-> Value (Ptr (Struct (global, state))) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store Value (Ptr (Struct (Struct global, (Struct state, ()))))
globalStatePtr ((global, state) -> CodeGenFunction r ())
-> CodeGenFunction r (global, state) -> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start
      ((Value Word,
  Value (Ptr (Struct (Struct global, (Struct state, ()))))),
 ())
-> CodeGenFunction
     r
     ((Value Word,
       Value (Ptr (Struct (Struct global, (Struct state, ()))))),
      ())
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Repr Word
Value Word
len,Value (Ptr (Struct (Struct global, (Struct state, ()))))
globalStates), ()))
   (\(Value Word
len,Value (Ptr (Struct (Struct global, (Struct state, ()))))
globalStates) -> do
      Value Word
-> Value (Ptr (Struct (Struct global, (Struct state, ()))))
-> ()
-> (Value (Ptr (Struct (Struct global, (Struct state, ()))))
    -> () -> CodeGenFunction r ())
-> CodeGenFunction r ()
forall a b i r.
(Phi a, IsType b, Num i, IsConst i, IsInteger i, CmpRet i,
 IsPrimitive i) =>
Value i
-> Value (Ptr b)
-> a
-> (Value (Ptr b) -> a -> CodeGenFunction r a)
-> CodeGenFunction r a
C.arrayLoop Value Word
len Value (Ptr (Struct (Struct global, (Struct state, ()))))
globalStates () ((Value (Ptr (Struct (Struct global, (Struct state, ()))))
  -> () -> CodeGenFunction r ())
 -> CodeGenFunction r ())
-> (Value (Ptr (Struct (Struct global, (Struct state, ()))))
    -> () -> CodeGenFunction r ())
-> CodeGenFunction r ()
forall a b. (a -> b) -> a -> b
$ \Value (Ptr (Struct (Struct global, (Struct state, ()))))
globalStatePtr () ->
         global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop (global -> CodeGenFunction r ())
-> CodeGenFunction r global -> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Ptr (Struct global)) -> CodeGenFunction r global
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r. Value (Ptr (Struct global)) -> CodeGenFunction r global
Memory.load
            (Value (Ptr (Struct global)) -> CodeGenFunction r global)
-> CodeGenFunction r (Value (Ptr (Struct global)))
-> CodeGenFunction r global
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Ptr (Struct (Struct global, (Struct state, ()))))
-> (Proxy D0, ())
-> CodeGenFunction
     r
     (Value
        (Ptr
           (ElementPtrType
              (Struct (Struct global, (Struct state, ()))) (Proxy D0, ()))))
forall o i r.
GetElementPtr o i =>
Value (Ptr o)
-> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr0 Value (Ptr (Struct (Struct global, (Struct state, ()))))
globalStatePtr (Proxy D0
TypeNum.d0, ())
      Value (Ptr (Struct (Struct global, (Struct state, ()))))
-> CodeGenFunction r ()
forall a r. IsType a => Value (Ptr a) -> CodeGenFunction r ()
LLVM.free Value (Ptr (Struct (Struct global, (Struct state, ()))))
globalStates)

{-
We can implement 'replicateControlled' in terms of 'replicateSerial'
but this adds constraints @(Tuple.Undefined c, Tuple.Phi c)@.
-}
replicateControlledAlt ::
   (Tuple.Undefined a, Tuple.Phi a) =>
   (Tuple.Undefined c, Tuple.Phi c) =>
   Exp Word -> T (c,a) a -> T (c,a) a
replicateControlledAlt :: forall a c.
(Undefined a, Phi a, Undefined c, Phi c) =>
Exp Word -> T (c, a) a -> T (c, a) a
replicateControlledAlt Exp Word
n T (c, a) a
proc =
   Exp Word -> T (c, a) (c, a) -> T (c, a) (c, a)
forall a. (Undefined a, Phi a) => Exp Word -> T a a -> T a a
replicateSerial Exp Word
n (((c, a) -> c) -> T (c, a) c
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (c, a) -> c
forall a b. (a, b) -> a
fst T (c, a) c -> T (c, a) a -> T (c, a) (c, a)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& T (c, a) a
proc) T (c, a) (c, a) -> ((c, a) -> a) -> T (c, a) a
forall a b c. T a b -> (b -> c) -> T a c
>>^ (c, a) -> a
forall a b. (a, b) -> b
snd

replicateParallel ::
   (Tuple.Undefined b, Tuple.Phi b) =>
   Exp Word -> Sig.T b -> T (b,b) b -> T a b -> T a b
replicateParallel :: forall b a.
(Undefined b, Phi b) =>
Exp Word -> T b -> T (b, b) b -> T a b -> T a b
replicateParallel Exp Word
n T b
z T (b, b) b
cum T a b
p =
   Exp Word -> T (a, b) b -> T (a, b) b
forall a c.
(Undefined a, Phi a) =>
Exp Word -> T (c, a) a -> T (c, a) a
replicateControlled Exp Word
n (T (b, b) b
cum T (b, b) b -> T (a, b) (b, b) -> T (a, b) b
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< T a b -> T (a, b) (b, b)
forall b c d. T b c -> T (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first T a b
p) T (a, b) b -> SignalOf T b -> T a b
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process b -> process a c
$> SignalOf T b
T b
z


quantizeLift ::
   (Memory.C b, Marshal.C c, MultiValue.IntegerConstant c,
    MultiValue.Additive c, MultiValue.Comparison c) =>
   T a b -> T (MultiValue.T c, a) b
quantizeLift :: forall b c a.
(C b, C c, IntegerConstant c, Additive c, Comparison c) =>
T a b -> T (T c, a) b
quantizeLift (Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) = (forall r c.
 Phi c =>
 global
 -> Value (Ptr local)
 -> (T c, a)
 -> ((b, state), T c)
 -> T r c (b, ((b, state), T c)))
-> (forall r. CodeGenFunction r (global, ((b, state), T c)))
-> (forall r. global -> CodeGenFunction r ())
-> T (T c, a) b
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a b
Cons
   (\global
global Value (Ptr local)
local (T c
k, a
a0) ((b, state), T c)
yState0 -> do
      ((b, state)
yState1, T c
frac1) <-
         CodeGenFunction r (Value Bool, ((b, state), T c))
-> T r c ((b, state), T c)
forall z r a. Phi z => CodeGenFunction r (Value Bool, a) -> T r z a
MaybeCont.fromBool (CodeGenFunction r (Value Bool, ((b, state), T c))
 -> T r c ((b, state), T c))
-> CodeGenFunction r (Value Bool, ((b, state), T c))
-> T r c ((b, state), T c)
forall a b. (a -> b) -> a -> b
$
         (Value Bool, ((b, state), T c))
-> ((Value Bool, ((b, state), T c))
    -> CodeGenFunction r (Value Bool))
-> ((Value Bool, ((b, state), T c))
    -> CodeGenFunction r (Value Bool, ((b, state), T c)))
-> CodeGenFunction r (Value Bool, ((b, state), T c))
forall a r.
Phi a =>
a
-> (a -> CodeGenFunction r (Value Bool))
-> (a -> CodeGenFunction r a)
-> CodeGenFunction r a
C.whileLoop
            (Bool -> Value Bool
forall a. IsConst a => a -> Value a
LLVM.valueOf Bool
True, ((b, state), T c)
yState0)
            (\(Value Bool
cont1, ((b, state)
_, T c
frac0)) ->
               Value Bool
-> Value Bool -> CodeGenFunction r (BinOpValue Value Value Bool)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, IsInteger a) =>
value0 a
-> value1 a -> CodeGenFunction r (BinOpValue value0 value1 a)
LLVM.and Value Bool
cont1 (Value Bool -> CodeGenFunction r (Value Bool))
-> (T Bool -> Value Bool)
-> T Bool
-> CodeGenFunction r (Value Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T Bool -> Value Bool
unbool
                  (T Bool -> CodeGenFunction r (Value Bool))
-> CodeGenFunction r (T Bool) -> CodeGenFunction r (Value Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CmpPredicate -> T c -> T c -> CodeGenFunction r (T Bool)
forall r. CmpPredicate -> T c -> T c -> CodeGenFunction r (T Bool)
forall a r.
Comparison a =>
CmpPredicate -> T a -> T a -> CodeGenFunction r (T Bool)
MultiValue.cmp CmpPredicate
LLVM.CmpLE T c
frac0 T c
forall a. Additive a => a
A.zero)
            (\(Value Bool
_,((b
_,state
state01), T c
frac0)) ->
               T r (Value Bool, ((b, state), T c)) ((b, state), T c)
-> CodeGenFunction r (Value Bool, ((b, state), T c))
forall a r.
Undefined a =>
T r (Value Bool, a) a -> CodeGenFunction r (Value Bool, a)
MaybeCont.toBool (T r (Value Bool, ((b, state), T c)) ((b, state), T c)
 -> CodeGenFunction r (Value Bool, ((b, state), T c)))
-> T r (Value Bool, ((b, state), T c)) ((b, state), T c)
-> CodeGenFunction r (Value Bool, ((b, state), T c))
forall a b. (a -> b) -> a -> b
$ ((b, state) -> T c -> ((b, state), T c))
-> T r (Value Bool, ((b, state), T c)) (b, state)
-> T r (Value Bool, ((b, state), T c)) (T c)
-> T r (Value Bool, ((b, state), T c)) ((b, state), T c)
forall a b c.
(a -> b -> c)
-> T r (Value Bool, ((b, state), T c)) a
-> T r (Value Bool, ((b, state), T c)) b
-> T r (Value Bool, ((b, state), T c)) c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)
                  (global
-> Value (Ptr local)
-> a
-> state
-> T r (Value Bool, ((b, state), T c)) (b, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state)
next global
global Value (Ptr local)
local a
a0 state
state01)
                  (CodeGenFunction r (T c)
-> T r (Value Bool, ((b, state), T c)) (T c)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r (T c)
 -> T r (Value Bool, ((b, state), T c)) (T c))
-> CodeGenFunction r (T c)
-> T r (Value Bool, ((b, state), T c)) (T c)
forall a b. (a -> b) -> a -> b
$ T c -> T c -> CodeGenFunction r (T c)
forall a r. Additive a => a -> a -> CodeGenFunction r a
forall r. T c -> T c -> CodeGenFunction r (T c)
A.add T c
frac0 T c
k))

      T c
frac2 <- CodeGenFunction r (T c) -> T r c (T c)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r (T c) -> T r c (T c))
-> CodeGenFunction r (T c) -> T r c (T c)
forall a b. (a -> b) -> a -> b
$ T c -> T c -> CodeGenFunction r (T c)
forall a r. Additive a => a -> a -> CodeGenFunction r a
forall r. T c -> T c -> CodeGenFunction r (T c)
A.sub T c
frac1 T c
forall a. IntegerConstant a => a
A.one
      (b, ((b, state), T c)) -> T r c (b, ((b, state), T c))
forall a. a -> T r c a
forall (m :: * -> *) a. Monad m => a -> m a
return ((b, state) -> b
forall a b. (a, b) -> a
fst (b, state)
yState1, ((b, state)
yState1, T c
frac2)))
{- using this initialization code we would not need undefined values
   (do (global,s) <- start
       (a,_) <- next s
       return (global, ((a,s), A.zero))
-}
   (do
      (global
global,state
s) <- CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start
      (global, ((b, state), T c))
-> CodeGenFunction r (global, ((b, state), T c))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (global
global, ((b
forall a. Undefined a => a
Tuple.undef, state
s), T c
forall a. Additive a => a
A.zero)))
   global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop