{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}
module Synthesizer.LLVM.Causal.FunctionalPlug (
   T,
   ($&), (&|&),
   run, runPlugOut,
   fromSignal, plug, askParameter, Input,
   withArgs, withArgsPlugOut,
   MakeArguments, Arguments, makeArgs,
   ) where

import qualified Synthesizer.LLVM.Plug.Input as PIn
import qualified Synthesizer.LLVM.Plug.Output as POut

import qualified Synthesizer.LLVM.Causal.Parameterized as Parameterized
import qualified Synthesizer.LLVM.Causal.Render as CausalRender
import qualified Synthesizer.LLVM.Causal.Private as CausalPriv
import qualified Synthesizer.LLVM.Causal.Process as Causal
import qualified Synthesizer.LLVM.Generator.Signal as Sig

import qualified Synthesizer.Causal.Class as CausalClass
import qualified Synthesizer.CausalIO.Process as PIO
import qualified Synthesizer.Generic.Cut as CutG
import qualified Synthesizer.Zip as Zip

import qualified Data.EventList.Relative.BodyTime as EventListBT
import qualified Data.StorableVector as SV

import LLVM.DSL.Expression (Exp(Exp))

import qualified LLVM.Extra.Multi.Value.Marshal as Marshal
import qualified LLVM.Extra.MaybeContinuation as MaybeCont
import qualified LLVM.Extra.Arithmetic as A
import LLVM.Core (CodeGenFunction)

import Data.IORef (newIORef, readIORef)

import qualified Number.Ratio as Ratio
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Algebraic as Algebraic
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive

import qualified Control.Monad.Trans.Reader as MR
import qualified Control.Monad.Trans.State as MS
import Control.Monad.IO.Class (liftIO)

import qualified Data.Set as Set
import qualified Data.Vault.Lazy as Vault
import Data.Vault.Lazy (Vault)
import Data.Unique (Unique, newUnique)
import Data.Maybe (fromMaybe)

import Control.Arrow ((^<<), (<<^), arr, first, second)
import Control.Category (id, (.))
import Control.Applicative (Applicative, (<*>), pure, liftA2, liftA3)

import qualified System.Unsafe as Unsafe

import Prelude hiding (id, (.))


{- |
This data type detects sharing.
-}
{-
There are two levels of the use of keys.
At the top level, in T's State monad,
we store an object id in order to check,
whether we have already seen a certain object.
If we encounter a known object
then we use the Simple constructor
and fetch the stored CausalP output
within the causal process enclosed in Simple.
This and the causal process in the Plugged constructor
are the second level.
These arrows handle a Vault like a state monad
and insert all values they produce into the Vault.
-}
newtype T pp inp out =
   Cons (MS.State (Set.Set Unique) (Core pp inp out))

{-
We need to hide the x and y types
since these types grow when combining Cores,
and then we could not define numeric instances.
-}
data Core pp inp out =
   forall x y. CutG.Read x =>
   Plugged
      (pp -> inp -> x)
      (PIn.T x y)
      (Causal.T (y, Vault) (out, Vault))
   |
   {-
   The Simple constructor is needed for reusing shared CausalP processes
   and for input without external representation. (a Plug.Input)
   -}
   Simple (Causal.T Vault (out, Vault))


applyCore ::
   Causal.T (a, Vault) (b, Vault) ->
   Core pp inp a ->
   Core pp inp b
applyCore :: forall a b pp inp.
T (a, Vault) (b, Vault) -> Core pp inp a -> Core pp inp b
applyCore T (a, Vault) (b, Vault)
f Core pp inp a
core =
   case Core pp inp a
core of
      Plugged pp -> inp -> x
prep T x y
plg T (y, Vault) (a, Vault)
process -> (pp -> inp -> x)
-> T x y -> T (y, Vault) (b, Vault) -> Core pp inp b
forall pp inp out x y.
Read x =>
(pp -> inp -> x)
-> T x y -> T (y, Vault) (out, Vault) -> Core pp inp out
Plugged pp -> inp -> x
prep T x y
plg (T (a, Vault) (b, Vault)
f T (a, Vault) (b, Vault)
-> T (y, Vault) (a, Vault) -> T (y, Vault) (b, Vault)
forall b c a. 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 (y, Vault) (a, Vault)
process)
      Simple T Vault (a, Vault)
process -> T Vault (b, Vault) -> Core pp inp b
forall pp inp out. T Vault (out, Vault) -> Core pp inp out
Simple (T (a, Vault) (b, Vault)
f T (a, Vault) (b, Vault) -> T Vault (a, Vault) -> T Vault (b, Vault)
forall b c a. 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 Vault (a, Vault)
process)

combineCore ::
   Core pp inp a ->
   Core pp inp b ->
   Core pp inp (a,b)
combineCore :: forall pp inp a b.
Core pp inp a -> Core pp inp b -> Core pp inp (a, b)
combineCore (Plugged pp -> inp -> x
prepA T x y
plugA T (y, Vault) (a, Vault)
processA) (Plugged pp -> inp -> x
prepB T x y
plugB T (y, Vault) (b, Vault)
processB) =
   (pp -> inp -> T x x)
-> T (T x x) (y, y)
-> T ((y, y), Vault) ((a, b), Vault)
-> Core pp inp (a, b)
forall pp inp out x y.
Read x =>
(pp -> inp -> x)
-> T x y -> T (y, Vault) (out, Vault) -> Core pp inp out
Plugged
      (\pp
p -> (inp -> x) -> (inp -> x) -> inp -> T x x
forall (arrow :: * -> * -> *) a b c.
Arrow arrow =>
arrow a b -> arrow a c -> arrow a (T b c)
Zip.arrowFanout (pp -> inp -> x
prepA pp
p) (pp -> inp -> x
prepB pp
p))
      (T x y -> T x y -> T (T x x) (y, y)
forall a c b d. T a c -> T b d -> T (T a b) (c, d)
PIn.split T x y
plugA T x y
plugB)
      ((\(a
a,(b
b,Vault
v)) -> ((a
a,b
b), Vault
v)) ((a, (b, Vault)) -> ((a, b), Vault))
-> T ((y, y), Vault) (a, (b, Vault))
-> T ((y, y), Vault) ((a, b), Vault)
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< T (y, Vault) (b, Vault) -> T (a, (y, Vault)) (a, (b, Vault))
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second T (y, Vault) (b, Vault)
processB
       T (a, (y, Vault)) (a, (b, Vault))
-> T ((y, Vault), y) (a, (y, Vault))
-> T ((y, Vault), y) (a, (b, Vault))
forall b c a. 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
. (((a, Vault), y) -> (a, (y, Vault)))
-> T ((a, Vault), y) (a, (y, Vault))
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\((a
a,Vault
v),y
b) -> (a
a,(y
b,Vault
v))) T ((a, Vault), y) (a, (y, Vault))
-> T ((y, Vault), y) ((a, Vault), y)
-> T ((y, Vault), y) (a, (y, Vault))
forall b c a. 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 (y, Vault) (a, Vault) -> T ((y, Vault), y) ((a, Vault), y)
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 (y, Vault) (a, Vault)
processA T ((y, Vault), y) (a, (b, Vault))
-> (((y, y), Vault) -> ((y, Vault), y))
-> T ((y, y), Vault) (a, (b, Vault))
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ (\((y
a,y
b),Vault
v) -> ((y
a,Vault
v),y
b)))
combineCore (Simple T Vault (a, Vault)
processA) (Plugged pp -> inp -> x
prepB T x y
plugB T (y, Vault) (b, Vault)
processB) =
   (pp -> inp -> x)
