{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Synthesizer.LLVM.Filter.FirstOrder (
   Result(Result,lowpass_,highpass_), Parameter, FirstOrder.parameter,
   causal, lowpassCausal, highpassCausal,
   causalInit, lowpassCausalInit, highpassCausalInit,
   causalPacked, lowpassCausalPacked, highpassCausalPacked,
   causalInitPacked, lowpassCausalInitPacked, highpassCausalInitPacked,
   causalRecursivePacked, -- for Allpass
   ) where

import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as FirstOrder
import qualified Synthesizer.Plain.Modifier as Modifier
import Synthesizer.Plain.Filter.Recursive.FirstOrder
          (Parameter(Parameter), Result(Result,lowpass_,highpass_))

import qualified Synthesizer.LLVM.Causal.Private as CausalPriv
import qualified Synthesizer.LLVM.Causal.Process as Causal
import qualified Synthesizer.LLVM.Frame.SerialVector.Class as SerialCode

import qualified LLVM.DSL.Expression as Expr

import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Arithmetic as A

import qualified LLVM.Core as LLVM

import Control.Arrow (arr, (&&&), (<<<))
import Control.Monad (foldM)
import Control.Applicative (liftA2)

import qualified Algebra.Module as Module

import NumericPrelude.Numeric
import NumericPrelude.Base


instance (Tuple.Phi a) => Tuple.Phi (Parameter a) where
   phi :: forall r.
BasicBlock -> Parameter a -> CodeGenFunction r (Parameter a)
phi = BasicBlock -> Parameter a -> CodeGenFunction r (Parameter a)
forall a (f :: * -> *) r.
(Phi a, Traversable f) =>
BasicBlock -> f a -> CodeGenFunction r (f a)
Tuple.phiTraversable
   addPhi :: forall r.
BasicBlock -> Parameter a -> Parameter a -> CodeGenFunction r ()
addPhi = BasicBlock -> Parameter a -> Parameter a -> CodeGenFunction r ()
forall a (f :: * -> *) r.
(Phi a, Foldable f, Applicative f) =>
BasicBlock -> f a -> f a -> CodeGenFunction r ()
Tuple.addPhiFoldable

instance Tuple.Undefined a => Tuple.Undefined (Parameter a) where
   undef :: Parameter a
undef = Parameter a
forall a (f :: * -> *). (Undefined a, Applicative f) => f a
Tuple.undefPointed

instance (Memory.C a) => Memory.C (Parameter a) where
   type Struct (Parameter a) = Memory.Struct a
   load :: forall r.
Value (Ptr (Struct (Parameter a)))
-> CodeGenFunction r (Parameter a)
load = (a -> Parameter a)
-> Value (Ptr (Struct a)) -> CodeGenFunction r (Parameter a)
forall a llvmValue r.
C a =>
(a -> llvmValue)
-> Value (Ptr (Struct a)) -> CodeGenFunction r llvmValue
Memory.loadNewtype a -> Parameter a
forall a. a -> Parameter a
Parameter
   store :: forall r.
Parameter a
-> Value (Ptr (Struct (Parameter a))) -> CodeGenFunction r ()
store = (Parameter a -> a)
-> Parameter a -> Value (Ptr (Struct a)) -> CodeGenFunction r ()
forall a llvmValue r.
C a =>
(llvmValue -> a)
-> llvmValue -> Value (Ptr (Struct a)) -> CodeGenFunction r ()
Memory.storeNewtype (\(Parameter a
k) -> a
k)
   decompose :: forall r.
Value (Struct (Parameter a)) -> CodeGenFunction r (Parameter a)
decompose = (a -> Parameter a)
-> Value (Struct a) -> CodeGenFunction r (Parameter a)
forall a llvmValue r.
C a =>
(a -> llvmValue) -> Value (Struct a) -> CodeGenFunction r llvmValue
Memory.decomposeNewtype a -> Parameter a
forall a. a -> Parameter a
Parameter
   compose :: forall r.
Parameter a -> CodeGenFunction r (Value (Struct (Parameter a)))
compose = (Parameter a -> a)
-> Parameter a -> CodeGenFunction r (Value (Struct a))
forall a llvmValue r.
C a =>
(llvmValue -> a)
-> llvmValue -> CodeGenFunction r (Value (Struct a))
Memory.composeNewtype (\(Parameter a
k) -> a
k)


instance
   (Expr.Aggregate e mv) =>
      Expr.Aggregate (Parameter e) (Parameter mv) where
   type MultiValuesOf (Parameter e) = Parameter (Expr.MultiValuesOf e)
   type ExpressionsOf (Parameter mv) = Parameter (Expr.ExpressionsOf mv)
   bundle :: forall r. Parameter e -> CodeGenFunction r (Parameter mv)
bundle (Parameter e
p) = (mv -> Parameter mv)
-> CodeGenFunction r mv -> CodeGenFunction r (Parameter mv)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap mv -> Parameter mv
forall a. a -> Parameter a
Parameter (CodeGenFunction r mv -> CodeGenFunction r (Parameter mv))
-> CodeGenFunction r mv -> CodeGenFunction r (Parameter mv)
forall a b. (a -> b) -> a -> b
$ e -> CodeGenFunction r mv
forall r. e -> CodeGenFunction r mv
forall exp mv r. Aggregate exp mv => exp -> CodeGenFunction r mv
Expr.bundle e
p
   dissect :: Parameter mv -> Parameter e
dissect (Parameter mv
p) = e -> Parameter e
forall a. a -> Parameter a
Parameter (e -> Parameter e) -> e -> Parameter e
forall a b. (a -> b) -> a -> b
$ mv -> e
forall exp mv. Aggregate exp mv => mv -> exp
Expr.dissect mv
p


instance (Expr.Aggregate e mv) => Expr.Aggregate (Result e) (Result mv) where
   type MultiValuesOf (Result e) = Result (Expr.MultiValuesOf e)
   type ExpressionsOf (Result mv) = Result (Expr.ExpressionsOf mv)
   bundle :: forall r. Result e -> CodeGenFunction r (Result mv)
bundle (Result e
f e
k) = (mv -> mv -> Result mv)
-> CodeGenFunction r mv
-> CodeGenFunction r mv
-> CodeGenFunction r (Result mv)
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 mv -> mv -> Result mv
forall a. a -> a -> Result a
Result (e -> CodeGenFunction r mv
forall r. e -> CodeGenFunction r mv
forall exp mv r. Aggregate exp mv => exp -> CodeGenFunction r mv
Expr.bundle e
f) (e -> CodeGenFunction r mv
forall r. e -> CodeGenFunction r mv
forall exp mv r. Aggregate exp mv => exp -> CodeGenFunction r mv
Expr.bundle e
k)
   dissect :: Result mv -> Result e
dissect (Result mv
f mv
k) = e -> e -> Result e
forall a. a -> a -> Result a
Result (mv -> e
forall exp mv. Aggregate exp mv => mv -> exp
Expr.dissect mv
f) (mv -> e
forall exp mv. Aggregate exp mv => mv -> exp
Expr.dissect mv
k)

causal ::
   (Expr.Aggregate ae a, Module.C ae ve,
    Expr.Aggregate ve v, Memory.C v) =>
   Causal.T (Parameter a, v) (Result v)
causal :: forall ae a ve v.
(Aggregate ae a, C ae ve, Aggregate ve v, C v) =>
T (Parameter a, v) (Result v)
causal = Simple ve (Parameter ae) ve (Result ve)
-> T (Parameter a, v) (Result v)
forall ae al be bl ce cl se sl.
(Aggregate ae al, Aggregate be bl, Aggregate ce cl,
 Aggregate se sl, C sl) =>
Simple se ce ae be -> T (cl, al) bl
Causal.fromModifier Simple ve (Parameter ae) ve (Result ve)
forall a v. C a v => Simple v (Parameter a) v (Result v)
FirstOrder.modifier

lowpassCausal, highpassCausal ::
   (Expr.Aggregate ae a, Module.C ae ve,
    Expr.Aggregate ve v, Memory.C v) =>
   Causal.T (Parameter a, v) v
lowpassCausal :: forall ae a ve v.
(Aggregate ae a, C ae ve, Aggregate ve v, C v) =>
T (Parameter a, v) v
lowpassCausal  = Simple ve (Parameter ae) ve ve -> T (Parameter a, v) v
forall ae al be bl ce cl se sl.
(Aggregate ae al, Aggregate be bl, Aggregate ce cl,
 Aggregate se sl, C sl) =>
Simple se ce ae be -> T (cl, al) bl
Causal.fromModifier Simple ve (Parameter ae) ve ve
forall a v. (C a, C a v) => Simple v (Parameter a) v v
FirstOrder.lowpassModifier
highpassCausal :: forall ae a ve v.
(Aggregate ae a, C ae ve, Aggregate ve v, C v) =>
T (Parameter a, v) v
highpassCausal = Simple ve (Parameter ae) ve ve -> T (Parameter a, v) v
forall ae al be bl ce cl se sl.
(Aggregate ae al, Aggregate be bl, Aggregate ce cl,
 Aggregate se sl, C sl) =>
Simple se ce ae be -> T (cl, al) bl
Causal.fromModifier Simple ve (Parameter ae) ve ve
forall a v. (C a, C a v) => Simple v (Parameter a) v v
FirstOrder.highpassModifier


causalInit ::
   (Expr.Aggregate ae a, Memory.C a, Module.C ae ve,
    Expr.Aggregate ve v, Memory.C v) =>
   ve -> Causal.T (Parameter a, v) (Result v)
causalInit :: forall ae a ve v.
(Aggregate ae a, C a, C ae ve, Aggregate ve v, C v) =>
ve -> T (Parameter a, v) (Result v)
causalInit =
   Simple ve (Parameter ae) ve (Result ve)
-> T (Parameter a, v) (Result v)
forall ae al be bl ce cl se sl.
(Aggregate ae al, Aggregate be bl, Aggregate ce cl,
 Aggregate se sl, C sl) =>
Simple se ce ae be -> T (cl, al) bl
Causal.fromModifier (Simple ve (Parameter ae) ve (Result ve)
 -> T (Parameter a, v) (Result v))
-> (ve -> Simple ve (Parameter ae) ve (Result ve))
-> ve
-> T (Parameter a, v) (Result v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Initialized ve ve (Parameter ae) ve (Result ve)
-> ve -> Simple ve (Parameter ae) ve (Result ve)
forall s init ctrl a b.
Initialized s init ctrl a b -> init -> Simple s ctrl a b
Modifier.initialize Initialized ve ve (Parameter ae) ve (Result ve)
forall a v. C a v => Initialized v v (Parameter a) v (Result v)
FirstOrder.modifierInit

lowpassCausalInit, highpassCausalInit ::
   (Expr.Aggregate ae a, Memory.C a, Module.C ae ve,
    Expr.Aggregate ve v, Memory.C v) =>
   ve -> Causal.T (Parameter a, v) v
lowpassCausalInit :: forall ae a ve v.
(Aggregate ae a, C a, C ae ve, Aggregate ve v, C v) =>
ve -> T (Parameter a, v) v
lowpassCausalInit =
   Simple ve (Parameter ae) ve ve -> T (Parameter a, v) v
forall ae al be bl ce cl se sl.
(Aggregate ae al, Aggregate be bl, Aggregate ce cl,
 Aggregate se sl, C sl) =>
Simple se ce ae be -> T (cl, al) bl
Causal.fromModifier (Simple ve (Parameter ae) ve ve -> T (Parameter a, v) v)
-> (ve -> Simple ve (Parameter ae) ve ve)
-> ve
-> T (Parameter a, v) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Initialized ve ve (Parameter ae) ve ve
-> ve -> Simple ve (Parameter ae) ve ve
forall s init ctrl a b.
Initialized s init ctrl a b -> init -> Simple s ctrl a b
Modifier.initialize Initialized ve ve (Parameter ae) ve ve
forall a v. (C a, C a v) => Initialized v v (Parameter a) v v
FirstOrder.lowpassModifierInit
highpassCausalInit :: forall ae a ve v.
(Aggregate ae a, C a, C ae ve, Aggregate ve v, C v) =>
ve -> T (Parameter a, v) v
highpassCausalInit =
   Simple ve (Parameter ae) ve ve -> T (Parameter a, v) v
forall ae al be bl ce cl se sl.
(Aggregate ae al, Aggregate be bl, Aggregate ce cl,
 Aggregate se sl, C sl) =>
Simple se ce ae be -> T (cl, al) bl
Causal.fromModifier (Simple ve (Parameter ae) ve ve -> T (Parameter a, v) v)
-> (ve -> Simple ve (Parameter ae) ve ve)
-> ve
-> T (Parameter a, v) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Initialized ve ve (Parameter ae) ve ve
-> ve -> Simple ve (Parameter ae) ve ve
forall s init ctrl a b.
Initialized s init ctrl a b -> init -> Simple s ctrl a b
Modifier.initialize Initialized ve ve (Parameter ae) ve ve
forall a v. (C a, C a v) => Initialized v v (Parameter a) v v
FirstOrder.highpassModifierInit


lowpassCausalPacked, highpassCausalPacked, causalRecursivePacked,
      preampPacked ::
   (SerialCode.Write v, SerialCode.Element v ~ a,
    A.PseudoRing v, A.IntegerConstant v,
    A.PseudoRing a, A.IntegerConstant a, Memory.C a) =>
   Causal.T (Parameter a, v) v
highpassCausalPacked :: forall v a.
(Write v, Element v ~ a, PseudoRing v, IntegerConstant v,
 PseudoRing a, IntegerConstant a, C a) =>
T (Parameter a, v) v
highpassCausalPacked =
   (forall r. v -> v -> CodeGenFunction r v) -> T (v, v) v
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
CausalPriv.zipWith v -> v -> CodeGenFunction r v
forall r. v -> v -> CodeGenFunction r v
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.sub T (v, v) v -> T (Parameter a, v) (v, v) -> T (Parameter a, v) v
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< ((Parameter a, v) -> v) -> T (Parameter a, v) v
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Parameter a, v) -> v
forall a b. (a, b) -> b
snd T (Parameter a, v) v
-> T (Parameter a, v) v -> T (Parameter a, v) (v, v)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& T (Parameter a, v) v
forall v a.
(Write v, Element v ~ a, PseudoRing v, IntegerConstant v,
 PseudoRing a, IntegerConstant a, C a) =>
T (Parameter a, v) v
lowpassCausalPacked
lowpassCausalPacked :: forall v a.
(Write v, Element v ~ a, PseudoRing v, IntegerConstant v,
 PseudoRing a, IntegerConstant a, C a) =>
T (Parameter a, v) v
lowpassCausalPacked =
   T (Parameter a, v) v
forall v a.
(Write v, Element v ~ a, PseudoRing v, IntegerConstant v,
 PseudoRing a, IntegerConstant a, C a) =>
T (Parameter a, v) v
causalRecursivePacked T (Parameter a, v) v
-> T (Parameter a, v) (Parameter a, v) -> T (Parameter a, v) v
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< ((Parameter a, v) -> Parameter a)
-> T (Parameter a, v) (Parameter a)
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Parameter a, v) -> Parameter a
forall a b. (a, b) -> a
fst T (Parameter a, v) (Parameter a)
-> T (Parameter a, v) v -> T (Parameter a, v) (Parameter a, v)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& T (Parameter a, v) v
forall v a.
(Write v, Element v ~ a, PseudoRing v, IntegerConstant v,
 PseudoRing a, IntegerConstant a, C a) =>
