{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Rank2Types #-}
module Synthesizer.LLVM.Causal.ProcessPacked where

import qualified Synthesizer.LLVM.Causal.Private as CausalPriv
import qualified Synthesizer.LLVM.Causal.Process as Causal
import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
import qualified Synthesizer.LLVM.Frame.SerialVector.Code as SerialCode
import qualified Synthesizer.LLVM.Frame.SerialVector.Class as SerialClass
import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
import qualified Synthesizer.LLVM.Frame as Frame

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

import qualified LLVM.Extra.Multi.Vector as MultiVector
import qualified LLVM.Extra.Multi.Value.Marshal as Marshal
import qualified LLVM.Extra.Multi.Value as MultiValue
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Extra.MaybeContinuation as Maybe
import qualified LLVM.Extra.Control as C
import qualified LLVM.Extra.Arithmetic as A

import qualified Type.Data.Num.Decimal as TypeNum
import Type.Data.Num.Decimal ((:<:))
import Type.Base.Proxy (Proxy)

import qualified LLVM.Core as LLVM

import qualified Control.Arrow as Arrow
import qualified Control.Category as Cat
import qualified Control.Monad.Trans.Class as MT
import qualified Control.Monad.Trans.State as MS
import Control.Arrow ((<<<))

import Data.Tuple.HT (swap)
import Data.Word (Word)

import NumericPrelude.Numeric
import NumericPrelude.Base hiding (map, zipWith, takeWhile)
import Prelude ()


type Serial n a = MultiValue.T (Serial.T n a)


{- |
Run a scalar process on packed data.
If the signal length is not divisible by the chunk size,
then the last chunk is dropped.
-}
pack ::
   (SerialClass.Read  va, n ~ SerialClass.Size va, a ~ SerialClass.Element va,
    SerialClass.Write vb, n ~ SerialClass.Size vb, b ~ SerialClass.Element vb)
   =>
   Causal.T a b -> Causal.T va vb
pack :: forall va n a vb b.
(Read va, n ~ Size va, a ~ Element va, Write vb, n ~ Size vb,
 b ~ Element vb) =>
T a b -> T va vb
pack (CausalPriv.Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) = (forall r c.
 Phi c =>
 global -> Value (Ptr local) -> va -> state -> T r c (vb, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T va vb
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
CausalPriv.Cons
   (\global
global Value (Ptr local)
local va
a state
s -> do
      ReadIterator (ReadIt va) va
r <- CodeGenFunction r (ReadIterator (ReadIt va) va)
-> T r c (ReadIterator (ReadIt va) va)
forall r a z. CodeGenFunction r a -> T r z a
Maybe.lift (CodeGenFunction r (ReadIterator (ReadIt va) va)
 -> T r c (ReadIterator (ReadIt va) va))
-> CodeGenFunction r (ReadIterator (ReadIt va) va)
-> T r c (ReadIterator (ReadIt va) va)
forall a b. (a -> b) -> a -> b
$ va -> CodeGenFunction r (ReadIterator (ReadIt va) va)
forall r. va -> CodeGenFunction r (ReadIterator (ReadIt va) va)
forall v r.
Read v =>
v -> CodeGenFunction r (ReadIterator (ReadIt v) v)
SerialClass.readStart va
a
      ((ReadIterator (ReadIt va) va
_,Iterator WriteMode (WriteIt vb) vb
w2),(Value Word
_,state
s2)) <-
         CodeGenFunction
  r
  (Value Bool,
   ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
    (Value Word, state)))
-> T r
     c
     ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
      (Value Word, state))
forall z r a. Phi z => CodeGenFunction r (Value Bool, a) -> T r z a
Maybe.fromBool (CodeGenFunction
   r
   (Value Bool,
    ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
     (Value Word, state)))
 -> T r
      c
      ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
       (Value Word, state)))
-> CodeGenFunction
     r
     (Value Bool,
      ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
       (Value Word, state)))
-> T r
     c
     ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
      (Value Word, state))
forall a b. (a -> b) -> a -> b
$
         (Value Bool,
 ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
  (Value Word, state)))
-> ((Value Bool,
     ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
      (Value Word, state)))
    -> CodeGenFunction r (Value Bool))