-> T x y -> T (y, Vault) ((a, b), Vault) -> Core pp inp (a, b)
forall pp inp out x y.
Read x =>
(pp -> inp -> x)
-> T x y -> T (y, Vault) (out, Vault) -> Core pp inp out
Plugged pp -> inp -> x
prepB T x y
plugB
      ((\(b
b,(a
a,Vault
v)) -> ((a
a,b
b), Vault
v)) ((b, (a, Vault)) -> ((a, b), Vault))
-> T (y, Vault) (b, (a, Vault)) -> T (y, Vault) ((a, b), Vault)
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< T Vault (a, Vault) -> T (b, Vault) (b, (a, Vault))
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second T Vault (a, Vault)
processA T (b, Vault) (b, (a, Vault))
-> T (y, Vault) (b, Vault) -> T (y, Vault) (b, (a, Vault))
forall b c a. 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 (y, Vault) (b, Vault)
processB)
combineCore (Plugged pp -> inp -> x
prepA T x y
plugA T (y, Vault) (a, Vault)
processA) (Simple T Vault (b, Vault)
processB) =
   (pp -> inp -> x)
-> T x y -> T (y, Vault) ((a, b), Vault) -> Core pp inp (a, b)
forall pp inp out x y.
Read x =>
(pp -> inp -> x)
-> T x y -> T (y, Vault) (out, Vault) -> Core pp inp out
Plugged pp -> inp -> x
prepA T x y
plugA
      ((\(a
a,(b
b,Vault
v)) -> ((a
a,b
b), Vault
v)) ((a, (b, Vault)) -> ((a, b), Vault))
-> T (y, Vault) (a, (b, Vault)) -> T (y, Vault) ((a, b), Vault)
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< T Vault (b, Vault) -> T (a, Vault) (a, (b, Vault))
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second T Vault (b, Vault)
processB T (a, Vault) (a, (b, Vault))
-> T (y, Vault) (a, Vault) -> T (y, Vault) (a, (b, Vault))
forall b c a. 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 (y, Vault) (a, Vault)
processA)
combineCore (Simple T Vault (a, Vault)
processA) (Simple T Vault (b, Vault)
processB) =
   T Vault ((a, b), Vault) -> Core pp inp (a, b)
forall pp inp out. T Vault (out, Vault) -> Core pp inp out
Simple ((\(a
a,(b
b,Vault
v)) -> ((a
a,b
b), Vault
v)) ((a, (b, Vault)) -> ((a, b), Vault))
-> T Vault (a, (b, Vault)) -> T Vault ((a, b), Vault)
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< T Vault (b, Vault) -> T (a, Vault) (a, (b, Vault))
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second T Vault (b, Vault)
processB T (a, Vault) (a, (b, Vault))
-> T Vault (a, Vault) -> T Vault (a, (b, Vault))
forall b c a. 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 Vault (a, Vault)
processA)


reuseCore :: Vault.Key out -> Core pp inp out
reuseCore :: forall out pp inp. Key out -> Core pp inp out
reuseCore Key out
key =
   T Vault (out, Vault) -> Core pp inp out
forall pp inp out. T Vault (out, Vault) -> Core pp inp out
Simple (T Vault (out, Vault) -> Core pp inp out)
-> T Vault (out, Vault) -> Core pp inp out
forall a b. (a -> b) -> a -> b
$ (Vault -> (out, Vault)) -> T Vault (out, Vault)
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((Vault -> (out, Vault)) -> T Vault (out, Vault))
-> (Vault -> (out, Vault)) -> T Vault (out, Vault)
forall a b. (a -> b) -> a -> b
$ \Vault
vault ->
      (out -> Maybe out -> out
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> out
forall a. HasCallStack => [Char] -> a
error [Char]
"key must have been lost") (Maybe out -> out) -> Maybe out -> out
forall a b. (a -> b) -> a -> b
$ Key out -> Vault -> Maybe out
forall a. Key a -> Vault -> Maybe a
Vault.lookup Key out
key Vault
vault,
       Vault
vault)


tag ::
   Unique -> Vault.Key out ->
   MS.State (Set.Set Unique) (Core pp inp out) ->
   T pp inp out
tag :: forall out pp inp.
Unique
-> Key out -> State (Set Unique) (Core pp inp out) -> T pp inp out
tag Unique
unique Key out
key State (Set Unique) (Core pp inp out)
stateCore = State (Set Unique) (Core pp inp out) -> T pp inp out
forall pp inp out.
State (Set Unique) (Core pp inp out) -> T pp inp out
Cons (State (Set Unique) (Core pp inp out) -> T pp inp out)
-> State (Set Unique) (Core pp inp out) -> T pp inp out
forall a b. (a -> b) -> a -> b
$ do
   Bool
alreadySeen <- (Set Unique -> Bool) -> StateT (Set Unique) Identity Bool
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
MS.gets (Unique -> Set Unique -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Unique
unique)
   if Bool
alreadySeen
      then Core pp inp out -> State (Set Unique) (Core pp inp out)
forall a. a -> StateT (Set Unique) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Core pp inp out -> State (Set Unique) (Core pp inp out))
-> Core pp inp out -> State (Set Unique) (Core pp inp out)
forall a b. (a -> b) -> a -> b
$ Key out -> Core pp inp out
forall out pp inp. Key out -> Core pp inp out
reuseCore Key out
key
      else do
         (Set Unique -> Set Unique) -> StateT (Set Unique) Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
MS.modify (Unique -> Set Unique -> Set Unique
forall a. Ord a => a -> Set a -> Set a
Set.insert Unique
unique)
         (Core pp inp out -> Core pp inp out)