T (Parameter a, v) v
preampPacked

causalRecursivePacked :: forall v a.
(Write v, Element v ~ a, PseudoRing v, IntegerConstant v,
 PseudoRing a, IntegerConstant a, C a) =>
T (Parameter a, v) v
causalRecursivePacked =
   (forall r. (Parameter a, v) -> a -> CodeGenFunction r (v, a))
-> (forall r. CodeGenFunction r a) -> T (Parameter a, v) v
forall state a b.
C state =>
(forall r. a -> state -> CodeGenFunction r (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
CausalPriv.mapAccum (Parameter a, v) -> a -> CodeGenFunction r (v, a)
forall r. (Parameter a, v) -> a -> CodeGenFunction r (v, a)
forall v a r.
(Write v, Element v ~ a, PseudoRing v, IntegerConstant v,
 PseudoRing a) =>
(Parameter a, v) -> a -> CodeGenFunction r (v, a)
causalRecursivePackedStep (a -> CodeGenFunction r a
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Additive a => a
A.zero)

preampPacked :: forall v a.
(Write v, Element v ~ a, PseudoRing v, IntegerConstant v,
 PseudoRing a, IntegerConstant a, C a) =>
T (Parameter a, v) v
preampPacked =
   (forall r. (Parameter a, v) -> CodeGenFunction r v)
-> T (Parameter a, v) v
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
CausalPriv.map
      (\(Parameter a
k, v
x) -> v -> v -> CodeGenFunction r v
forall r. v -> v -> CodeGenFunction r v
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
A.mul v
x (v -> CodeGenFunction r v)
-> CodeGenFunction r v -> CodeGenFunction r v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> CodeGenFunction r v
Element v -> CodeGenFunction r v
forall v r. Write v => Element v -> CodeGenFunction r v
SerialCode.upsample (a -> CodeGenFunction r v)
-> CodeGenFunction r a -> CodeGenFunction r v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.sub a
forall a. IntegerConstant a => a
A.one a
k)



{-
x = [x0, x1, x2, x3]

filter k y1 x
  = [x0 + k*y1,
     x1 + k*x0 + k^2*y1,
     x2 + k*x1 + k^2*x0 + k^3*y1,
     x3 + k*x2 + k^2*x1 + k^3*x0 + k^4*y1,
     ... ]

f0x = insert 0 (k*y1) x
f1x = f0x + k * f0x->1
f2x = f1x + k^2 * f1x->2
-}
causalRecursivePackedStep ::
   (SerialCode.Write v, SerialCode.Element v ~ a,
    A.PseudoRing v, A.IntegerConstant v, A.PseudoRing a) =>
   (Parameter a, v) -> a -> LLVM.CodeGenFunction r (v,a)
causalRecursivePackedStep :: forall v a r.
(Write v, Element v ~ a, PseudoRing v, IntegerConstant v,
 PseudoRing a) =>
(Parameter a, v) -> a -> CodeGenFunction r (v, a)
causalRecursivePackedStep (Parameter a
k, v
xk0) a
y1 = do
   a
y1k <- a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
A.mul a
k a
y1
   v
xk1 <- Value Word32
-> (a -> CodeGenFunction r a) -> v -> CodeGenFunction r v
forall v a r.
(Write v, Element v ~ a) =>
Value Word32
-> (a -> CodeGenFunction r a) -> v -> CodeGenFunction r v
SerialCode.modify Value Word32
forall a. Additive a => a
A.zero (a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.add a
y1k) v
xk0
   v
kv <- Element v -> CodeGenFunction r v
forall v r. Write v => Element v -> CodeGenFunction r v
SerialCode.upsample a
Element v
k
   v
xk2 <-
      ((v, v) -> v) -> CodeGenFunction r (v, v) -> CodeGenFunction r v
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v, v) -> v
forall a b. (a, b) -> a
fst (CodeGenFunction r (v, v) -> CodeGenFunction r v)
-> CodeGenFunction r (v, v) -> CodeGenFunction r v
forall a b. (a -> b) -> a -> b
$
      ((v, v) -> Int -> CodeGenFunction r (v, v))
-> (v, v) -> [Int] -> CodeGenFunction r (v, v)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
         (\(v
y,v
k0) Int
d ->
            (v -> v -> (v, v))
-> CodeGenFunction r v
-> CodeGenFunction r v
-> CodeGenFunction r (v, v)
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 (,)
               (v -> v -> CodeGenFunction r v
forall r. v -> v -> CodeGenFunction r v
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.add v
y (v -> CodeGenFunction r v)
-> CodeGenFunction r v -> CodeGenFunction r v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> v -> CodeGenFunction r v
forall v r.
(Write v, Additive (Element v)) =>
Int -> v -> CodeGenFunction r v
SerialCode.shiftUpMultiZero Int
d (v -> CodeGenFunction r v)
-> CodeGenFunction r v -> CodeGenFunction r v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< v -> v -> CodeGenFunction r v
forall r. v -> v -> CodeGenFunction r v
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
A.mul v
y v
k0)
               (v -> v -> CodeGenFunction r v
forall r. v -> v -> CodeGenFunction r v
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
A.mul v
k0 v
k0))
         (v
xk1,v
kv)
         ((Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< v -> Int
forall v i. (Sized v, Integral i) => v -> i
SerialCode.size v
xk0) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int
2Int -> Int -> Int
forall a. C a => a -> a -> a
*) Int
1)
   a