-> ((Value Bool,
     ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
      (Value Word, state)))
    -> CodeGenFunction
         r
         (Value Bool,
          ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
           (Value Word, state))))
-> CodeGenFunction
     r
     (Value Bool,
      ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
       (Value Word, state)))
forall a r.
Phi a =>
a
-> (a -> CodeGenFunction r (Value Bool))
-> (a -> CodeGenFunction r a)
-> CodeGenFunction r a
C.whileLoop
            (Bool -> Value Bool
forall a. IsConst a => a -> Value a
LLVM.valueOf Bool
True,
             let w :: Iterator WriteMode (WriteIt vb) vb
w = Iterator WriteMode (WriteIt vb) vb
forall a. Undefined a => a
Tuple.undef
             in ((ReadIterator (ReadIt va) va
r,Iterator WriteMode (WriteIt vb) vb
w),
                 (Word -> Value Word
forall a. IsConst a => a -> Value a
LLVM.valueOf (Iterator WriteMode (WriteIt vb) vb -> Word
forall v i mode it.
(Sized v, Integral i) =>
Iterator mode it v -> i
SerialClass.sizeOfIterator Iterator WriteMode (WriteIt vb) vb
w :: Word), state
s)))
            (\(Value Bool
cont,((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb)
_rw0,(Value Word
i0,state
_s0))) ->
               Value Bool -> Value Bool -> CodeGenFunction r (Value Bool)
forall a r. Logic a => a -> a -> CodeGenFunction r a
forall r.
Value Bool -> Value Bool -> CodeGenFunction r (Value Bool)
A.and Value Bool
cont (Value Bool -> CodeGenFunction r (Value Bool))
-> CodeGenFunction r (Value Bool) -> CodeGenFunction r (Value Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CmpPredicate
-> Value Word
-> Value Word
-> CodeGenFunction r (CmpResult (Value Word))
forall r.
CmpPredicate
-> Value Word
-> Value Word
-> CodeGenFunction r (CmpResult (Value Word))
forall a r.
Comparison a =>
CmpPredicate -> a -> a -> CodeGenFunction r (CmpResult a)
A.cmp CmpPredicate
LLVM.CmpGT Value Word
i0 Value Word
forall a. Additive a => a
A.zero)
            (\(Value Bool
_,((ReadIterator (ReadIt va) va
r0,Iterator WriteMode (WriteIt vb) vb
w0),(Value Word
i0,state
s0))) -> T r
  (Value Bool,
   ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
    (Value Word, state)))
  ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
   (Value Word, state))
-> CodeGenFunction
     r
     (Value Bool,
      ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
       (Value Word, state)))
forall a r.
Undefined a =>
T r (Value Bool, a) a -> CodeGenFunction r (Value Bool, a)
Maybe.toBool (T r
   (Value Bool,
    ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
     (Value Word, state)))
   ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
    (Value Word, state))
 -> CodeGenFunction
      r
      (Value Bool,
       ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
        (Value Word, state))))
-> T r
     (Value Bool,
      ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
       (Value Word, state)))
     ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
      (Value Word, state))
-> CodeGenFunction
     r
     (Value Bool,
      ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
       (Value Word, state)))
forall a b. (a -> b) -> a -> b
$ do
               (a
ai,ReadIterator (ReadIt va) va
r1) <- CodeGenFunction r (a, ReadIterator (ReadIt va) va)
-> T r
     (Value Bool,
      ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
       (Value Word, state)))
     (a, ReadIterator (ReadIt va) va)
forall r a z. CodeGenFunction r a -> T r z a
Maybe.lift (CodeGenFunction r (a, ReadIterator (ReadIt va) va)
 -> T r
      (Value Bool,
       ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
        (Value Word, state)))
      (a, ReadIterator (ReadIt va) va))
-> CodeGenFunction r (a, ReadIterator (ReadIt va) va)
-> T r
     (Value Bool,
      ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
       (Value Word, state)))
     (a, ReadIterator (ReadIt va) va)
forall a b. (a -> b) -> a -> b
$ ReadIterator (ReadIt va) va
-> CodeGenFunction r (Element va, ReadIterator (ReadIt va) va)
forall v r.
Read v =>
ReadIterator (ReadIt v) v
-> CodeGenFunction r (Element v, ReadIterator (ReadIt v) v)
forall r.
ReadIterator (ReadIt va) va
-> CodeGenFunction r (Element va, ReadIterator (ReadIt va) va)
SerialClass.readNext ReadIterator (ReadIt va) va
r0
               (b
bi,state
s1) <- global
-> Value (Ptr local)
-> a
-> state
-> T r
     (Value Bool,
      ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
       (Value Word, state)))
     (b, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state)