-> State (Set Unique) (Core pp inp out)
-> State (Set Unique) (Core pp inp out)
forall a b.
(a -> b)
-> StateT (Set Unique) Identity a -> StateT (Set Unique) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (T (out, Vault) (out, Vault) -> Core pp inp out -> Core pp inp out
forall a b pp inp.
T (a, Vault) (b, Vault) -> Core pp inp a -> Core pp inp b
applyCore (((out, Vault) -> (out, Vault)) -> T (out, Vault) (out, Vault)
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (((out, Vault) -> (out, Vault)) -> T (out, Vault) (out, Vault))
-> ((out, Vault) -> (out, Vault)) -> T (out, Vault) (out, Vault)
forall a b. (a -> b) -> a -> b
$ \(out
a,Vault
v) -> (out
a, Key out -> out -> Vault -> Vault
forall a. Key a -> a -> Vault -> Vault
Vault.insert Key out
key out
a Vault
v))) State (Set Unique) (Core pp inp out)
stateCore

tagUnique ::
   MS.State (Set.Set Unique) (Core pp inp out) ->
   T pp inp out
tagUnique :: forall pp inp out.
State (Set Unique) (Core pp inp out) -> T pp inp out
tagUnique State (Set Unique) (Core pp inp out)
core =
   IO (T pp inp out) -> T pp inp out
forall a. IO a -> a
Unsafe.performIO (IO (T pp inp out) -> T pp inp out)
-> IO (T pp inp out) -> T pp inp out
forall a b. (a -> b) -> a -> b
$
   (Unique
 -> Key out -> State (Set Unique) (Core pp inp out) -> T pp inp out)
-> IO Unique
-> IO (Key out)
-> IO (State (Set Unique) (Core pp inp out))
-> IO (T pp inp out)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 Unique
-> Key out -> State (Set Unique) (Core pp inp out) -> T pp inp out
forall out pp inp.
Unique
-> Key out -> State (Set Unique) (Core pp inp out) -> T pp inp out
tag IO Unique
newUnique IO (Key out)
forall a. IO (Key a)
Vault.newKey (State (Set Unique) (Core pp inp out)
-> IO (State (Set Unique) (Core pp inp out))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure State (Set Unique) (Core pp inp out)
core)


infixr 0 $&

($&) ::
   Causal.T a b ->
   T pp inp a ->
   T pp inp b
T a b
f  $& :: forall a b pp inp. T a b -> T pp inp a -> T pp inp b
$&  Cons State (Set Unique) (Core pp inp a)
core =
   State (Set Unique) (Core pp inp b) -> T pp inp b
forall pp inp out.
State (Set Unique) (Core pp inp out) -> T pp inp out
tagUnique (State (Set Unique) (Core pp inp b) -> T pp inp b)
-> State (Set Unique) (Core pp inp b) -> T pp inp b
forall a b. (a -> b) -> a -> b
$ (Core pp inp a -> Core pp inp b)
-> State (Set Unique) (Core pp inp a)
-> State (Set Unique) (Core pp inp b)
forall a b.
(a -> b)
-> StateT (Set Unique) Identity a -> StateT (Set Unique) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (T (a, Vault) (b, Vault) -> Core pp inp a -> Core pp inp b
forall a b pp inp.
T (a, Vault) (b, Vault) -> Core pp inp a -> Core pp inp b
applyCore (T (a, Vault) (b, Vault) -> Core pp inp a -> Core pp inp b)
-> T (a, Vault) (b, Vault) -> Core pp inp a -> Core pp inp b
forall a b. (a -> b) -> a -> b
$ T a b -> T (a, Vault) (b, Vault)
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
f) State (Set Unique) (Core pp inp a)
core


infixr 3 &|&

(&|&) ::
   T pp inp a ->
   T pp inp b ->
   T pp inp (a,b)
Cons State (Set Unique) (Core pp inp a)
coreA  &|& :: forall pp inp a b. T pp inp a -> T pp inp b -> T pp inp (a, b)
&|&  Cons State (Set Unique) (Core pp inp b)
coreB =
   State (Set Unique) (Core pp inp (a, b)) -> T pp inp (a, b)
forall pp inp out.
State (Set Unique) (Core pp inp out) -> T pp inp out
tagUnique (State (Set Unique) (Core pp inp (a, b)) -> T pp inp (a, b))
-> State (Set Unique) (Core pp inp (a, b)) -> T pp inp (a, b)
forall a b. (a -> b) -> a -> b
$ (Core pp inp a -> Core pp inp b -> Core pp inp (a, b))
-> State (Set Unique) (Core pp inp a)
-> State (Set Unique) (Core pp inp b)
-> State (Set Unique) (Core pp inp (a, b))
forall a b c.
(a -> b -> c)
-> StateT (Set Unique) Identity a
-> StateT (Set Unique) Identity b
-> StateT (Set Unique) Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Core pp inp a -> Core pp inp b -> Core pp inp (a, b)
forall pp inp a b.
Core pp inp a -> Core pp inp b -> Core pp inp (a, b)
combineCore State (Set Unique) (Core pp inp a)
coreA State (Set Unique) (Core pp inp b)
coreB


instance Functor (Core pp inp) where
   fmap :: forall a b. (a -> b) -> Core pp inp a -> Core pp inp b
fmap a -> b
f (Simple T Vault (a, Vault)
process) = T Vault (b, Vault) -> Core pp inp b
forall pp inp out. T Vault (out, Vault) -> Core pp inp out
Simple (((a, Vault) -> (b, Vault))
-> T Vault (a, Vault) -> T Vault (b, Vault)
forall a b. (a -> b) -> T Vault a -> T Vault b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a, Vault) -> (b, Vault)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> b
f) T Vault (a, Vault)
process)
   fmap a -> b
f (Plugged pp -> inp -> x
prep T x y
plg T (y, Vault) (a, Vault)
process) = (pp -> inp -> x)
-> T x y -> T (y, Vault) (b, Vault) -> Core pp inp b
forall pp inp out x y.
Read x =>
(pp -> inp -> x)
-> T x y -> T (y, Vault) (out, Vault) -> Core pp inp out
Plugged pp -> inp -> x
prep T x y
plg (((a, Vault) -> (b, Vault))
-> T (y, Vault) (a, Vault) -> T (y, Vault) (b, Vault)
forall a b. (a -> b) -> T (y, Vault) a -> T (y, Vault) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a, Vault) -> (b, Vault)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> b
f) T (y, Vault) (a, Vault)
process)

instance Applicative (Core pp inp) where
   pure :: forall a. a -> Core pp inp a