y0 <- v -> CodeGenFunction r (Element v)
forall v r. Read v => v -> CodeGenFunction r (Element v)
SerialCode.last v
xk2
   (v, a) -> CodeGenFunction r (v, a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (v
xk2, a
y0)

{-
We can also optimize filtering with time-varying filter parameter.

k = [k0, k1, k2, k3]
x = [x0, x1, x2, x3]

filter k y1 x
  = [x0 + k0*y1,
     x1 + k1*x0 + k1*k0*y1,
     x2 + k2*x1 + k2*k1*x0 + k2*k1*k0*y1,
     x3 + k3*x2 + k3*k2*x1 + k3*k2*k1*x0 + k3*k2*k1*k0*y1,
     ... ]

f0x = insert 0 (k0*y1) x
f1x = f0x + k  * f0x->1      k'  = k * k->1
f2x = f1x + k' * f1x->2


We can even interpret vectorised first order filtering
as first order filtering with matrix coefficients.

[x0 + k0*y1,
 x1 + k1*x0 + k1*k0*y1,
 x2 + k2*x1 + k2*k1*x0 + k2*k1*k0*y1,
 x3 + k3*x2 + k3*k2*x1 + k3*k2*k1*x0 + k3*k2*k1*k0*y1]
  =
  / 1                   \   /x0\    / k0          0 0 0 \   /y1\
  | k1       1          | . |x1| +  | k1*k0       0 0 0 | . |y2|
  | k2*k1    k2    1    |   |x2|    | k2*k1*k0    0 0 0 |   |y3|
  \ k3*k2*k1 k3*k2 k3 1 /   \x3/    \ k3*k2*k1*k0 0 0 0 /   \y4/


  / 1                   \   / 1                 \   / 1          \
  | k1       1          | = |         1         | . | k1  1      |
  | k2*k1    k2    1    |   | k2*k1        1    |   |    k2  1   |
  \ k3*k2*k1 k3*k2 k3 1 /   \       k3*k2     1 /   \       k3 1 /
-}


addHighpass ::
   (A.Additive v) =>
   Causal.T (param,v) v -> Causal.T (param,v) (Result v)
addHighpass :: forall v param.
Additive v =>
T (param, v) v -> T (param, v) (Result v)
addHighpass T (param, v) v
lowpass =
   (forall r. (v, v) -> CodeGenFunction r (Result v))
-> T (v, v) (Result v)
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
CausalPriv.map
      (\(v
l,v
x) -> do
         v
h <- v -> v -> CodeGenFunction r v
forall r. v -> v -> CodeGenFunction r v
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.sub v
x v
l
         Result v -> CodeGenFunction r (Result v)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result{lowpass_ :: v
lowpass_ = v
l, highpass_ :: v
highpass_ = v
h}))
   T (v, v) (Result v)
