{-# 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)


-- | similar to @Causal.T a b@
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))
               -- compute next value
           (forall r. CodeGenFunction r (global, state))
               -- initial state
           (forall r. global -> CodeGenFunction r ())
               -- cleanup


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


{-
We must not define Category and Arrow instances
because in osci***osci the result of osci would be shared,
although it depends on the particular input.

instance Category T where
   id = tagUnique Cat.id
   Cons a . Cons b = tagUnique (a . b)

instance Arrow T where
   arr f = tagUnique $ arr f
   first (Cons a) = tagUnique $ first a
-}

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

-- dummy for debugging
_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


{- |
Using 'withArgs' you can simplify

> let x = F.lift (arr fst)
>     y = F.lift (arr (fst.snd))
>     z = F.lift (arr (snd.snd))
> in  F.compile (f x y z)

to

> withArgs $ \(x,(y,z)) -> f x y z
-}
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


{-
I have thought about an Arg type, that marks where to stop descending.
This way we can throw away all of these FlexibleContext instances
and the user can freely choose the granularity of arguments.
However this does not work so easily,
because we would need a functional depedency from, say,
@(Arg a, Arg b)@ to @(a,b)@.
This is the opposite direction to the dependency we use currently.
The 'AnyArg' type provides a solution in this spirit.
-}
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

{- |
Consistent with pair instance.
You may use 'AnyArg' or 'withGuidedArgs'
to stop descending into the stereo channels.
-}
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)


{- |
You can use this to explicitly stop breaking of composed data types.
It might be more comfortable to do this using 'withGuidedArgs'.
-}
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



{- |
This is similar to 'withArgs'
but it requires to specify the decomposition depth
using constructors in the arguments.
-}
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)



{- |
This is similar to 'withArgs'
but it allows to specify the decomposition depth using a pattern.
-}
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)



{- |
Alternative to withGuidedArgs.
This way of pattern construction is even Haskell 98.
-}
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)