pure a
a = (forall r. CodeGenFunction r a) -> Core pp inp a
forall out pp inp.
(forall r. CodeGenFunction r out) -> Core pp inp out
lift0Core ((forall r. CodeGenFunction r a) -> Core pp inp a)
-> (forall r. CodeGenFunction r a) -> Core pp inp a
forall a b. (a -> b) -> a -> b
$ a -> CodeGenFunction r a
forall a. a -> CodeGenFunction r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
   Core pp inp (a -> b)
f <*> :: forall a b. Core pp inp (a -> b) -> Core pp inp a -> Core pp inp b
<*> Core pp inp a
x = ((a -> b, a) -> b) -> Core pp inp (a -> b, a) -> Core pp inp b
forall a b. (a -> b) -> Core pp inp a -> Core pp inp b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a -> b) -> a -> b) -> (a -> b, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($))  (Core pp inp (a -> b, a) -> Core pp inp b)
-> Core pp inp (a -> b, a) -> Core pp inp b
forall a b. (a -> b) -> a -> b
$  Core pp inp (a -> b) -> Core pp inp a -> Core pp inp (a -> b, a)
forall pp inp a b.
Core pp inp a -> Core pp inp b -> Core pp inp (a, b)
combineCore Core pp inp (a -> b)
f Core pp inp a
x

lift0Core :: (forall r. CodeGenFunction r out) -> Core pp inp out
lift0Core :: forall out pp inp.
(forall r. CodeGenFunction r out) -> Core pp inp out
lift0Core forall r. CodeGenFunction r out
f = T Vault (out, Vault) -> Core pp inp out
forall pp inp out. T Vault (out, Vault) -> Core pp inp out
Simple ((forall r. Vault -> CodeGenFunction r (out, Vault))
-> T Vault (out, Vault)
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
CausalPriv.map (\Vault
v -> (out -> (out, Vault))
-> CodeGenFunction r out -> CodeGenFunction r (out, Vault)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((out -> Vault -> (out, Vault)) -> Vault -> out -> (out, Vault)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Vault
v) CodeGenFunction r out
forall r. CodeGenFunction r out
f))


instance Functor (T pp inp) where
   fmap :: forall a b. (a -> b) -> T pp inp a -> T pp inp b
fmap a -> b
f (Cons State (Set Unique) (Core pp inp a)
x) = State (Set Unique) (Core pp inp b) -> T pp inp b
forall pp inp out.
State (Set Unique) (Core pp inp out) -> T pp inp out
tagUnique (State (Set Unique) (Core pp inp b) -> T pp inp b)
-> State (Set Unique) (Core pp inp b) -> T pp inp b
forall a b. (a -> b) -> a -> b
$ (Core pp inp a -> Core pp inp b)
-> State (Set Unique) (Core pp inp a)
-> State (Set Unique) (Core pp inp b)
forall a b.
(a -> b)
-> StateT (Set Unique) Identity a -> StateT (Set Unique) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Core pp inp a -> Core pp inp b
forall a b. (a -> b) -> Core pp inp a -> Core pp inp b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) State (Set Unique) (Core pp inp a)
x

instance Applicative (T pp inp) where
   pure :: forall a. a -> T pp inp a
pure a
a = State (Set Unique) (Core pp inp a) -> T pp inp a
forall pp inp out.
State (Set Unique) (Core pp inp out) -> T pp inp out
tagUnique (State (Set Unique) (Core pp inp a) -> T pp inp a)
-> State (Set Unique) (Core pp inp a) -> T pp inp a
forall a b. (a -> b) -> a -> b
$ Core pp inp a -> State (Set Unique) (Core pp inp a)
forall a. a -> StateT (Set Unique) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Core pp inp a -> State (Set Unique) (Core pp inp a))
-> Core pp inp a -> State (Set Unique) (Core pp inp a)
forall a b. (a -> b) -> a -> b
$ a -> Core pp inp a
forall a. a -> Core pp inp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
   T pp inp (a -> b)
f <*> :: forall a b. T pp inp (a -> b) -> T pp inp a -> T pp inp b
<*> T pp inp a
x = ((a -> b, a) -> b) -> T pp inp (a -> b, a) -> T pp inp b
forall a b. (a -> b) -> T pp inp a -> T pp inp b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a -> b) -> a -> b) -> (a -> b, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($))  (T pp inp (a -> b, a) -> T pp inp b)
-> T pp inp (a -> b, a) -> T pp inp b
forall a b. (a -> b) -> a -> b
$  T pp inp (a -> b)
f T pp inp (a -> b) -> T pp inp a -> T pp inp (a -> b, a)
forall pp inp a b. T pp inp a -> T pp inp b -> T pp inp (a, b)
&|& T pp inp a
x


lift0 :: (forall r. CodeGenFunction r out) -> T pp inp out
lift0 :: forall out pp inp.
(forall r. CodeGenFunction r out) -> T pp inp out
lift0 forall r. CodeGenFunction r out
f = State (Set Unique) (Core pp inp out) -> T pp inp out
forall pp inp out.
State (Set Unique) (Core pp inp out) -> T pp inp out
tagUnique (State (Set Unique) (Core pp inp out) -> T pp inp out)
-> State (Set Unique) (Core pp inp out) -> T pp inp out
forall a b. (a -> b) -> a -> b
$ Core pp inp out -> State (Set Unique) (Core pp inp out)
forall a. a -> StateT (Set Unique) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Core pp inp out -> State (Set Unique) (Core pp inp out))
-> Core pp inp out -> State (Set Unique) (Core pp inp out)
forall a b. (a -> b) -> a -> b
$ (forall r. CodeGenFunction r out) -> Core pp inp out
forall out pp inp.
(forall r. CodeGenFunction r out) -> Core pp inp out
lift0Core CodeGenFunction r out
forall r. CodeGenFunction r out
f

lift1 ::
   (forall r. a -> CodeGenFunction r out) ->
   T pp inp a -> T pp inp out
lift1 :: forall a out pp inp.
(forall r. a -> CodeGenFunction r out)
-> T pp inp a -> T pp inp out
lift1 forall r. a -> CodeGenFunction r out
f T pp inp a
x = (forall r. a -> CodeGenFunction r out) -> T a out
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
CausalPriv.map a -> CodeGenFunction r out
forall r. a -> CodeGenFunction r out
f T a out -> T pp inp a -> T pp inp out
forall a b pp inp. T a b -> T pp inp a -> T pp inp b
$& T pp inp a
x

lift2 ::
   (forall r. a -> b -> CodeGenFunction r out) ->
   T pp inp a -> T pp inp b -> T pp inp out