-> T (param, v) (v, v) -> T (param, v) (Result v)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<
   T (param, v) v
lowpass T (param, v) v -> T (param, v) v -> T (param, v) (v, v)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((param, v) -> v) -> T (param, v) v
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (param, v) -> v
forall a b. (a, b) -> b
snd

causalPacked ::
   (SerialCode.Write v, SerialCode.Element v ~ a,
    A.PseudoRing v, A.IntegerConstant v,
    A.PseudoRing a, A.IntegerConstant a, Memory.C a) =>
   Causal.T (Parameter a, v) (Result v)
causalPacked :: forall v a.
(Write v, Element v ~ a, PseudoRing v, IntegerConstant v,
 PseudoRing a, IntegerConstant a, C a) =>
T (Parameter a, v) (Result v)
causalPacked = T (Parameter a, v) v -> T (Parameter a, v) (Result v)
forall v param.
Additive v =>
T (param, v) v -> T (param, v) (Result v)
addHighpass T (Parameter a, v) v
forall v a.
(Write v, Element v ~ a, PseudoRing v, IntegerConstant v,
 PseudoRing a, IntegerConstant a, C a) =>
T (Parameter a, v) v
lowpassCausalPacked


lowpassCausalInitPacked, highpassCausalInitPacked,
      causalRecursiveInitPacked ::
   (A.PseudoRing v, A.IntegerConstant v,
    SerialCode.Write v, SerialCode.Element v ~ a,
    Expr.Aggregate ae a, A.PseudoRing a, A.IntegerConstant a, Memory.C a) =>
   ae -> Causal.T (Parameter a, v) v