next global
global Value (Ptr local)
local a
ai state
s0
               CodeGenFunction
  r
  ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
   (Value Word, state))
-> T r
     (Value Bool,
      ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
       (Value Word, state)))
     ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
      (Value Word, state))
forall r a z. CodeGenFunction r a -> T r z a
Maybe.lift (CodeGenFunction
   r
   ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
    (Value Word, state))
 -> T r
      (Value Bool,
       ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
        (Value Word, state)))
      ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
       (Value Word, state)))
-> CodeGenFunction
     r
     ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
      (Value Word, state))
-> T r
     (Value Bool,
      ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
       (Value Word, state)))
     ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
      (Value Word, state))
forall a b. (a -> b) -> a -> b
$ do
                  Iterator WriteMode (WriteIt vb) vb
w1 <- Element vb
-> Iterator WriteMode (WriteIt vb) vb
-> CodeGenFunction r (Iterator WriteMode (WriteIt vb) vb)
forall v r.
Write v =>
Element v
-> WriteIterator (WriteIt v) v
-> CodeGenFunction r (WriteIterator (WriteIt v) v)
forall r.
Element vb
-> Iterator WriteMode (WriteIt vb) vb
-> CodeGenFunction r (Iterator WriteMode (WriteIt vb) vb)
SerialClass.writeNext b
Element vb
bi Iterator WriteMode (WriteIt vb) vb
w0
                  Value Word
i1 <- Value Word -> CodeGenFunction r (Value Word)
forall a r.
(IsArithmetic a, IsConst a, Num a) =>
Value a -> CodeGenFunction r (Value a)
A.dec Value Word
i0
                  ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
 (Value Word, state))
-> CodeGenFunction
     r
     ((ReadIterator (ReadIt va) va, Iterator WriteMode (WriteIt vb) vb),
      (Value Word, state))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ReadIterator (ReadIt va) va
r1,Iterator WriteMode (WriteIt vb) vb
w1),(Value Word
i1,state
s1)))
      vb
b <- CodeGenFunction r vb -> T r c vb
forall r a z. CodeGenFunction r a -> T r z a
Maybe.lift (CodeGenFunction r vb -> T r c vb)
-> CodeGenFunction r vb -> T r c vb
forall a b. (a -> b) -> a -> b
$ Iterator WriteMode (WriteIt vb) vb -> CodeGenFunction r vb
forall v r.
Write v =>
WriteIterator (WriteIt v) v -> CodeGenFunction r v
forall r.
Iterator WriteMode (WriteIt vb) vb -> CodeGenFunction r vb
SerialClass.writeStop Iterator WriteMode (WriteIt vb) vb
w2
      (vb, state) -> T r c (vb, state)
forall a. a -> T r c a
forall (m :: * -> *) a. Monad m => a -> m a
return (vb
b, state
s2))
   CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start
   global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop

{- |
Like 'pack' but duplicates the code for the scalar process.
That is, for vectors of size n,
the code for the scalar causal process will be written n times.
This is efficient only for simple input processes.
-}
packSmall ::
   (SerialClass.Read  va, n ~ SerialClass.Size va, a ~ SerialClass.Element va,
    SerialClass.Write vb, n ~ SerialClass.Size vb, b ~ SerialClass.Element vb)
   =>
   Causal.T a b -> Causal.T va vb
packSmall :: forall va n a vb b.
(Read va, n ~ Size va, a ~ Element va, Write vb, n ~ Size vb,
 b ~ Element vb) =>