lift2 :: forall a b out pp inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T pp inp a -> T pp inp b -> T pp inp out
lift2 forall r. a -> b -> CodeGenFunction r out
f T pp inp a
x T pp inp b
y = (forall r. a -> b -> CodeGenFunction r out) -> T (a, b) out
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
CausalPriv.zipWith a -> b -> CodeGenFunction r out
forall r. a -> b -> CodeGenFunction r out
f T (a, b) out -> T pp inp (a, b) -> T pp inp out
forall a b pp inp. T a b -> T pp inp a -> T pp inp b
$& T pp inp a
xT pp inp a -> T pp inp b -> T pp inp (a, b)
forall pp inp a b. T pp inp a -> T pp inp b -> T pp inp (a, b)
&|&T pp inp b
y


instance
   (A.PseudoRing b, A.Real b, A.IntegerConstant b) =>
      Num (T pp a b) where
   fromInteger :: Integer -> T pp a b
fromInteger Integer
n = b -> T pp a b
forall a. a -> T pp a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> b
forall a. IntegerConstant a => Integer -> a
A.fromInteger' Integer
n)
   + :: T pp a b -> T pp a b -> T pp a b
(+) = (forall r. b -> b -> CodeGenFunction r b)
-> T pp a b -> T pp a b -> T pp a b
forall a b out pp inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T pp inp a -> T pp inp b -> T pp inp out
lift2 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 pp a b -> T pp a b -> T pp a b
forall a b out pp inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T pp inp a -> T pp inp b -> T pp inp out
lift2 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 pp a b -> T pp a b -> T pp a b
(*) = (forall r. b -> b -> CodeGenFunction r b)
-> T pp a b -> T pp a b -> T pp a b
forall a b out pp inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T pp inp a -> T pp inp b -> T pp inp out
lift2 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 pp a b -> T pp a b
abs = (forall r. b -> CodeGenFunction r b) -> T pp a b -> T pp a b
forall a out pp inp.
(forall r. a -> CodeGenFunction r out)
-> T pp inp a -> T pp inp out
lift1 b -> CodeGenFunction r b
forall r. b -> CodeGenFunction r b
forall a r. Real a => a -> CodeGenFunction r a
A.abs
   signum :: T pp a b -> T pp a b
signum = (forall r. b -> CodeGenFunction r b) -> T pp a b -> T pp a b
forall a out pp inp.
(forall r. a -> CodeGenFunction r out)
-> T pp inp a -> T pp inp out
lift1 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) =>
      Fractional (T pp a b) where
   fromRational :: Rational -> T pp a b
fromRational Rational
x = b -> T pp a b
forall a. a -> T pp a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> b
forall a. RationalConstant a => Rational -> a
A.fromRational' Rational
x)
   / :: T pp a b -> T pp a b -> T pp a b
(/) = (forall r. b -> b -> CodeGenFunction r b)
-> T pp a b -> T pp a b -> T pp a b
forall a b out pp inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T pp inp a -> T pp inp b -> T pp inp out
lift2 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.Additive b) => Additive.C (T pp a b) where
   zero :: T pp a b
zero = b -> T pp a b
forall a. a -> T pp a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Additive a => a
A.zero
   + :: T pp a b -> T pp a b -> T pp a b
(+) = (forall r. b -> b -> CodeGenFunction r b)
-> T pp a b -> T pp a b -> T pp a b
forall a b out pp inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T pp inp a -> T pp inp b -> T pp inp out
lift2 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 pp a b -> T pp a b -> T pp a b
forall a b out pp inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T pp inp a -> T pp inp b -> T pp inp out
lift2 b -> b -> CodeGenFunction r b
forall r. b -> b -> CodeGenFunction r b
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.sub
   negate :: T pp a b -> T pp a b
negate = (forall r. b -> CodeGenFunction r b) -> T pp a b -> T pp a b
forall a out pp inp.
(forall r. a -> CodeGenFunction r out)
-> T pp inp a -> T pp inp out
lift1 b -> CodeGenFunction r b
forall r. b -> CodeGenFunction r b
forall a r. Additive a => a -> CodeGenFunction r a
A.neg

instance (A.PseudoRing b, A.IntegerConstant b) => Ring.C (T pp a b) where
   one :: T pp a b
one = b -> T pp a b
forall a. a -> T pp a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. IntegerConstant a => a
A.one
   fromInteger :: Integer -> T pp a b
fromInteger Integer
n = b -> T pp a b
forall a. a -> T pp a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> b
forall a. IntegerConstant a => Integer -> a
A.fromInteger' Integer
n)
   * :: T pp a b -> T pp a b -> T pp a b
(*) = (forall r. b -> b -> CodeGenFunction r b)
-> T pp a b -> T pp a b -> T pp a b
forall a b out pp inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T pp inp a -> T pp inp b -> T pp inp out
lift2 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 pp a b) where
   fromRational' :: Rational -> T pp a b
fromRational' Rational
x = b -> T pp a b
forall a. a -> T pp 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 pp a b -> T pp a b -> T pp a b
(/) = (forall r. b -> b -> CodeGenFunction r b)
-> T pp a b -> T pp a b -> T pp a b
forall a b out pp inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T pp inp a -> T pp inp b -> T pp inp out
lift2 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.Transcendental b, A.RationalConstant b) =>
      Algebraic.C (T pp a b) where
   sqrt :: T pp a b -> T pp a b
sqrt = (forall r. b -> CodeGenFunction r b) -> T pp a b -> T pp a b
forall a out pp inp.
(forall r. a -> CodeGenFunction r out)
-> T pp inp a -> T pp inp out
lift1 b -> CodeGenFunction r b
forall r. b -> CodeGenFunction r b
forall a r. Algebraic a => a -> CodeGenFunction r a
A.sqrt
   root :: Integer -> T pp a b -> T pp a b
root Integer
n T pp a b
x = (forall r. b -> b -> CodeGenFunction r b)
-> T pp a b -> T pp a b -> T pp a b
forall a b out pp inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T pp inp a -> T pp inp b -> T pp inp out
lift2 b -> b -> CodeGenFunction r b
forall r. b -> b -> CodeGenFunction r b
forall a r. Transcendental a => a -> a -> CodeGenFunction r a
A.pow T pp a b
x (T pp a b -> T pp a b
forall a. C a => a -> a
Field.recip (T pp a b -> T pp a b) -> T pp a b -> T pp a b
forall a b. (a -> b) -> a -> b
$ Integer -> T pp a b
forall a. C a => Integer -> a
Ring.fromInteger Integer
n)
   T pp a b