causalRecursiveInitPacked :: forall v a ae.
(PseudoRing v, IntegerConstant v, Write v, Element v ~ a,
 Aggregate ae a, PseudoRing a, IntegerConstant a, C a) =>
ae -> T (Parameter a, v) v
causalRecursiveInitPacked ae
a =
   (forall r. (Parameter a, v) -> a -> CodeGenFunction r (v, a))
-> (forall r. CodeGenFunction r a) -> T (Parameter a, v) v
forall state a b.
C state =>
(forall r. a -> state -> CodeGenFunction r (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
CausalPriv.mapAccum (Parameter a, v) -> a -> CodeGenFunction r (v, a)
forall r. (Parameter a, v) -> a -> CodeGenFunction r (v, a)
forall v a r.
(Write v, Element v ~ a, PseudoRing v, IntegerConstant v,
 PseudoRing a) =>
(Parameter a, v) -> a -> CodeGenFunction r (v, a)
causalRecursivePackedStep (ae -> CodeGenFunction r a
forall r. ae -> CodeGenFunction r a
forall exp mv r. Aggregate exp mv => exp -> CodeGenFunction r mv
Expr.bundle ae
a)

highpassCausalInitPacked :: forall v a ae.
(PseudoRing v, IntegerConstant v, Write v, Element v ~ a,
 Aggregate ae a, PseudoRing a, IntegerConstant a, C a) =>
ae -> T (Parameter a, v) v
highpassCausalInitPacked ae
a = ((Parameter a, v) -> v) -> T (Parameter a, v) v
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Parameter a, v) -> v
forall a b. (a, b) -> b
snd T (Parameter a, v) v
-> T (Parameter a, v) v -> T (Parameter a, v) v
forall a. C a => a -> a -> a
- ae -> T (Parameter a, v) v
forall v a ae.
(PseudoRing v, IntegerConstant v, Write v, Element v ~ a,
 Aggregate ae a, PseudoRing a, IntegerConstant a, C a) =>
ae -> T (Parameter a, v) v
lowpassCausalInitPacked ae
a
lowpassCausalInitPacked :: forall v a ae.
(PseudoRing v, IntegerConstant v, Write v, Element v ~ a,
 Aggregate ae a, PseudoRing a, IntegerConstant a, C a) =>
ae -> T (Parameter a, v) v
lowpassCausalInitPacked ae
a =
   ae -> T (Parameter a, v) v
forall v a ae.
(PseudoRing v, IntegerConstant v, Write v, Element v ~ a,
 Aggregate ae a, PseudoRing a, IntegerConstant a, C a) =>
ae -> T (Parameter a, v) v
causalRecursiveInitPacked ae
a T (Parameter a, v) v
-> T (Parameter a, v) (Parameter a, v) -> T (Parameter a, v) v
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< ((Parameter a, v) -> Parameter a)
-> T (Parameter a, v) (Parameter a)
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Parameter a, v) -> Parameter a
forall a b. (a, b) -> a
fst T (Parameter a, v) (Parameter a)
-> T (Parameter a, v) v -> T (Parameter a, v) (Parameter a, v)
forall b c c'. T b c -> T b c' -> T b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& T (Parameter a, v) v
forall v a.
(Write v, Element v ~ a, PseudoRing v, IntegerConstant v,
 PseudoRing a, IntegerConstant a, C a) =>
T (Parameter a, v) v
preampPacked

causalInitPacked ::
   (A.PseudoRing v, A.IntegerConstant v,
    SerialCode.Write v, SerialCode.Element v ~ a,
    Expr.Aggregate ae a, A.PseudoRing a, A.IntegerConstant a, Memory.C a) =>
   ae -> Causal.T (Parameter a, v) (Result v)
causalInitPacked :: forall v a ae.
(PseudoRing v, IntegerConstant v, Write v, Element v ~ a,
 Aggregate ae a, PseudoRing a, IntegerConstant a, C a) =>
ae -> T (Parameter a, v) (Result v)
causalInitPacked ae
a = T (Parameter a, v) v -> T (Parameter a, v) (Result v)
forall v param.
Additive v =>
T (param, v) v -> T (param, v) (Result v)
addHighpass (ae -> T (Parameter a, v) v
forall v a ae.
(PseudoRing v, IntegerConstant v, Write v, Element v ~ a,
 Aggregate ae a, PseudoRing a, IntegerConstant a, C a) =>
ae -> T (Parameter a, v) v
lowpassCausalInitPacked ae
a)