T a b -> T va vb
packSmall (CausalPriv.Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) = (forall r c.
 Phi c =>
 global -> Value (Ptr local) -> va -> state -> T r c (vb, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T va vb
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
CausalPriv.Cons
   (\global
global Value (Ptr local)
local va
a ->
      StateT state (T r c) vb -> state -> T r c (vb, state)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
MS.runStateT (StateT state (T r c) vb -> state -> T r c (vb, state))
-> StateT state (T r c) vb -> state -> T r c (vb, state)
forall a b. (a -> b) -> a -> b
$
         T r c vb -> StateT state (T r c) vb
forall (m :: * -> *) a. Monad m => m a -> StateT state m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (T r c vb -> StateT state (T r c) vb)
-> ([b] -> T r c vb) -> [b] -> StateT state (T r c) vb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeGenFunction r vb -> T r c vb
forall r a z. CodeGenFunction r a -> T r z a
Maybe.lift (CodeGenFunction r vb -> T r c vb)
-> ([b] -> CodeGenFunction r vb) -> [b] -> T r c vb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> CodeGenFunction r vb
[Element vb] -> CodeGenFunction r vb
forall r. [Element vb] -> CodeGenFunction r vb
forall v r. Write v => [Element v] -> CodeGenFunction r v
SerialClass.assemble
         ([b] -> StateT state (T r c) vb)
-> StateT state (T r c) [b] -> StateT state (T r c) vb
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
         (a -> StateT state (T r c) b) -> [a] -> StateT state (T r c) [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((state -> T r c (b, state)) -> StateT state (T r c) b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
MS.StateT ((state -> T r c (b, state)) -> StateT state (T r c) b)
-> (a -> state -> T r c (b, state)) -> a -> StateT state (T r c) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. global -> Value (Ptr local) -> a -> state -> T r c (b, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> a -> state -> T r c (b, state)
next global
global Value (Ptr local)
local)
         ([a] -> StateT state (T r c) [b])
-> StateT state (T r c) [a] -> StateT state (T r c) [b]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
         (T r c [a] -> StateT state (T r c) [a]
forall (m :: * -> *) a. Monad m => m a -> StateT state m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (T r c [a] -> StateT state (T r c) [a])
-> T r c [a] -> StateT state (T r c) [a]
forall a b. (a -> b) -> a -> b
$ CodeGenFunction r [a] -> T r c [a]
forall r a z. CodeGenFunction r a -> T r z a
Maybe.lift (CodeGenFunction r [a] -> T r c [a])
-> CodeGenFunction r [a] -> T r c [a]
forall a b. (a -> b) -> a -> b
$ va -> CodeGenFunction r [Element va]
forall r. va -> CodeGenFunction r [Element va]
forall v r. Read v => v -> CodeGenFunction r [Element v]
SerialClass.dissect va
a))
   CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start
   global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop


raise ::
   (TypeNum.Positive n, MultiVector.Additive a) =>
   Exp a -> Causal.T (Serial n a) (Serial n a)
raise :: forall n a.
(Positive n, Additive a) =>
Exp a -> T (Serial n a) (Serial n a)
raise Exp a
x =
   (forall r. Serial n a -> CodeGenFunction r (Serial n a))
-> T (Serial n a) (Serial n a)
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
CausalPriv.map
      (\Serial n a
y -> Exp (T n a) -> forall r. CodeGenFunction r (Serial n a)
forall a. Exp a -> forall r. CodeGenFunction r (T a)
Expr.unExp (Exp a -> Exp (T n a)
forall n a. (Positive n, C a) => Exp a -> Exp (T n a)
Serial.upsample Exp a
x) CodeGenFunction r (Serial n a)
-> (Serial n a -> CodeGenFunction r (Serial n a))
-> CodeGenFunction r (Serial n a)
forall a b.
CodeGenFunction r a
-> (a -> CodeGenFunction r b) -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Serial n a -> Serial n a -> CodeGenFunction r (Serial n a))
-> Serial n a -> Serial n a -> CodeGenFunction r (Serial n a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Serial n a -> Serial n a -> CodeGenFunction r (Serial n a)
forall a r. Additive a => a -> a -> CodeGenFunction r a
Frame.mix Serial n a
y)

amplify ::
   (TypeNum.Positive n, MultiVector.PseudoRing a) =>
   Exp a -> Causal.T (Serial n a) (Serial n a)
amplify :: forall n a.
(Positive n, PseudoRing a) =>
Exp a -> T (Serial n a) (Serial n a)
amplify Exp a
x =
   (forall r. Serial n a -> CodeGenFunction r (Serial n a))
-> T (Serial n a) (Serial n a)
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
CausalPriv.map
      (\Serial n a
y -> Exp (T n a) -> forall r. CodeGenFunction r (Serial n a)
forall a. Exp a -> forall r. CodeGenFunction r (T a)
Expr.unExp (Exp a -> Exp (T n a)
forall n a. (Positive n, C a) => Exp a -> Exp (T n a)
Serial.upsample Exp a
x) CodeGenFunction r (Serial n a)
-> (Serial n a -> CodeGenFunction r (Serial n a))
-> CodeGenFunction r (Serial n a)
forall a b.
CodeGenFunction r a
-> (a -> CodeGenFunction r b) -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Serial n a -> Serial n a -> CodeGenFunction r (Serial n a))
-> Serial n a -> Serial n a -> CodeGenFunction r (Serial n a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Serial n a -> Serial n a -> CodeGenFunction r (Serial n a)
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
Frame.amplifyMono Serial n a
y)

amplifyStereo ::
   (TypeNum.Positive n, MultiVector.PseudoRing a) =>
   Exp a -> Causal.T (Stereo.T (Serial n a)) (Stereo.T (Serial n a))
amplifyStereo :: forall n a.
(Positive n, PseudoRing a) =>
Exp a -> T (T (Serial n a)) (T (Serial n a))
amplifyStereo Exp a
x =
   (forall r. T (Serial n a) -> CodeGenFunction r (T (Serial n a)))
-> T (T (Serial n a)) (T (Serial n a))
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
CausalPriv.map
      (\T (Serial n a)
y -> Exp (T n a) -> forall r. CodeGenFunction r (Serial n a)
forall a. Exp a -> forall r. CodeGenFunction r (T a)
Expr.unExp (Exp a -> Exp (T n a)
forall n a. (Positive n, C a) => Exp a -> Exp (T n a)
Serial.upsample Exp a
x) CodeGenFunction r (Serial n a)
-> (Serial n a -> CodeGenFunction r (T (Serial n a)))
-> CodeGenFunction r (T (Serial n a))
forall a b.
CodeGenFunction r a
-> (a -> CodeGenFunction r b) -> CodeGenFunction r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Serial n a
 -> T (Serial n a) -> CodeGenFunction r (T (Serial n a)))
-> T (Serial n a)
-> Serial n a
-> CodeGenFunction r (T (Serial n a))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Serial n a -> T (Serial n a) -> CodeGenFunction r (T (Serial n a))
forall a r. PseudoRing a => a -> T a -> CodeGenFunction r (T a)
Frame.amplifyStereo T (Serial n a)
y)


delay1 ::
   (LLVM.Positive n, Marshal.C a,
    MultiVector.C a, SerialCode.Value n a ~ v) =>
   Exp a -> Causal.T v v
delay1 :: forall n a v.
(Positive n, C a, C a, Value n a ~ v) =>
Exp a -> T v v
delay1 Exp a
initial =
   Exp a -> T (v, T a) (v, T a) -> T v v
forall ce c a b.
(Aggregate ce c, C c) =>
ce -> T (a, c) (b, c) -> T a b
Causal.loop Exp a
initial (T (v, T a) (v, T a) -> T v v) -> T (v, T a) (v, T a) -> T v v
forall a b. (a -> b) -> a -> b
$
   ((Exp (T n a), Exp a) -> (Exp (T n a), Exp a))
-> T (v, T a) (v, T a)
forall ae a be b.
(Aggregate ae a, Aggregate be b) =>
(ae -> be) -> T a b
Causal.map ((Exp a, Exp (T n a)) -> (Exp (T n a), Exp a)
forall a b. (a, b) -> (b, a)
swap ((Exp a, Exp (T n a)) -> (Exp (T n a), Exp a))
-> ((Exp (T n a), Exp a) -> (Exp a, Exp (T n a)))
-> (Exp (T n a), Exp a)
-> (Exp (T n a), Exp a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp a -> Exp (T n a) -> (Exp a, Exp (T n a)))
-> (Exp a, Exp (T n a)) -> (Exp a, Exp (T n a))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Exp a -> Exp (T n a) -> (Exp a, Exp (T n a))
forall n x a v.
(Positive n, C x, Exp x ~ a, Exp (T n x) ~ v) =>
a -> v -> (a, v)
Serial.shiftUp ((Exp a, Exp (T n a)) -> (Exp a, Exp (T n a)))
-> ((Exp (T n a), Exp a) -> (Exp a, Exp (T n a)))
-> (Exp (T n a), Exp a)
-> (Exp a, Exp (T n a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp (T n a), Exp a) -> (Exp a, Exp (T n a))
forall a b. (a, b) -> (b, a)
swap)

differentiate ::
   (LLVM.Positive n, Marshal.C a,
    MultiVector.Additive a, SerialCode.Value n a ~ v) =>
   Exp a -> Causal.T v v
differentiate :: forall n a v.
(Positive n, C a, Additive a, Value n a ~ v) =>
Exp a -> T v v
differentiate Exp a
initial = T v v
forall a. T a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Cat.id T v v -> T v v -> T v v
forall a. C a => a -> a -> a
- Exp a -> T v v
forall n a v.
(Positive n, C a, C a, Value n a ~ v) =>
Exp a -> T v v
delay1 Exp a
initial

integrate ::
   (LLVM.Positive n, Marshal.C a,
    MultiVector.Additive a, SerialCode.Value n a ~ v) =>
   Exp a -> Causal.T v v
integrate :: forall n a v.
(Positive n, C a, Additive a, Value n a ~ v) =>
Exp a -> T v v
integrate =
   (Exp (T n a) -> Exp a -> (Exp (T n a), Exp a)) -> Exp a -> T v v
forall state statel a al b bl.
(Aggregate state statel, C statel, Aggregate a al,
 Aggregate b bl) =>
(a -> state -> (b, state)) -> state -> T al bl
Causal.mapAccum (\Exp (T n a)
a Exp a
acc0 -> (Exp a, Exp (T n a)) -> (Exp (T n a), Exp a)
forall a b. (a, b) -> (b, a)
swap ((Exp a, Exp (T n a)) -> (Exp (T n a), Exp a))
-> (Exp a, Exp (T n a)) -> (Exp (T n a), Exp a)
forall a b. (a -> b) -> a -> b
$ Exp a -> Exp (T n a) -> (Exp a, Exp (T n a))
forall n a.
(Positive n, Additive a) =>
Exp a -> Exp (T n a) -> (Exp a, Exp (T n a))
Serial.cumulate Exp a
acc0 Exp (T n a)
a)


osciCore ::
   (TypeNum.Positive n, Marshal.C t, MultiVector.Fraction t) =>
   Causal.T (Serial n t, Serial n t) (Serial n t)
osciCore :: forall n t.
(Positive n, C t, Fraction t) =>
T (Serial n t, Serial n t) (Serial n t)
osciCore =
   (forall r.
 Serial n t -> Serial n t -> CodeGenFunction r (Serial n t))
-> T (Serial n t, Serial n t) (Serial n t)
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
CausalPriv.zipWith Serial n t -> Serial n t -> CodeGenFunction r (Serial n t)
forall r.
Serial n t -> Serial n t -> CodeGenFunction r (Serial n t)
forall a r. Fraction a => a -> a -> CodeGenFunction r a
A.addToPhase T (Serial n t, Serial n t) (Serial n t)
-> T (Serial n t, Serial n t) (Serial n t, Serial n t)
-> T (Serial n t, Serial n t) (Serial n t)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
   T (Serial n t) (Serial n t)
-> T (Serial n t, Serial n t) (Serial n t, Serial n t)
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arrow.second
      ((Exp (T n t) -> Exp t -> (Exp (T n t), Exp t))
-> Exp t -> T (Serial n t) (Serial n t)
forall state statel a al b bl.
(Aggregate state statel, C statel, Aggregate a al,
 Aggregate b bl) =>
(a -> state -> (b, state)) -> state -> T al bl
Causal.mapAccum
         (\Exp (T n t)
a Exp t
phase0 ->
            let (Exp t
phase1,Exp (T n t)
b1) = Exp t -> Exp (T n t) -> (Exp t, Exp (T n t))
forall n a.
(Positive n, Additive a) =>
Exp a -> Exp (T n a) -> (Exp a, Exp (T n a))
Serial.cumulate Exp t
phase0 Exp (T n t)
a
            in (Exp (T n t)
b1, (forall r. T t -> CodeGenFunction r (T t)) -> Exp t -> Exp t
forall ae am b.
Aggregate ae am =>
(forall r. am -> CodeGenFunction r (T b)) -> ae -> Exp b
Expr.liftM T t -> CodeGenFunction r (T t)
forall r. T t -> CodeGenFunction r (T t)
forall a r. Fraction a => a -> CodeGenFunction r a
A.signedFraction Exp t
phase1))
         Exp t
forall a. C a => Exp a
Expr.zero)

osci ::
   (TypeNum.Positive n, Marshal.C t, MultiVector.Fraction t) =>
   (forall r. Serial n t -> LLVM.CodeGenFunction r y) ->
   Causal.T (Serial n t, Serial n t) y
osci :: forall n t y.
(Positive n, C t, Fraction t) =>
(forall r. Serial n t -> CodeGenFunction r y)
-> T (Serial n t, Serial n t) y
osci forall r. Serial n t -> CodeGenFunction r y
wave = (forall r. Serial n t -> CodeGenFunction r y) -> T (Serial n t) y
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
CausalPriv.map Serial n t -> CodeGenFunction r y
forall r. Serial n t -> CodeGenFunction r y
wave T (Serial n t) y
-> T (Serial n t, Serial n t) (Serial n t)
-> T (Serial n t, Serial n t) y
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< T (Serial n t, Serial n t) (Serial n t)
forall n t.
(Positive n, C t, Fraction t) =>
T (Serial n t, Serial n t) (Serial n t)
osciCore

shapeModOsci ::
   (TypeNum.Positive n, Marshal.C t, MultiVector.Fraction t) =>
   (forall r. c -> Serial n t -> LLVM.CodeGenFunction r y) ->
   Causal.T (c, (Serial n t, Serial n t)) y
shapeModOsci :: forall n t c y.
(Positive n, C t, Fraction t) =>
(forall r. c -> Serial n t -> CodeGenFunction r y)
-> T (c, (Serial n t, Serial n t)) y
shapeModOsci forall r. c -> Serial n t -> CodeGenFunction r y
wave = (forall r. c -> Serial n t -> CodeGenFunction r y)
-> T (c, Serial n t) y
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
CausalPriv.zipWith c -> Serial n t -> CodeGenFunction r y
forall r. c -> Serial n t -> CodeGenFunction r y
wave T (c, Serial n t) y
-> T (c, (Serial n t, Serial n t)) (c, Serial n t)
-> T (c, (Serial n t, Serial n t)) y
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< T (Serial n t, Serial n t) (Serial n t)
-> T (c, (Serial n t, Serial n t)) (c, Serial n t)
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arrow.second T (Serial n t, Serial n t) (Serial n t)
forall n t.
(Positive n, C t, Fraction t) =>
T (Serial n t, Serial n t) (Serial n t)
osciCore


arrayElement ::
   (TypeNum.Positive n,
    MultiVector.C a, Marshal.C a,
    Marshal.Struct a ~ aStruct, LLVM.IsFirstClass aStruct,
    TypeNum.Natural i, TypeNum.Natural d, i :<: d) =>
   Proxy i -> Causal.T (MultiValue.T (MultiValue.Array d a)) (Serial n a)
arrayElement :: forall n a aStruct i d.
(Positive n, C a, C a, Struct a ~ aStruct, IsFirstClass aStruct,
 Natural i, Natural d, i :<: d) =>
Proxy i -> T (T (Array d a)) (Serial n a)
arrayElement Proxy i
i = (Exp a -> Exp (T n a)) -> T (T a) (Serial n a)
forall ae a be b.
(Aggregate ae a, Aggregate be b) =>
(ae -> be) -> T a b
Causal.map Exp a -> Exp (T n a)
forall n a. (Positive n, C a) => Exp a -> Exp (T n a)
Serial.upsample T (T a) (Serial n a)
-> T (T (Array d a)) (T a) -> T (T (Array d a)) (Serial n a)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< Proxy i -> T (T (Array d a)) (T a)
forall a aStruct i n.
(C a, Struct a ~ aStruct, IsFirstClass aStruct, Natural i,
 Natural n, i :<: n) =>
Proxy i -> T (T (Array n a)) (T a)
Causal.arrayElement Proxy i
i