x^/ :: T pp a b -> Rational -> T pp a b
^/Rational
r = (forall r. b -> b -> CodeGenFunction r b)
-> T pp a b -> T pp a b -> T pp a b
forall a b out pp inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T pp inp a -> T pp inp b -> T pp inp out
lift2 b -> b -> CodeGenFunction r b
forall r. b -> b -> CodeGenFunction r b
forall a r. Transcendental a => a -> a -> CodeGenFunction r a
A.pow T pp a b
x (Rational -> T pp a b
forall a. C a => Rational -> a
Field.fromRational' Rational
r)

instance
   (A.Transcendental b, A.RationalConstant b) =>
      Trans.C (T pp a b) where
   pi :: T pp a b
pi = (forall r. CodeGenFunction r b) -> T pp a b
forall out pp inp.
(forall r. CodeGenFunction r out) -> T pp inp out
lift0 CodeGenFunction r b
forall r. CodeGenFunction r b
forall a r. Transcendental a => CodeGenFunction r a
A.pi
   sin :: T pp a b -> T pp a b
sin = (forall r. b -> CodeGenFunction r b) -> T pp a b -> T pp a b
forall a out pp inp.
(forall r. a -> CodeGenFunction r out)
-> T pp inp a -> T pp inp out
lift1 b -> CodeGenFunction r b
forall r. b -> CodeGenFunction r b
forall a r. Transcendental a => a -> CodeGenFunction r a
A.sin
   cos :: T pp a b -> T pp a b
cos = (forall r. b -> CodeGenFunction r b) -> T pp a b -> T pp a b
forall a out pp inp.
(forall r. a -> CodeGenFunction r out)
-> T pp inp a -> T pp inp out
lift1 b -> CodeGenFunction r b
forall r. b -> CodeGenFunction r b
forall a r. Transcendental a => a -> CodeGenFunction r a
A.cos
   ** :: T pp a b -> T pp a b -> T pp a b
(**) = (forall r. b -> b -> CodeGenFunction r b)
-> T pp a b -> T pp a b -> T pp a b
forall a b out pp inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T pp inp a -> T pp inp b -> T pp inp out
lift2 b -> b -> CodeGenFunction r b
forall r. b -> b -> CodeGenFunction r b
forall a r. Transcendental a => a -> a -> CodeGenFunction r a
A.pow
   exp :: T pp a b -> T pp a b
exp = (forall r. b -> CodeGenFunction r b) -> T pp a b -> T pp a b
forall a out pp inp.
(forall r. a -> CodeGenFunction r out)
-> T pp inp a -> T pp inp out
lift1 b -> CodeGenFunction r b
forall r. b -> CodeGenFunction r b
forall a r. Transcendental a => a -> CodeGenFunction r a
A.exp
   log :: T pp a b -> T pp a b
log = (forall r. b -> CodeGenFunction r b) -> T pp a b -> T pp a b
forall a out pp inp.
(forall r. a -> CodeGenFunction r out)
-> T pp inp a -> T pp inp out
lift1 b -> CodeGenFunction r b
forall r. b -> CodeGenFunction r b
forall a r. Transcendental a => a -> CodeGenFunction r a
A.log

   asin :: T pp a b -> T pp a b
asin T pp a b
_ = [Char] -> T pp a b
forall a. HasCallStack => [Char] -> a
error [Char]
"LLVM missing intrinsic: asin"
   acos :: T pp a b -> T pp a b
acos T pp a b
_ = [Char] -> T pp a b
forall a. HasCallStack => [Char] -> a
error [Char]
"LLVM missing intrinsic: acos"
   atan :: T pp a b -> T pp a b
atan T pp a b
_ = [Char] -> T pp a b
forall a. HasCallStack => [Char] -> a
error [Char]
"LLVM missing intrinsic: atan"



fromSignal :: Sig.T a -> T pp inp a
fromSignal :: forall a pp inp. T a -> T pp inp a
fromSignal T a
sig =
   State (Set Unique) (Core pp inp a) -> T pp inp a
forall pp inp out.
State (Set Unique) (Core pp inp out) -> T pp inp out
tagUnique (State (Set Unique) (Core pp inp a) -> T pp inp a)
-> State (Set Unique) (Core pp inp a) -> T pp inp a
forall a b. (a -> b) -> a -> b
$ Core pp inp a -> State (Set Unique) (Core pp inp a)
forall a. a -> StateT (Set Unique) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Core pp inp a -> State (Set Unique) (Core pp inp a))
-> Core pp inp a -> State (Set Unique) (Core pp inp a)
forall a b. (a -> b) -> a -> b
$ T Vault (a, Vault) -> Core pp inp a
forall pp inp out. T Vault (out, Vault) -> Core pp inp out
Simple (SignalOf T a -> T Vault (a, Vault)
forall (process :: * -> * -> *) a b.
C process =>
SignalOf process a -> process b (a, b)
CausalClass.feedFst SignalOf T a
T a
sig)



type Input pp a = MR.Reader (pp, a)

plug ::
   (CutG.Read b, PIn.Default b) =>
   Input pp a b ->
   T pp a (PIn.Element b)
plug :: forall b pp a.
(Read b, Default b) =>
Input pp a b -> T pp a (Element b)
plug Input pp a b
accessor =
   State (Set Unique) (Core pp a (Element b)) -> T pp a (Element b)
forall pp inp out.
State (Set Unique) (Core pp inp out) -> T pp inp out
tagUnique (State (Set Unique) (Core pp a (Element b)) -> T pp a (Element b))
-> State (Set Unique) (Core pp a (Element b)) -> T pp a (Element b)
forall a b. (a -> b) -> a -> b
$ Core pp a (Element b) -> State (Set Unique) (Core pp a (Element b))
forall a. a -> StateT (Set Unique) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Core pp a (Element b)
 -> State (Set Unique) (Core pp a (Element b)))
-> Core pp a (Element b)
-> State (Set Unique) (Core pp a (Element b))
forall a b. (a -> b) -> a -> b
$
   (pp -> a -> b)
-> T b (Element b)
-> T (Element b, Vault) (Element b, Vault)
-> Core pp a (Element b)
forall pp inp out x y.
Read x =>
(pp -> inp -> x)
-> T x y -> T (y, Vault) (out, Vault) -> Core pp inp out
Plugged
      (((pp, a) -> b) -> pp -> a -> b
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((pp, a) -> b) -> pp -> a -> b) -> ((pp, a) -> b) -> pp -> a -> b
forall a b. (a -> b) -> a -> b
$ Input pp a b -> (pp, a) -> b
forall r a. Reader r a -> r -> a
MR.runReader Input pp a b
accessor)
      T b (Element b)
forall a. Default a => T a (Element a)
PIn.deflt
      T (Element b, Vault) (Element b, Vault)
forall a. T a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

