{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
module Synthesizer.LLVM.Causal.Functional (
T,
lift, fromSignal,
($&), (&|&),
compile,
compileSignal,
withArgs, MakeArguments, Arguments, makeArgs,
AnyArg(..),
Ground(Ground),
withGroundArgs, MakeGroundArguments, GroundArguments,
makeGroundArgs,
Atom(..), atom,
withGuidedArgs, MakeGuidedArguments, GuidedArguments, PatternArguments,
makeGuidedArgs,
PrepareArguments(PrepareArguments), withPreparedArgs, withPreparedArgs2,
atomArg, stereoArgs, pairArgs, tripleArgs,
) where
import qualified Synthesizer.LLVM.Causal.Private as CausalCore
import qualified Synthesizer.LLVM.Causal.Process as Causal
import qualified Synthesizer.LLVM.Generator.Signal as Signal
import qualified Synthesizer.LLVM.Frame.SerialVector.Class as Serial
import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
import qualified Synthesizer.Causal.Class as CausalClass
import Synthesizer.LLVM.Private (getPairPtrs, noLocalPtr)
import qualified LLVM.Extra.Multi.Value as MultiValue
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Extra.MaybeContinuation as MaybeCont
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Arithmetic as A
import LLVM.Core (CodeGenFunction)
import qualified LLVM.Core as LLVM
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.State as State
import qualified Control.Monad.Trans.Class as MT
import Control.Monad.Trans.State (StateT)
import qualified Data.Vault.Lazy as Vault
import Data.Vault.Lazy (Vault)
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 (zipPair)
import Data.Tuple.HT (fst3, snd3, thd3)
import qualified System.Unsafe as Unsafe
import Prelude hiding ((.))
newtype T inp out = Cons (Code inp out)
data Code a b =
forall global local state.
(Memory.C global, LLVM.IsSized local, Memory.C state) =>
Code (forall r c.
(Tuple.Phi c) =>
global -> LLVM.Value (LLVM.Ptr local) -> a -> state ->
StateT Vault (MaybeCont.T r c) (b, state))
(forall r. CodeGenFunction r (global, state))
(forall r. global -> CodeGenFunction r ())
instance Category Code where
id :: forall a. Code a a
id = (a -> a) -> Code a a
forall b c. (b -> c) -> Code b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> a
forall a. a -> a
id
Code forall r c.
Phi c =>
global
-> Value (Ptr local)
-> b
-> state
-> StateT Vault (T r c) (c, state)
nextB forall r. CodeGenFunction r (global, state)
startB forall r. global -> CodeGenFunction r ()
stopB . :: forall b c a. Code b c -> Code a b -> Code a c
. Code forall r c.
Phi c =>
global
-> Value (Ptr local)
-> a
-> state
-> StateT Vault (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)
-> StateT Vault (T r c) (c, (state, state)))
-> (forall r. CodeGenFunction r ((global, global), (state, state)))
-> (forall r. (global, global) -> CodeGenFunction r ())
-> Code 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
-> StateT Vault (T r c) (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> Code a b
Code
(\(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) <- T r c (Value (Ptr local), Value (Ptr local))
-> StateT Vault (T r c) (Value (Ptr local), Value (Ptr local))
forall (m :: * -> *) a. Monad m => m a -> StateT Vault m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (T r c (Value (Ptr local), Value (Ptr local))
-> StateT Vault (T r c) (Value (Ptr local), Value (Ptr local)))
-> T r c (Value (Ptr local), Value (Ptr local))
-> StateT Vault (T r c) (Value (Ptr local), Value (Ptr local))
forall a b. (a -> b) -> a -> b
$ 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
-> StateT Vault (T r c) (b, state)
forall r c.
Phi c =>
global
-> Value (Ptr local)
-> a
-> state
-> StateT Vault (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
-> StateT Vault (T r c) (c, state)
forall r c.
Phi c =>
global
-> Value (Ptr local)
-> b
-> state
-> StateT Vault (T r c) (c, state)
nextB global
globalB Value (Ptr local)
localB b
b state
sb0
(c, (state, state)) -> StateT Vault (T r c) (c, (state, state))
forall a. a -> StateT Vault (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 Code where
arr :: forall b c. (b -> c) -> Code b c
arr b -> c
f = (forall r c.
Phi c =>
()
-> Value (Ptr (Struct ()))
-> b
-> ()
-> StateT Vault (T r c) (c, ()))
-> (forall r. CodeGenFunction r ((), ()))
-> (forall r. () -> CodeGenFunction r ())
-> Code b c
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
Phi c =>
global
-> Value (Ptr local)
-> a
-> state
-> StateT Vault (T r c) (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> Code a b
Code
(\() -> (b -> () -> StateT Vault (T r c) (c, ()))
-> Value (Ptr (Struct ()))
-> b
-> ()
-> StateT Vault (T r c) (c, ())
forall f. f -> Value (Ptr (Struct ())) -> f
noLocalPtr ((b -> () -> StateT Vault (T r c) (c, ()))
-> Value (Ptr (Struct ()))
-> b
-> ()
-> StateT Vault (T r c) (c, ()))
-> (b -> () -> StateT Vault (T r c) (c, ()))
-> Value (Ptr (Struct ()))
-> b
-> ()
-> StateT Vault (T r c) (c, ())
forall a b. (a -> b) -> a -> b
$ \b
a () -> (c, ()) -> StateT Vault (T r c) (c, ())
forall a. a -> StateT Vault (T r c) a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> c
f b
a, ()))
(((), ()) -> CodeGenFunction r ((), ())
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ((),()))
(\() -> () -> CodeGenFunction r ()
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
first :: forall b c d. Code b c -> Code (b, d) (c, d)
first (Code forall r c.
Phi c =>
global
-> Value (Ptr local)
-> b
-> state
-> StateT Vault (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
-> StateT Vault (T r c) ((c, d), state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> Code (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
-> StateT Vault (T r c) (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> Code a b
Code ((global
-> Value (Ptr local)
-> b
-> state
-> StateT Vault (T r c) (c, state))
-> global
-> Value (Ptr local)
-> (b, d)
-> state
-> StateT Vault (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)
CausalCore.firstNext global
-> Value (Ptr local)
-> b
-> state
-> StateT Vault (T r c) (c, state)
forall r c.
Phi c =>
global
-> Value (Ptr local)
-> b
-> state
-> StateT Vault (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
instance Functor (T inp) where
fmap :: forall a b. (a -> b) -> T inp a -> T inp b
fmap a -> b
f (Cons Code inp a
x) =
Code inp b -> T inp b
forall inp out. Code inp out -> T inp out
tagUnique (Code inp b -> T inp b) -> Code inp b -> T inp b
forall a b. (a -> b) -> a -> b
$ Code inp a
x Code inp a -> (a -> b) -> Code inp b
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ a -> b
f
instance Applicative (T inp) where
pure :: forall a. a -> T inp a
pure a
a = Code inp a -> T inp a
forall inp out. Code inp out -> T inp out
tagUnique (Code inp a -> T inp a) -> Code inp a -> T inp a
forall a b. (a -> b) -> a -> b
$ (inp -> a) -> Code inp a
forall b c. (b -> c) -> Code b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (a -> inp -> a
forall a b. a -> b -> a
const a
a)
T inp (a -> b)
f <*> :: forall a b. T inp (a -> b) -> T inp a -> T inp b
<*> T inp a
x = ((a -> b, a) -> b) -> T inp (a -> b, a) -> T inp b
forall a b. (a -> b) -> T inp a -> T 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 inp (a -> b, a) -> T inp b) -> T inp (a -> b, a) -> T inp b
forall a b. (a -> b) -> a -> b
$ T inp (a -> b)
f T inp (a -> b) -> T inp a -> T inp (a -> b, a)
forall a b c. T a b -> T a c -> T a (b, c)
&|& T inp a
x
lift0 :: (forall r. CodeGenFunction r out) -> T inp out
lift0 :: forall out inp. (forall r. CodeGenFunction r out) -> T inp out
lift0 forall r. CodeGenFunction r out
f = T inp out -> T inp out
forall inp out. T inp out -> T inp out
lift ((forall r. inp -> CodeGenFunction r out) -> T inp out
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
CausalCore.map (CodeGenFunction r out -> inp -> CodeGenFunction r out
forall a b. a -> b -> a
const CodeGenFunction r out
forall r. CodeGenFunction r out
f))
lift1 :: (forall r. a -> CodeGenFunction r out) -> T inp a -> T inp out
lift1 :: forall a out inp.
(forall r. a -> CodeGenFunction r out) -> T inp a -> T inp out
lift1 forall r. a -> CodeGenFunction r out
f T inp a
x = (forall r. a -> CodeGenFunction r out) -> T a out
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
CausalCore.map a -> CodeGenFunction r out
forall r. a -> CodeGenFunction r out
f T a out -> T inp a -> T inp out
forall b c a. T b c -> T a b -> T a c
$& T inp a
x
lift2 ::
(forall r. a -> b -> CodeGenFunction r out) ->
T inp a -> T inp b -> T inp out
lift2 :: forall a b out inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T inp a -> T inp b -> T inp out
lift2 forall r. a -> b -> CodeGenFunction r out
f T inp a
x T 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
CausalCore.zipWith a -> b -> CodeGenFunction r out
forall r. a -> b -> CodeGenFunction r out
f T (a, b) out -> T inp (a, b) -> T inp out
forall b c a. T b c -> T a b -> T a c
$& T inp a
xT inp a -> T inp b -> T inp (a, b)
forall a b c. T a b -> T a c -> T a (b, c)
&|&T inp b
y
instance (A.PseudoRing b, A.Real b, A.IntegerConstant b) => 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)
+ :: 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 a b out inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T inp a -> T inp b -> T 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 a b -> T a b -> T a b
forall a b out inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T inp a -> T inp b -> T 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 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 a b out inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T inp a -> T inp b -> T 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 a b -> T a b
abs = (forall r. b -> CodeGenFunction r b) -> T a b -> T a b
forall a out inp.
(forall r. a -> CodeGenFunction r out) -> T inp a -> T 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 a b -> T a b
signum = (forall r. b -> CodeGenFunction r b) -> T a b -> T a b
forall a out inp.
(forall r. a -> CodeGenFunction r out) -> T inp a -> T 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 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 a b out inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T inp a -> T inp b -> T 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 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
+ :: 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 a b out inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T inp a -> T inp b -> T 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 a b -> T a b -> T a b
forall a b out inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T inp a -> T inp b -> T 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 a b -> T a b
negate = (forall r. b -> CodeGenFunction r b) -> T a b -> T a b
forall a out inp.
(forall r. a -> CodeGenFunction r out) -> T inp a -> T 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 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 a b out inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T inp a -> T inp b -> T 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 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 a b out inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T inp a -> T inp b -> T 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 a b) where
sqrt :: T a b -> T a b
sqrt = (forall r. b -> CodeGenFunction r b) -> T a b -> T a b
forall a out inp.
(forall r. a -> CodeGenFunction r out) -> T inp a -> T 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 a b -> T a b
root Integer
n T a b
x = (forall r. b -> b -> CodeGenFunction r b)
-> T a b -> T a b -> T a b
forall a b out inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T inp a -> T inp b -> T 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 a b
x (T a b -> T a b
forall a. C a => a -> a
Field.recip (T a b -> T a b) -> T a b -> T a b
forall a b. (a -> b) -> a -> b
$ Integer -> T a b
forall a. C a => Integer -> a
Ring.fromInteger Integer
n)
T a b
x^/ :: T a b -> Rational -> T a b
^/Rational
r = (forall r. b -> b -> CodeGenFunction r b)
-> T a b -> T a b -> T a b
forall a b out inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T inp a -> T inp b -> T 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 a b
x (Rational -> T a b
forall a. C a => Rational -> a
Field.fromRational' Rational
r)
instance (A.Transcendental b, A.RationalConstant b) => Trans.C (T a b) where
pi :: T a b
pi = (forall r. CodeGenFunction r b) -> T a b
forall out inp. (forall r. CodeGenFunction r out) -> T inp out
lift0 CodeGenFunction r b
forall r. CodeGenFunction r b
forall a r. Transcendental a => CodeGenFunction r a
A.pi
sin :: T a b -> T a b
sin = (forall r. b -> CodeGenFunction r b) -> T a b -> T a b
forall a out inp.
(forall r. a -> CodeGenFunction r out) -> T inp a -> T 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 a b -> T a b
cos = (forall r. b -> CodeGenFunction r b) -> T a b -> T a b
forall a out inp.
(forall r. a -> CodeGenFunction r out) -> T inp a -> T 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 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 a b out inp.
(forall r. a -> b -> CodeGenFunction r out)
-> T inp a -> T inp b -> T 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 a b -> T a b
exp = (forall r. b -> CodeGenFunction r b) -> T a b -> T a b
forall a out inp.
(forall r. a -> CodeGenFunction r out) -> T inp a -> T 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 a b -> T a b
log = (forall r. b -> CodeGenFunction r b) -> T a b -> T a b
forall a out inp.
(forall r. a -> CodeGenFunction r out) -> T inp a -> T 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 a b -> T a b
asin T a b
_ = [Char] -> T a b
forall a. HasCallStack => [Char] -> a
error [Char]
"LLVM missing intrinsic: asin"
acos :: T a b -> T a b
acos T a b
_ = [Char] -> T a b
forall a. HasCallStack => [Char] -> a
error [Char]
"LLVM missing intrinsic: acos"
atan :: T a b -> T a b
atan T a b
_ = [Char] -> T a b
forall a. HasCallStack => [Char] -> a
error [Char]
"LLVM missing intrinsic: atan"
infixr 0 $&
($&) :: Causal.T b c -> T a b -> T a c
T b c
f $& :: forall b c a. T b c -> T a b -> T a c
$& (Cons Code a b
b) =
Code a c -> T a c
forall inp out. Code inp out -> T inp out
tagUnique (Code a c -> T a c) -> Code a c -> T a c
forall a b. (a -> b) -> a -> b
$ T b c -> Code b c
forall inp out. T inp out -> Code inp out
liftCode T b c
f Code b c -> Code a b -> Code a c
forall b c a. Code b c -> Code a b -> Code a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Code a b
b
infixr 3 &|&
(&|&) :: T a b -> T a c -> T a (b,c)
Cons Code a b
b &|& :: forall a b c. T a b -> T a c -> T a (b, c)
&|& Cons Code a c
c =
Code a (b, c) -> T a (b, c)
forall inp out. Code inp out -> T inp out
tagUnique (Code a (b, c) -> T a (b, c)) -> Code a (b, c) -> T a (b, c)
forall a b. (a -> b) -> a -> b
$ Code a b
b Code a b -> Code a c -> Code a (b, c)
forall b c c'. Code b c -> Code b c' -> Code b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Code a c
c
liftCode :: Causal.T inp out -> Code inp out
liftCode :: forall inp out. T inp out -> Code inp out
liftCode (CausalCore.Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> inp -> state -> T r c (out, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) =
(forall r c.
Phi c =>
global
-> Value (Ptr local)
-> inp
-> state
-> StateT Vault (T r c) (out, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> Code inp out
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
Phi c =>
global
-> Value (Ptr local)
-> a
-> state
-> StateT Vault (T r c) (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> Code a b
Code
(\global
p Value (Ptr local)
l inp
a state
state -> T r c (out, state) -> StateT Vault (T r c) (out, state)
forall (m :: * -> *) a. Monad m => m a -> StateT Vault m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (global -> Value (Ptr local) -> inp -> state -> T r c (out, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> inp -> state -> T r c (out, state)
next global
p Value (Ptr local)
l inp
a state
state))
CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop
lift :: Causal.T inp out -> T inp out
lift :: forall inp out. T inp out -> T inp out
lift = Code inp out -> T inp out
forall inp out. Code inp out -> T inp out
tagUnique (Code inp out -> T inp out)
-> (T inp out -> Code inp out) -> T inp out -> T inp out
forall b c a. (b -> c) -> (a -> b) -> 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 inp out -> Code inp out
forall inp out. T inp out -> Code inp out
liftCode
fromSignal :: Signal.T out -> T inp out
fromSignal :: forall out inp. T out -> T inp out
fromSignal = T inp out -> T inp out
forall inp out. T inp out -> T inp out
lift (T inp out -> T inp out)
-> (T out -> T inp out) -> T out -> T inp out
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SignalOf T out -> T inp out
T out -> T inp out
forall b a. SignalOf T b -> T a b
forall (process :: * -> * -> *) b a.
C process =>
SignalOf process b -> process a b
CausalClass.fromSignal
tag :: Vault.Key out -> Code inp out -> T inp out
tag :: forall out inp. Key out -> Code inp out -> T inp out
tag Key out
key (Code forall r c.
Phi c =>
global
-> Value (Ptr local)
-> inp
-> state
-> StateT Vault (T r c) (out, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) =
Code inp out -> T inp out
forall inp out. Code inp out -> T inp out
Cons (Code inp out -> T inp out) -> Code inp out -> T inp out
forall a b. (a -> b) -> a -> b
$
(forall r c.
Phi c =>
global
-> Value (Ptr local)
-> inp
-> state
-> StateT Vault (T r c) (out, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> Code inp out
forall a b global local state.
(C global, IsSized local, C state) =>
(forall r c.
Phi c =>
global
-> Value (Ptr local)
-> a
-> state
-> StateT Vault (T r c) (b, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> Code a b
Code
(\global
p Value (Ptr local)
l inp
a state
s0 -> do
Maybe out
mb <- (Vault -> Maybe out) -> StateT Vault (T r c) (Maybe out)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.gets (Key out -> Vault -> Maybe out
forall a. Key a -> Vault -> Maybe a
Vault.lookup Key out
key)
case Maybe out
mb of
Just out
b -> (out, state) -> StateT Vault (T r c) (out, state)
forall a. a -> StateT Vault (T r c) a
forall (m :: * -> *) a. Monad m => a -> m a
return (out
b,state
s0)
Maybe out
Nothing -> do
bs :: (out, state)
bs@(out
b,state
_) <- global
-> Value (Ptr local)
-> inp
-> state
-> StateT Vault (T r c) (out, state)
forall r c.
Phi c =>
global
-> Value (Ptr local)
-> inp
-> state
-> StateT Vault (T r c) (out, state)
next global
p Value (Ptr local)
l inp
a state
s0
(Vault -> Vault) -> StateT Vault (T r c) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify (Key out -> out -> Vault -> Vault
forall a. Key a -> a -> Vault -> Vault
Vault.insert Key out
key out
b)
(out, state) -> StateT Vault (T r c) (out, state)
forall a. a -> StateT Vault (T r c) a
forall (m :: * -> *) a. Monad m => a -> m a
return (out, state)
bs)
CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop
_tag :: Vault.Key out -> Code inp out -> T inp out
_tag :: forall out inp. Key out -> Code inp out -> T inp out
_tag Key out
_ = Code inp out -> T inp out
forall inp out. Code inp out -> T inp out
Cons
tagUnique :: Code inp out -> T inp out
tagUnique :: forall inp out. Code inp out -> T inp out
tagUnique Code inp out
code =
IO (T inp out) -> T inp out
forall a. IO a -> a
Unsafe.performIO (IO (T inp out) -> T inp out) -> IO (T inp out) -> T inp out
forall a b. (a -> b) -> a -> b
$
(Key out -> T inp out) -> IO (Key out) -> IO (T inp out)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key out -> Code inp out -> T inp out)
-> Code inp out -> Key out -> T inp out
forall a b c. (a -> b -> c) -> b -> a -> c
flip Key out -> Code inp out -> T inp out
forall out inp. Key out -> Code inp out -> T inp out
tag Code inp out
code) IO (Key out)
forall a. IO (Key a)
Vault.newKey
initialize :: Code inp out -> Causal.T inp out
initialize :: forall inp out. Code inp out -> T inp out
initialize (Code forall r c.
Phi c =>
global
-> Value (Ptr local)
-> inp
-> state
-> StateT Vault (T r c) (out, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) =
(forall r c.
Phi c =>
global -> Value (Ptr local) -> inp -> state -> T r c (out, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T inp out
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
CausalCore.Cons
(\global
p Value (Ptr local)
l inp
a state
state -> StateT Vault (T r c) (out, state) -> Vault -> T r c (out, state)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT (global
-> Value (Ptr local)
-> inp
-> state
-> StateT Vault (T r c) (out, state)
forall r c.
Phi c =>
global
-> Value (Ptr local)
-> inp
-> state
-> StateT Vault (T r c) (out, state)
next global
p Value (Ptr local)
l inp
a state
state) Vault
Vault.empty)
CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop
compile :: T inp out -> Causal.T inp out
compile :: forall inp out. T inp out -> T inp out
compile (Cons Code inp out
code) = Code inp out -> T inp out
forall inp out. Code inp out -> T inp out
initialize Code inp out
code
compileSignal :: T () out -> Signal.T out
compileSignal :: forall out. T () out -> T out
compileSignal T () out
f = T () out -> SignalOf T out
forall a. T () a -> SignalOf T a
forall (process :: * -> * -> *) a.
C process =>
process () a -> SignalOf process a
CausalClass.toSignal (T () out -> SignalOf T out) -> T () out -> SignalOf T out
forall a b. (a -> b) -> a -> b
$ T () out -> T () out
forall inp out. T inp out -> T inp out
compile T () out
f
withArgs ::
(MakeArguments inp) =>
(Arguments (T inp) inp -> T inp out) -> Causal.T inp out
withArgs :: forall inp out.
MakeArguments inp =>
(Arguments (T inp) inp -> T inp out) -> T inp out
withArgs Arguments (T inp) inp -> T inp out
f = (T inp inp -> T inp out) -> T inp out
forall inp out. (T inp inp -> T inp out) -> T inp out
withId ((T inp inp -> T inp out) -> T inp out)
-> (T inp inp -> T inp out) -> T inp out
forall a b. (a -> b) -> a -> b
$ Arguments (T inp) inp -> T inp out
f (Arguments (T inp) inp -> T inp out)
-> (T inp inp -> Arguments (T inp) inp) -> T inp inp -> T inp out
forall b c a. (b -> c) -> (a -> b) -> 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 inp inp -> Arguments (T inp) inp
forall arg (f :: * -> *).
(MakeArguments arg, Functor f) =>
f arg -> Arguments f arg
forall (f :: * -> *). Functor f => f inp -> Arguments f inp
makeArgs
withId :: (T inp inp -> T inp out) -> Causal.T inp out
withId :: forall inp out. (T inp inp -> T inp out) -> T inp out
withId T inp inp -> T inp out
f = T inp out -> T inp out
forall inp out. T inp out -> T inp out
compile (T inp out -> T inp out) -> T inp out -> T inp out
forall a b. (a -> b) -> a -> b
$ T inp inp -> T inp out
f (T inp inp -> T inp out) -> T inp inp -> T inp out
forall a b. (a -> b) -> a -> b
$ T inp inp -> T inp inp
forall inp out. T inp out -> T inp out
lift T inp inp
forall a. T a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Cat.id
type family Arguments (f :: * -> *) arg
class MakeArguments arg where
makeArgs :: Functor f => f arg -> Arguments f arg
type instance Arguments f (LLVM.Value a) = f (LLVM.Value a)
instance MakeArguments (LLVM.Value a) where
makeArgs :: forall (f :: * -> *).
Functor f =>
f (Value a) -> Arguments f (Value a)
makeArgs = f (Value a) -> f (Value a)
f (Value a) -> Arguments f (Value a)
forall a. a -> a
id
type instance Arguments f (MultiValue.T a) = f (MultiValue.T a)
instance MakeArguments (MultiValue.T a) where
makeArgs :: forall (f :: * -> *). Functor f => f (T a) -> Arguments f (T a)
makeArgs = f (T a) -> f (T a)
f (T a) -> Arguments f (T a)
forall a. a -> a
id
type instance Arguments f (Stereo.T a) = Stereo.T (Arguments f a)
instance (MakeArguments a) => MakeArguments (Stereo.T a) where
makeArgs :: forall (f :: * -> *). Functor f => f (T a) -> Arguments f (T a)
makeArgs = (f a -> Arguments f a) -> T (f a) -> T (Arguments f a)
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 (T (f a) -> T (Arguments f a))
-> (f (T a) -> T (f a)) -> f (T a) -> T (Arguments f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f (T a) -> T (f a)
forall (f :: * -> *) a. Functor f => f (T a) -> T (f a)
Stereo.sequence
type instance Arguments f (Serial.Constant n a) = f (Serial.Constant n a)
instance MakeArguments (Serial.Constant n a) where
makeArgs :: forall (f :: * -> *).
Functor f =>
f (Constant n a) -> Arguments f (Constant n a)
makeArgs = f (Constant n a) -> f (Constant n a)
f (Constant n a) -> Arguments f (Constant n a)
forall a. a -> a
id
type instance Arguments f () = f ()
instance MakeArguments () where
makeArgs :: forall (f :: * -> *). Functor f => f () -> Arguments f ()
makeArgs = f () -> f ()
f () -> Arguments f ()
forall a. a -> a
id
type instance Arguments f (a,b) = (Arguments f a, Arguments f b)
instance (MakeArguments a, MakeArguments b) =>
MakeArguments (a,b) where
makeArgs :: forall (f :: * -> *). Functor f => f (a, b) -> Arguments f (a, b)
makeArgs f (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
$ ((a, b) -> a) -> f (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 (a, b) -> a
forall a b. (a, b) -> a
fst f (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
$ ((a, b) -> b) -> f (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 (a, b) -> b
forall a b. (a, b) -> b
snd f (a, b)
f)
type instance Arguments f (a,b,c) =
(Arguments f a, Arguments f b, Arguments f c)
instance (MakeArguments a, MakeArguments b, MakeArguments c) =>
MakeArguments (a,b,c) where
makeArgs :: forall (f :: * -> *).
Functor f =>
f (a, b, c) -> Arguments f (a, b, c)
makeArgs f (a, b, c)
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
$ ((a, b, c) -> a) -> f (a, b, c) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b, c) -> a
forall a b c. (a, b, c) -> a
fst3 f (a, b, c)
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
$ ((a, b, c) -> b) -> f (a, b, c) -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b, c) -> b
forall a b c. (a, b, c) -> b
snd3 f (a, b, c)
f, f c -> Arguments f c
forall arg (f :: * -> *).
(MakeArguments arg, Functor f) =>
f arg -> Arguments f arg
forall (f :: * -> *). Functor f => f c -> Arguments f c
makeArgs (f c -> Arguments f c) -> f c -> Arguments f c
forall a b. (a -> b) -> a -> b
$ ((a, b, c) -> c) -> f (a, b, c) -> f c
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b, c) -> c
forall a b c. (a, b, c) -> c
thd3 f (a, b, c)
f)
newtype AnyArg a = AnyArg {forall a. AnyArg a -> a
getAnyArg :: a}
type instance Arguments f (AnyArg a) = f a
instance MakeArguments (AnyArg a) where
makeArgs :: forall (f :: * -> *).
Functor f =>
f (AnyArg a) -> Arguments f (AnyArg a)
makeArgs = (AnyArg a -> a) -> f (AnyArg a) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AnyArg a -> a
forall a. AnyArg a -> a
getAnyArg
withGroundArgs ::
(MakeGroundArguments (T inp) args,
GroundArguments args ~ inp) =>
(args -> T inp out) -> Causal.T inp out
withGroundArgs :: forall inp args out.
(MakeGroundArguments (T inp) args, GroundArguments args ~ inp) =>
(args -> T inp out) -> T inp out
withGroundArgs args -> T inp out
f = (T inp inp -> T inp out) -> T inp out
forall inp out. (T inp inp -> T inp out) -> T inp out
withId ((T inp inp -> T inp out) -> T inp out)
-> (T inp inp -> T inp out) -> T inp out
forall a b. (a -> b) -> a -> b
$ args -> T inp out
f (args -> T inp out)
-> (T inp inp -> args) -> T inp inp -> T inp out
forall b c a. (b -> c) -> (a -> b) -> 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 inp inp -> args
T inp (GroundArguments args) -> args
forall (f :: * -> *) args.
MakeGroundArguments f args =>
f (GroundArguments args) -> args
makeGroundArgs
newtype Ground f a = Ground (f a)
type family GroundArguments args
class (Functor f) => MakeGroundArguments f args where
makeGroundArgs :: f (GroundArguments args) -> args
type instance GroundArguments (Ground f a) = a
instance (Functor f, f ~ g) => MakeGroundArguments f (Ground g a) where
makeGroundArgs :: f (GroundArguments (Ground g a)) -> Ground g a
makeGroundArgs = f a -> Ground f a
f (GroundArguments (Ground g a)) -> Ground g a
forall (f :: * -> *) a. f a -> Ground f a
Ground
type instance GroundArguments (Stereo.T a) = Stereo.T (GroundArguments a)
instance MakeGroundArguments f a => MakeGroundArguments f (Stereo.T a) where
makeGroundArgs :: f (GroundArguments (T a)) -> T a
makeGroundArgs f (GroundArguments (T a))
f =
a -> a -> T a
forall a. a -> a -> T a
Stereo.cons
(f (GroundArguments a) -> a
forall (f :: * -> *) args.
MakeGroundArguments f args =>
f (GroundArguments args) -> args
makeGroundArgs (f (GroundArguments a) -> a) -> f (GroundArguments a) -> a
forall a b. (a -> b) -> a -> b
$ (T (GroundArguments a) -> GroundArguments a)
-> f (T (GroundArguments a)) -> f (GroundArguments a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T (GroundArguments a) -> GroundArguments a
forall a. T a -> a
Stereo.left f (T (GroundArguments a))
f (GroundArguments (T a))
f)
(f (GroundArguments a) -> a
forall (f :: * -> *) args.
MakeGroundArguments f args =>
f (GroundArguments args) -> args
makeGroundArgs (f (GroundArguments a) -> a) -> f (GroundArguments a) -> a
forall a b. (a -> b) -> a -> b
$ (T (GroundArguments a) -> GroundArguments a)
-> f (T (GroundArguments a)) -> f (GroundArguments a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T (GroundArguments a) -> GroundArguments a
forall a. T a -> a
Stereo.right f (T (GroundArguments a))
f (GroundArguments (T a))
f)
type instance GroundArguments () = ()
instance (Functor f) => MakeGroundArguments f () where
makeGroundArgs :: f (GroundArguments ()) -> ()
makeGroundArgs f (GroundArguments ())
_ = ()
type instance
GroundArguments (a,b) =
(GroundArguments a, GroundArguments b)
instance
(MakeGroundArguments f a, MakeGroundArguments f b) =>
MakeGroundArguments f (a,b) where
makeGroundArgs :: f (GroundArguments (a, b)) -> (a, b)
makeGroundArgs f (GroundArguments (a, b))
f =
(f (GroundArguments a) -> a
forall (f :: * -> *) args.
MakeGroundArguments f args =>
f (GroundArguments args) -> args
makeGroundArgs (f (GroundArguments a) -> a) -> f (GroundArguments a) -> a
forall a b. (a -> b) -> a -> b
$ ((GroundArguments a, GroundArguments b) -> GroundArguments a)
-> f (GroundArguments a, GroundArguments b)
-> f (GroundArguments a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GroundArguments a, GroundArguments b) -> GroundArguments a
forall a b. (a, b) -> a
fst f (GroundArguments a, GroundArguments b)
f (GroundArguments (a, b))
f,
f (GroundArguments b) -> b
forall (f :: * -> *) args.
MakeGroundArguments f args =>
f (GroundArguments args) -> args
makeGroundArgs (f (GroundArguments b) -> b) -> f (GroundArguments b) -> b
forall a b. (a -> b) -> a -> b
$ ((GroundArguments a, GroundArguments b) -> GroundArguments b)
-> f (GroundArguments a, GroundArguments b)
-> f (GroundArguments b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GroundArguments a, GroundArguments b) -> GroundArguments b
forall a b. (a, b) -> b
snd f (GroundArguments a, GroundArguments b)
f (GroundArguments (a, b))
f)
type instance
GroundArguments (a,b,c) =
(GroundArguments a, GroundArguments b, GroundArguments c)
instance
(MakeGroundArguments f a, MakeGroundArguments f b,
MakeGroundArguments f c) =>
MakeGroundArguments f (a,b,c) where
makeGroundArgs :: f (GroundArguments (a, b, c)) -> (a, b, c)
makeGroundArgs f (GroundArguments (a, b, c))
f =
(f (GroundArguments a) -> a
forall (f :: * -> *) args.
MakeGroundArguments f args =>
f (GroundArguments args) -> args
makeGroundArgs (f (GroundArguments a) -> a) -> f (GroundArguments a) -> a
forall a b. (a -> b) -> a -> b
$ ((GroundArguments a, GroundArguments b, GroundArguments c)
-> GroundArguments a)
-> f (GroundArguments a, GroundArguments b, GroundArguments c)
-> f (GroundArguments a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GroundArguments a, GroundArguments b, GroundArguments c)
-> GroundArguments a
forall a b c. (a, b, c) -> a
fst3 f (GroundArguments a, GroundArguments b, GroundArguments c)
f (GroundArguments (a, b, c))
f,
f (GroundArguments b) -> b
forall (f :: * -> *) args.
MakeGroundArguments f args =>
f (GroundArguments args) -> args
makeGroundArgs (f (GroundArguments b) -> b) -> f (GroundArguments b) -> b
forall a b. (a -> b) -> a -> b
$ ((GroundArguments a, GroundArguments b, GroundArguments c)
-> GroundArguments b)
-> f (GroundArguments a, GroundArguments b, GroundArguments c)
-> f (GroundArguments b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GroundArguments a, GroundArguments b, GroundArguments c)
-> GroundArguments b
forall a b c. (a, b, c) -> b
snd3 f (GroundArguments a, GroundArguments b, GroundArguments c)
f (GroundArguments (a, b, c))
f,
f (GroundArguments c) -> c
forall (f :: * -> *) args.
MakeGroundArguments f args =>
f (GroundArguments args) -> args
makeGroundArgs (f (GroundArguments c) -> c) -> f (GroundArguments c) -> c
forall a b. (a -> b) -> a -> b
$ ((GroundArguments a, GroundArguments b, GroundArguments c)
-> GroundArguments c)
-> f (GroundArguments a, GroundArguments b, GroundArguments c)
-> f (GroundArguments c)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GroundArguments a, GroundArguments b, GroundArguments c)
-> GroundArguments c
forall a b c. (a, b, c) -> c
thd3 f (GroundArguments a, GroundArguments b, GroundArguments c)
f (GroundArguments (a, b, c))
f)
withGuidedArgs ::
(MakeGuidedArguments pat, PatternArguments pat ~ inp) =>
pat ->
(GuidedArguments (T inp) pat -> T inp out) -> Causal.T inp out
withGuidedArgs :: forall pat inp out.
(MakeGuidedArguments pat, PatternArguments pat ~ inp) =>
pat -> (GuidedArguments (T inp) pat -> T inp out) -> T inp out
withGuidedArgs pat
p GuidedArguments (T inp) pat -> T inp out
f = (T inp inp -> T inp out) -> T inp out
forall inp out. (T inp inp -> T inp out) -> T inp out
withId ((T inp inp -> T inp out) -> T inp out)
-> (T inp inp -> T inp out) -> T inp out
forall a b. (a -> b) -> a -> b
$ GuidedArguments (T inp) pat -> T inp out
f (GuidedArguments (T inp) pat -> T inp out)
-> (T inp inp -> GuidedArguments (T inp) pat)
-> T inp inp
-> T inp out
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. pat -> T inp (PatternArguments pat) -> GuidedArguments (T inp) pat
forall pat (f :: * -> *).
(MakeGuidedArguments pat, Functor f) =>
pat -> f (PatternArguments pat) -> GuidedArguments f pat
forall (f :: * -> *).
Functor f =>
pat -> f (PatternArguments pat) -> GuidedArguments f pat
makeGuidedArgs pat
p
data Atom a = Atom
atom :: Atom a
atom :: forall a. Atom a
atom = Atom a
forall a. Atom a
Atom
type family GuidedArguments (f :: * -> *) pat
type family PatternArguments pat
class MakeGuidedArguments pat where
makeGuidedArgs ::
Functor f =>
pat -> f (PatternArguments pat) -> GuidedArguments f pat
type instance GuidedArguments f (Atom a) = f a
type instance PatternArguments (Atom a) = a
instance MakeGuidedArguments (Atom a) where
makeGuidedArgs :: forall (f :: * -> *).
Functor f =>
Atom a
-> f (PatternArguments (Atom a)) -> GuidedArguments f (Atom a)
makeGuidedArgs Atom a
Atom = f a -> f a
f (PatternArguments (Atom a)) -> GuidedArguments f (Atom a)
forall a. a -> a
id
type instance GuidedArguments f (Stereo.T a) = Stereo.T (GuidedArguments f a)
type instance PatternArguments (Stereo.T a) = Stereo.T (PatternArguments a)
instance MakeGuidedArguments a => MakeGuidedArguments (Stereo.T a) where
makeGuidedArgs :: forall (f :: * -> *).
Functor f =>
T a -> f (PatternArguments (T a)) -> GuidedArguments f (T a)
makeGuidedArgs T a
pat f (PatternArguments (T a))
f =
GuidedArguments f a
-> GuidedArguments f a -> T (GuidedArguments f a)
forall a. a -> a -> T a
Stereo.cons
(a -> f (PatternArguments a) -> GuidedArguments f a
forall pat (f :: * -> *).
(MakeGuidedArguments pat, Functor f) =>
pat -> f (PatternArguments pat) -> GuidedArguments f pat
forall (f :: * -> *).
Functor f =>
a -> f (PatternArguments a) -> GuidedArguments f a
makeGuidedArgs (T a -> a
forall a. T a -> a
Stereo.left T a
pat) (f (PatternArguments a) -> GuidedArguments f a)
-> f (PatternArguments a) -> GuidedArguments f a
forall a b. (a -> b) -> a -> b
$ (T (PatternArguments a) -> PatternArguments a)
-> f (T (PatternArguments a)) -> f (PatternArguments a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T (PatternArguments a) -> PatternArguments a
forall a. T a -> a
Stereo.left f (T (PatternArguments a))
f (PatternArguments (T a))
f)
(a -> f (PatternArguments a) -> GuidedArguments f a
forall pat (f :: * -> *).
(MakeGuidedArguments pat, Functor f) =>
pat -> f (PatternArguments pat) -> GuidedArguments f pat
forall (f :: * -> *).
Functor f =>
a -> f (PatternArguments a) -> GuidedArguments f a
makeGuidedArgs (T a -> a
forall a. T a -> a
Stereo.right T a
pat) (f (PatternArguments a) -> GuidedArguments f a)
-> f (PatternArguments a) -> GuidedArguments f a
forall a b. (a -> b) -> a -> b
$ (T (PatternArguments a) -> PatternArguments a)
-> f (T (PatternArguments a)) -> f (PatternArguments a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T (PatternArguments a) -> PatternArguments a
forall a. T a -> a
Stereo.right f (T (PatternArguments a))
f (PatternArguments (T a))
f)
type instance GuidedArguments f () = f ()
type instance PatternArguments () = ()
instance MakeGuidedArguments () where
makeGuidedArgs :: forall (f :: * -> *).
Functor f =>
() -> f (PatternArguments ()) -> GuidedArguments f ()
makeGuidedArgs () = f () -> f ()
f (PatternArguments ()) -> GuidedArguments f ()
forall a. a -> a
id
type instance
GuidedArguments f (a,b) =
(GuidedArguments f a, GuidedArguments f b)
type instance
PatternArguments (a,b) =
(PatternArguments a, PatternArguments b)
instance (MakeGuidedArguments a, MakeGuidedArguments b) =>
MakeGuidedArguments (a,b) where
makeGuidedArgs :: forall (f :: * -> *).
Functor f =>
(a, b) -> f (PatternArguments (a, b)) -> GuidedArguments f (a, b)
makeGuidedArgs (a
pa,b
pb) f (PatternArguments (a, b))
f =
(a -> f (PatternArguments a) -> GuidedArguments f a
forall pat (f :: * -> *).
(MakeGuidedArguments pat, Functor f) =>
pat -> f (PatternArguments pat) -> GuidedArguments f pat
forall (f :: * -> *).
Functor f =>
a -> f (PatternArguments a) -> GuidedArguments f a
makeGuidedArgs a
pa (f (PatternArguments a) -> GuidedArguments f a)
-> f (PatternArguments a) -> GuidedArguments f a
forall a b. (a -> b) -> a -> b
$ ((PatternArguments a, PatternArguments b) -> PatternArguments a)
-> f (PatternArguments a, PatternArguments b)
-> f (PatternArguments a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PatternArguments a, PatternArguments b) -> PatternArguments a
forall a b. (a, b) -> a
fst f (PatternArguments a, PatternArguments b)
f (PatternArguments (a, b))
f,
b -> f (PatternArguments b) -> GuidedArguments f b
forall pat (f :: * -> *).
(MakeGuidedArguments pat, Functor f) =>
pat -> f (PatternArguments pat) -> GuidedArguments f pat
forall (f :: * -> *).
Functor f =>
b -> f (PatternArguments b) -> GuidedArguments f b
makeGuidedArgs b
pb (f (PatternArguments b) -> GuidedArguments f b)
-> f (PatternArguments b) -> GuidedArguments f b
forall a b. (a -> b) -> a -> b
$ ((PatternArguments a, PatternArguments b) -> PatternArguments b)
-> f (PatternArguments a, PatternArguments b)
-> f (PatternArguments b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PatternArguments a, PatternArguments b) -> PatternArguments b
forall a b. (a, b) -> b
snd f (PatternArguments a, PatternArguments b)
f (PatternArguments (a, b))
f)
type instance
GuidedArguments f (a,b,c) =
(GuidedArguments f a, GuidedArguments f b, GuidedArguments f c)
type instance
PatternArguments (a,b,c) =
(PatternArguments a, PatternArguments b, PatternArguments c)
instance
(MakeGuidedArguments a, MakeGuidedArguments b, MakeGuidedArguments c) =>
MakeGuidedArguments (a,b,c) where
makeGuidedArgs :: forall (f :: * -> *).
Functor f =>
(a, b, c)
-> f (PatternArguments (a, b, c)) -> GuidedArguments f (a, b, c)
makeGuidedArgs (a
pa,b
pb,c
pc) f (PatternArguments (a, b, c))
f =
(a -> f (PatternArguments a) -> GuidedArguments f a
forall pat (f :: * -> *).
(MakeGuidedArguments pat, Functor f) =>
pat -> f (PatternArguments pat) -> GuidedArguments f pat
forall (f :: * -> *).
Functor f =>
a -> f (PatternArguments a) -> GuidedArguments f a
makeGuidedArgs a
pa (f (PatternArguments a) -> GuidedArguments f a)
-> f (PatternArguments a) -> GuidedArguments f a
forall a b. (a -> b) -> a -> b
$ ((PatternArguments a, PatternArguments b, PatternArguments c)
-> PatternArguments a)
-> f (PatternArguments a, PatternArguments b, PatternArguments c)
-> f (PatternArguments a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PatternArguments a, PatternArguments b, PatternArguments c)
-> PatternArguments a
forall a b c. (a, b, c) -> a
fst3 f (PatternArguments a, PatternArguments b, PatternArguments c)
f (PatternArguments (a, b, c))
f,
b -> f (PatternArguments b) -> GuidedArguments f b
forall pat (f :: * -> *).
(MakeGuidedArguments pat, Functor f) =>
pat -> f (PatternArguments pat) -> GuidedArguments f pat
forall (f :: * -> *).
Functor f =>
b -> f (PatternArguments b) -> GuidedArguments f b
makeGuidedArgs b
pb (f (PatternArguments b) -> GuidedArguments f b)
-> f (PatternArguments b) -> GuidedArguments f b
forall a b. (a -> b) -> a -> b
$ ((PatternArguments a, PatternArguments b, PatternArguments c)
-> PatternArguments b)
-> f (PatternArguments a, PatternArguments b, PatternArguments c)
-> f (PatternArguments b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PatternArguments a, PatternArguments b, PatternArguments c)
-> PatternArguments b
forall a b c. (a, b, c) -> b
snd3 f (PatternArguments a, PatternArguments b, PatternArguments c)
f (PatternArguments (a, b, c))
f,
c -> f (PatternArguments c) -> GuidedArguments f c
forall pat (f :: * -> *).
(MakeGuidedArguments pat, Functor f) =>
pat -> f (PatternArguments pat) -> GuidedArguments f pat
forall (f :: * -> *).
Functor f =>
c -> f (PatternArguments c) -> GuidedArguments f c
makeGuidedArgs c
pc (f (PatternArguments c) -> GuidedArguments f c)
-> f (PatternArguments c) -> GuidedArguments f c
forall a b. (a -> b) -> a -> b
$ ((PatternArguments a, PatternArguments b, PatternArguments c)
-> PatternArguments c)
-> f (PatternArguments a, PatternArguments b, PatternArguments c)
-> f (PatternArguments c)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PatternArguments a, PatternArguments b, PatternArguments c)
-> PatternArguments c
forall a b c. (a, b, c) -> c
thd3 f (PatternArguments a, PatternArguments b, PatternArguments c)
f (PatternArguments (a, b, c))
f)
withPreparedArgs ::
PrepareArguments (T inp) inp a ->
(a -> T inp out) -> Causal.T inp out
withPreparedArgs :: forall inp a out.
PrepareArguments (T inp) inp a -> (a -> T inp out) -> T inp out
withPreparedArgs (PrepareArguments T inp inp -> a
prepare) a -> T inp out
f = (T inp inp -> T inp out) -> T inp out
forall inp out. (T inp inp -> T inp out) -> T inp out
withId ((T inp inp -> T inp out) -> T inp out)
-> (T inp inp -> T inp out) -> T inp out
forall a b. (a -> b) -> a -> b
$ a -> T inp out
f (a -> T inp out) -> (T inp inp -> a) -> T inp inp -> T inp out
forall b c a. (b -> c) -> (a -> b) -> 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 inp inp -> a
prepare
withPreparedArgs2 ::
PrepareArguments (T (inp0, inp1)) inp0 a ->
PrepareArguments (T (inp0, inp1)) inp1 b ->
(a -> b -> T (inp0, inp1) out) ->
Causal.T (inp0, inp1) out
withPreparedArgs2 :: forall inp0 inp1 a b out.
PrepareArguments (T (inp0, inp1)) inp0 a
-> PrepareArguments (T (inp0, inp1)) inp1 b
-> (a -> b -> T (inp0, inp1) out)
-> T (inp0, inp1) out
withPreparedArgs2 PrepareArguments (T (inp0, inp1)) inp0 a
prepareA PrepareArguments (T (inp0, inp1)) inp1 b
prepareB a -> b -> T (inp0, inp1) out
f =
PrepareArguments (T (inp0, inp1)) (inp0, inp1) (a, b)
-> ((a, b) -> T (inp0, inp1) out) -> T (inp0, inp1) out
forall inp a out.
PrepareArguments (T inp) inp a -> (a -> T inp out) -> T inp out
withPreparedArgs (PrepareArguments (T (inp0, inp1)) inp0 a
-> PrepareArguments (T (inp0, inp1)) inp1 b
-> PrepareArguments (T (inp0, inp1)) (inp0, inp1) (a, b)
forall (f :: * -> *) a0 b0 a1 b1.
Functor f =>
PrepareArguments f a0 b0
-> PrepareArguments f a1 b1 -> PrepareArguments f (a0, a1) (b0, b1)
pairArgs PrepareArguments (T (inp0, inp1)) inp0 a
prepareA PrepareArguments (T (inp0, inp1)) inp1 b
prepareB) ((a -> b -> T (inp0, inp1) out) -> (a, b) -> T (inp0, inp1) out
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> T (inp0, inp1) out
f)
newtype PrepareArguments f merged separated =
PrepareArguments (f merged -> separated)
atomArg :: PrepareArguments f a (f a)
atomArg :: forall (f :: * -> *) a. PrepareArguments f a (f a)
atomArg = (f a -> f a) -> PrepareArguments f a (f a)
forall (f :: * -> *) merged separated.
(f merged -> separated) -> PrepareArguments f merged separated
PrepareArguments f a -> f a
forall a. a -> a
id
stereoArgs ::
(Functor f) =>
PrepareArguments f a b ->
PrepareArguments f (Stereo.T a) (Stereo.T b)
stereoArgs :: forall (f :: * -> *) a b.
Functor f =>
PrepareArguments f a b -> PrepareArguments f (T a) (T b)
stereoArgs (PrepareArguments f a -> b
p) =
(f (T a) -> T b) -> PrepareArguments f (T a) (T b)
forall (f :: * -> *) merged separated.
(f merged -> separated) -> PrepareArguments f merged separated
PrepareArguments ((f (T a) -> T b) -> PrepareArguments f (T a) (T b))
-> (f (T a) -> T b) -> PrepareArguments f (T a) (T b)
forall a b. (a -> b) -> a -> b
$ (f a -> b) -> T (f a) -> T b
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> b
p (T (f a) -> T b) -> (f (T a) -> T (f a)) -> f (T a) -> T b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f (T a) -> T (f a)
forall (f :: * -> *) a. Functor f => f (T a) -> T (f a)
Stereo.sequence
pairArgs ::
(Functor f) =>
PrepareArguments f a0 b0 ->
PrepareArguments f a1 b1 ->
PrepareArguments f (a0,a1) (b0,b1)
pairArgs :: forall (f :: * -> *) a0 b0 a1 b1.
Functor f =>
PrepareArguments f a0 b0
-> PrepareArguments f a1 b1 -> PrepareArguments f (a0, a1) (b0, b1)
pairArgs (PrepareArguments f a0 -> b0
p0) (PrepareArguments f a1 -> b1
p1) =
(f (a0, a1) -> (b0, b1)) -> PrepareArguments f (a0, a1) (b0, b1)
forall (f :: * -> *) merged separated.
(f merged -> separated) -> PrepareArguments f merged separated
PrepareArguments ((f (a0, a1) -> (b0, b1)) -> PrepareArguments f (a0, a1) (b0, b1))
-> (f (a0, a1) -> (b0, b1)) -> PrepareArguments f (a0, a1) (b0, b1)
forall a b. (a -> b) -> a -> b
$ \f (a0, a1)
f -> (f a0 -> b0
p0 (f a0 -> b0) -> f a0 -> b0
forall a b. (a -> b) -> a -> b
$ ((a0, a1) -> a0) -> f (a0, a1) -> f a0
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a0, a1) -> a0
forall a b. (a, b) -> a
fst f (a0, a1)
f, f a1 -> b1
p1 (f a1 -> b1) -> f a1 -> b1
forall a b. (a -> b) -> a -> b
$ ((a0, a1) -> a1) -> f (a0, a1) -> f a1
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a0, a1) -> a1
forall a b. (a, b) -> b
snd f (a0, a1)
f)
tripleArgs ::
(Functor f) =>
PrepareArguments f a0 b0 ->
PrepareArguments f a1 b1 ->
PrepareArguments f a2 b2 ->
PrepareArguments f (a0,a1,a2) (b0,b1,b2)
tripleArgs :: forall (f :: * -> *) a0 b0 a1 b1 a2 b2.
Functor f =>
PrepareArguments f a0 b0
-> PrepareArguments f a1 b1
-> PrepareArguments f a2 b2
-> PrepareArguments f (a0, a1, a2) (b0, b1, b2)
tripleArgs (PrepareArguments f a0 -> b0
p0) (PrepareArguments f a1 -> b1
p1) (PrepareArguments f a2 -> b2
p2) =
(f (a0, a1, a2) -> (b0, b1, b2))
-> PrepareArguments f (a0, a1, a2) (b0, b1, b2)
forall (f :: * -> *) merged separated.
(f merged -> separated) -> PrepareArguments f merged separated
PrepareArguments ((f (a0, a1, a2) -> (b0, b1, b2))
-> PrepareArguments f (a0, a1, a2) (b0, b1, b2))
-> (f (a0, a1, a2) -> (b0, b1, b2))
-> PrepareArguments f (a0, a1, a2) (b0, b1, b2)
forall a b. (a -> b) -> a -> b
$ \f (a0, a1, a2)
f ->
(f a0 -> b0
p0 (f a0 -> b0) -> f a0 -> b0
forall a b. (a -> b) -> a -> b
$ ((a0, a1, a2) -> a0) -> f (a0, a1, a2) -> f a0
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a0, a1, a2) -> a0
forall a b c. (a, b, c) -> a
fst3 f (a0, a1, a2)
f, f a1 -> b1
p1 (f a1 -> b1) -> f a1 -> b1
forall a b. (a -> b) -> a -> b
$ ((a0, a1, a2) -> a1) -> f (a0, a1, a2) -> f a1
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a0, a1, a2) -> a1
forall a b c. (a, b, c) -> b
snd3 f (a0, a1, a2)
f, f a2 -> b2
p2 (f a2 -> b2) -> f a2 -> b2
forall a b. (a -> b) -> a -> b
$ ((a0, a1, a2) -> a2) -> f (a0, a1, a2) -> f a2
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a0, a1, a2) -> a2
forall a b c. (a, b, c) -> c
thd3 f (a0, a1, a2)
f)