askParameter :: Input pp a pp
askParameter :: forall pp a. Input pp a pp
askParameter = ((pp, a) -> pp) -> ReaderT (pp, a) Identity pp
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
MR.asks (pp, a) -> pp
forall a b. (a, b) -> a
fst


runPlugOut ::
   (Marshal.C pl) =>
   (Exp pl -> T pp a x) -> POut.T x b ->
   IO (pp -> pl -> PIO.T a b)
runPlugOut :: forall pl pp a x b.
C pl =>
(Exp pl -> T pp a x) -> T x b -> IO (pp -> pl -> T a b)
runPlugOut Exp pl -> T pp a x
func T x b
pout = do
   let name :: [Char]
name = [Char]
"FunctionalPlug.runPlugOut"
   IORef (T pl)
ref <- T pl -> IO (IORef (T pl))
forall a. a -> IO (IORef a)
newIORef (T pl -> IO (IORef (T pl))) -> T pl -> IO (IORef (T pl))
forall a b. (a -> b) -> a -> b
$ [Char] -> T pl
forall a. HasCallStack => [Char] -> a
error ([Char] -> T pl) -> [Char] -> T pl
forall a b. (a -> b) -> a -> b
$ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": uninitialized parameter reference"
   case Exp pl -> T pp a x
func ((forall r. CodeGenFunction r (T pl)) -> Exp pl
forall a. (forall r. CodeGenFunction r (T a)) -> Exp a
Exp (IO (T pl) -> CodeGenFunction r (T pl)
forall a. IO a -> CodeGenFunction r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (T pl) -> IO (T pl)
forall a. IORef a -> IO a
readIORef IORef (T pl)
ref))) of
      Cons State (Set Unique) (Core pp a x)
core ->
         case State (Set Unique) (Core pp a x) -> Set Unique -> Core pp a x
forall s a. State s a -> s -> a
MS.evalState State (Set Unique) (Core pp a x)
core Set Unique
forall a. Set a
Set.empty of
            Simple T Vault (x, Vault)
_ -> [Char] -> IO (pp -> pl -> T a b)
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO (pp -> pl -> T a b))
-> [Char] -> IO (pp -> pl -> T a b)
forall a b. (a -> b) -> a -> b
$ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": no substantial input available"
               -- Simple process ->
               --    CausalRender.processIOCore pin process pout
            Plugged pp -> a -> x
prep T x y
pin T (y, Vault) (x, Vault)
process ->
               ((IO (pl, IO ()) -> T x b) -> pp -> pl -> T a b)
-> IO (IO (pl, IO ()) -> T x b) -> IO (pp -> pl -> T a b)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IO (pl, IO ()) -> T x b
f pp
pp pl
pl -> IO (pl, IO ()) -> T x b
f ((pl, IO ()) -> IO (pl, IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (pl
pl, () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())) T x b -> (a -> x) -> T a b
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ pp -> a -> x
prep pp
pp) (IO (IO (pl, IO ()) -> T x b) -> IO (pp -> pl -> T a b))
-> IO (IO (pl, IO ()) -> T x b) -> IO (pp -> pl -> T a b)
forall a b. (a -> b) -> a -> b
$
               case (x, Vault) -> x
forall a b. (a, b) -> a
fst ((x, Vault) -> x) -> T y (x, Vault) -> T y x
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< T (y, Vault) (x, Vault)
process T (y, Vault) (x, Vault) -> (y -> (y, Vault)) -> T y (x, Vault)
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^ (y -> Vault -> (y, Vault)) -> Vault -> y -> (y, Vault)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Vault
Vault.empty of
                  CausalPriv.Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> y -> state -> T r c (x, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop ->
                     (\T (Value (Ptr (Struct (Repr pl)))) y x
paramd ->
                        T x y
-> T (Value (Ptr (Struct (Repr pl)))) y x
-> T x b
-> IO (IO (pl, IO ()) -> T x b)
forall p a x b c d.
(C p, Read a, x ~ Value (Ptr (Struct p))) =>
T a b -> T x b c -> T c d -> IO (IO (p, IO ()) -> T a d)
CausalRender.processIOParameterized T x y
pin T (Value (Ptr (Struct (Repr pl)))) y x
paramd T x b
pout) (T (Value (Ptr (Struct (Repr pl)))) y x
 -> IO (IO (pl, IO ()) -> T x b))
-> T (Value (Ptr (Struct (Repr pl)))) y x
-> IO (IO (pl, IO ()) -> T x b)
forall a b. (a -> b) -> a -> b
$
                     (forall r c.
 Phi c =>
 Value (Ptr (Struct (Repr pl)))
 -> global -> Value (Ptr local) -> y -> state -> T r c (x, state))
-> (forall r.
    Value (Ptr (Struct (Repr pl)))
    -> CodeGenFunction r (global, state))
-> (forall r.
    Value (Ptr (Struct (Repr pl))) -> global -> CodeGenFunction r ())
-> T (Value (Ptr (Struct (Repr pl)))) y x
forall p a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 p -> global -> Value (Ptr local) -> a -> state -> T r c (b, state))
-> (forall r. p -> CodeGenFunction r (global, state))
-> (forall r. p -> global -> CodeGenFunction r ())
-> T p a b
Parameterized.Cons
                        (\Value (Ptr (Struct (Repr pl)))
p global
global Value (Ptr local)
local y
a state
state ->
                           CodeGenFunction r () -> T r c ()
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (IORef (T pl)
-> Value (Ptr (Struct (Repr pl))) -> CodeGenFunction r ()
forall param r.
C param =>
IORef (T param)
-> Value (Ptr (Struct param)) -> CodeGenFunction r ()
Parameterized.loadParam IORef (T pl)
ref Value (Ptr (Struct (Repr pl)))
p) T r c () -> T r c (x, state) -> T r c (x, state)
forall a b. T r c a -> T r c b -> T r c b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                           global -> Value (Ptr local) -> y -> state -> T r c (x, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> y -> state -> T r c (x, state)
next global
global Value (Ptr local)
local y
a state
state)
                        (\Value (Ptr (Struct (Repr pl)))
p ->
                           IORef (T pl)
-> Value (Ptr (Struct (Repr pl))) -> CodeGenFunction r ()
forall param r.
C param =>
IORef (T param)
-> Value (Ptr (Struct param)) -> CodeGenFunction r ()
Parameterized.loadParam IORef (T pl)
ref Value (Ptr (Struct (Repr pl)))
p CodeGenFunction r ()
-> CodeGenFunction r (global, state)
-> CodeGenFunction r (global, state)
forall a b.
CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start)
                        (\Value (Ptr (Struct (Repr pl)))
p global
global ->
                           IORef (T pl)
-> Value (Ptr (Struct (Repr pl))) -> CodeGenFunction r ()
forall param r.
C param =>
IORef (T param)
-> Value (Ptr (Struct param)) -> CodeGenFunction r ()
Parameterized.loadParam IORef (T pl)
ref Value (Ptr (Struct (Repr pl)))
p 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 ()
stop global
global)

run ::
   (Marshal.C pl) =>
   (POut.Default b) =>
   (Exp pl -> T pp a (POut.Element b)) ->
   IO (pp -> pl -> PIO.T a b)
run :: forall pl b pp a.
(C pl, Default b) =>
(Exp pl -> T pp a (Element b)) -> IO (pp -> pl -> T a b)
run Exp pl -> T pp a (Element b)
f = (Exp pl -> T pp a (Element b))
-> T (Element b) b -> IO (pp -> pl -> T a b)
forall pl pp a x b.
C pl =>
(Exp pl -> T pp a x) -> T x b -> IO (pp -> pl -> T a b)
runPlugOut Exp pl -> T pp a (Element b)
f T (Element b) b
forall b. Default b => T (Element b) b
POut.deflt


{- |
Cf. 'F.withArgs'.
-}
withArgs ::
   (Marshal.C pl) =>
   (MakeArguments a, POut.Default b) =>
   (Arguments (Input pp a) a -> Exp pl -> T pp a (POut.Element b)) ->
   IO (pp -> pl -> PIO.T a b)
withArgs :: forall pl a b pp.
(C pl, MakeArguments a, Default b) =>
(Arguments (Input pp a) a -> Exp pl -> T pp a (Element b))
-> IO (pp -> pl -> T a b)
withArgs Arguments (Input pp a) a -> Exp pl -> T pp a (Element b)
f = (Arguments (Input pp a) a -> Exp pl -> T pp a (Element b))
-> T (Element b) b -> IO (pp -> pl -> T a b)
forall pl a pp x b.
(C pl, MakeArguments a) =>
(Arguments (Input pp a) a -> Exp pl -> T pp a x)
-> T x b -> IO (pp -> pl -> T a b)
withArgsPlugOut Arguments (Input pp a) a -> Exp pl -> T pp a (Element b)
f T (Element b) b
forall b. Default b => T (Element b) b
POut.deflt

withArgsPlugOut ::
   (Marshal.C pl) =>
   (MakeArguments a) =>
   (Arguments (Input pp a) a -> Exp pl -> T pp a x) ->
   POut.T x b ->
   IO (pp -> pl -> PIO.T a b)
withArgsPlugOut :: forall pl a pp x b.
(C pl, MakeArguments a) =>
(Arguments (Input pp a) a -> Exp pl -> T pp a x)
-> T x b -> IO (pp -> pl -> T a b)
withArgsPlugOut = Input pp a a
-> (Arguments (Input pp a) a -> Exp pl -> T pp a x)
-> T x b
-> IO (pp -> pl -> T a b)
forall pl a pp x b.
(C pl, MakeArguments a) =>
Input pp a a
-> (Arguments (Input pp a) a -> Exp pl -> T pp a x)
-> T x b
-> IO (pp -> pl -> T a b)
withArgsPlugOutStart (((pp, a) -> a) -> Input pp a a
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
MR.asks (pp, a) -> a
forall a b. (a, b) -> b
snd)

withArgsPlugOutStart ::
   (Marshal.C pl) =>
   (MakeArguments a) =>
   Input pp a a ->
   (Arguments (Input pp a) a -> Exp pl -> T pp a x) ->
   POut.T x b ->
   IO (pp -> pl -> PIO.T a b)
withArgsPlugOutStart :: forall pl a pp x b.
(C pl, MakeArguments a) =>
Input pp a a
-> (Arguments (Input pp a) a -> Exp pl -> T pp a x)
-> T x b
-> IO (pp -> pl -> T a b)
withArgsPlugOutStart Input pp a a
fid Arguments (ReaderT (pp, a) Identity) a -> Exp pl -> T pp a x
f = (Exp pl -> T pp a x) -> T x b -> IO (pp -> pl -> T a b)
forall pl pp a x b.
C pl =>
(Exp pl -> T pp a x) -> T x b -> IO (pp -> pl -> T a b)
runPlugOut (Arguments (ReaderT (pp, a) Identity) a -> Exp pl -> T pp a x
f (Input pp a a -> Arguments (ReaderT (pp, a) Identity) a
forall arg (f :: * -> *).
(MakeArguments arg, Functor f) =>
f arg -> Arguments f arg
forall (f :: * -> *). Functor f => f a -> Arguments f a
makeArgs Input pp a a
fid))



type family Arguments (f :: * -> *) arg

class MakeArguments arg where
   makeArgs :: Functor f => f arg -> Arguments f arg


type instance Arguments f (EventListBT.T i a) = f (EventListBT.T i a)
instance MakeArguments (EventListBT.T i a) where
   makeArgs :: forall (f :: * -> *). Functor f => f (T i a) -> Arguments f (T i a)
makeArgs = f (T i a) -> f (T i a)
f (T i a) -> Arguments f (T i a)
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

type instance Arguments f (SV.Vector a) = f (SV.Vector a)
instance MakeArguments (SV.Vector a) where
   makeArgs :: forall (f :: * -> *).
Functor f =>
f (Vector a) -> Arguments f (Vector a)
makeArgs = f (Vector a) -> f (Vector a)
f (Vector a) -> Arguments f (Vector a)
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

type instance Arguments f (Zip.T a b) = (Arguments f a, Arguments f b)
instance (MakeArguments a, MakeArguments b) =>
      MakeArguments (Zip.T a b) where
   makeArgs :: forall (f :: * -> *). Functor f => f (T a b) -> Arguments f (T a b)
makeArgs f (T a b)
f = (f a -> Arguments f a
forall arg (f :: * -> *).
(MakeArguments arg, Functor f) =>
f arg -> Arguments f arg
forall (f :: * -> *). Functor f => f a -> Arguments f a
makeArgs (f a -> Arguments f a) -> f a -> Arguments f a
forall a b. (a -> b) -> a -> b
$ (T a b -> a) -> f (T a b) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T a b -> a
forall a b. T a b -> a
Zip.first f (T a b)
f, f b -> Arguments f b
forall arg (f :: * -> *).
(MakeArguments arg, Functor f) =>
f arg -> Arguments f arg
forall (f :: * -> *). Functor f => f b -> Arguments f b
makeArgs (f b -> Arguments f b) -> f b -> Arguments f b
forall a b. (a -> b) -> a -> b
$ (T a b -> b) -> f (T a b) -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T a b -> b
forall a b. T a b -> b
Zip.second f (T a b)
f)