{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
module Synthesizer.LLVM.Filter.SecondOrderPacked (
   Parameter, ParameterExp, bandpassParameter, State, causal,
   ) where

import qualified Synthesizer.LLVM.Filter.SecondOrder as Filt2L
import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2

import qualified Synthesizer.LLVM.Causal.Private as Causal

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

import qualified LLVM.Extra.Multi.Value.Marshal as Marshal
import qualified LLVM.Extra.Multi.Value as MultiValue
import qualified LLVM.Extra.Multi.Vector as MultiVector
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 Type.Data.Num.Decimal (D4, d0, d1)

import Control.Applicative (liftA2)

import NumericPrelude.Numeric
import NumericPrelude.Base


{- |
Layout:

> c0 [c1 d1 c2 d2]
-}
data Parameter a = Parameter (MultiValue.T a) (MultiVector.T D4 a)

instance (MultiVector.C a) => Tuple.Phi (Parameter a) where
   phi :: forall r.
BasicBlock -> Parameter a -> CodeGenFunction r (Parameter a)
phi BasicBlock
bb (Parameter T a
r T D4 a
i) = do
      T a
r' <- BasicBlock -> T a -> CodeGenFunction r (T a)
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
forall r. BasicBlock -> T a -> CodeGenFunction r (T a)
Tuple.phi BasicBlock
bb T a
r
      T D4 a
i' <- BasicBlock -> T D4 a -> CodeGenFunction r (T D4 a)
forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a
forall r. BasicBlock -> T D4 a -> CodeGenFunction r (T D4 a)
Tuple.phi BasicBlock
bb T D4 a
i
      Parameter a -> CodeGenFunction r (Parameter a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (T a -> T D4 a -> Parameter a
forall a. T a -> T D4 a -> Parameter a
Parameter T a
r' T D4 a
i')
   addPhi :: forall r.
BasicBlock -> Parameter a -> Parameter a -> CodeGenFunction r ()
addPhi BasicBlock
bb (Parameter T a
r T D4 a
i) (Parameter T a
r' T D4 a
i') = do
      BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
forall r. BasicBlock -> T a -> T a -> CodeGenFunction r ()
Tuple.addPhi BasicBlock
bb T a
r T a
r'
      BasicBlock -> T D4 a -> T D4 a -> CodeGenFunction r ()
forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r ()
forall r. BasicBlock -> T D4 a -> T D4 a -> CodeGenFunction r ()
Tuple.addPhi BasicBlock
bb T D4 a
i T D4 a
i'

instance (MultiVector.C a) => Tuple.Undefined (Parameter a) where
   undef :: Parameter a
undef = T a -> T D4 a -> Parameter a
forall a. T a -> T D4 a -> Parameter a
Parameter T a
forall a. Undefined a => a
Tuple.undef T D4 a
forall a. Undefined a => a
Tuple.undef


type ParameterStruct a = Memory.Struct (MultiValue.T a, MultiVector.T D4 a)

parameterMemory ::
   (Marshal.C a, Marshal.Vector D4 a) =>
   Memory.Record r (ParameterStruct a) (Parameter a)
parameterMemory :: forall a r.
(C a, Vector D4 a) =>
Record r (ParameterStruct a) (Parameter a)
parameterMemory =
   (T a -> T D4 a -> Parameter a)
-> Element
     r
     (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
     (Parameter a)
     (T a)
-> Element
     r
     (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
     (Parameter a)
     (T D4 a)
-> Element
     r
     (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
     (Parameter a)
     (Parameter a)
forall a b c.
(a -> b -> c)
-> Element
     r
     (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
     (Parameter a)
     a
-> Element
     r
     (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
     (Parameter a)
     b
-> Element
     r
     (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
     (Parameter a)
     c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 T a -> T D4 a -> Parameter a
forall a. T a -> T D4 a -> Parameter a
Parameter
      ((Parameter a -> T a)
-> Proxy D0
-> Element
     r
     (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
     (Parameter a)
     (T a)
forall x o n v r.
(C x, GetValue o n, ValueType o n ~ Struct x,
 GetElementPtr o (n, ()), ElementPtrType o (n, ()) ~ Struct x) =>
(v -> x) -> n -> Element r o v x
Memory.element (\(Parameter T a
c0 T D4 a
_) -> T a
c0) Proxy D0
d0)
      ((Parameter a -> T D4 a)
-> Proxy D1
-> Element
     r
     (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
     (Parameter a)
     (T D4 a)
forall x o n v r.
(C x, GetValue o n, ValueType o n ~ Struct x,
 GetElementPtr o (n, ()), ElementPtrType o (n, ()) ~ Struct x) =>
(v -> x) -> n -> Element r o v x
Memory.element (\(Parameter T a
_ T D4 a
cd) -> T D4 a
cd) Proxy D1
d1)

instance (Marshal.C a, Marshal.Vector D4 a) => Memory.C (Parameter a) where
   type Struct (Parameter a) = ParameterStruct a
   load :: forall r.
Value (Ptr (Struct (Parameter a)))
-> CodeGenFunction r (Parameter a)
load = Record
  r
  (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
  (Parameter a)
-> Value (Ptr (Struct (Struct (Repr a), (Struct (Repr D4 a), ()))))
-> CodeGenFunction r (Parameter a)
forall r o llvmValue.
Record r o llvmValue
-> Value (Ptr o) -> CodeGenFunction r llvmValue
Memory.loadRecord Record r (ParameterStruct a) (Parameter a)
Record
  r
  (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
  (Parameter a)
forall a r.
(C a, Vector D4 a) =>
Record r (ParameterStruct a) (Parameter a)
parameterMemory
   store :: forall r.
Parameter a
-> Value (Ptr (Struct (Parameter a))) -> CodeGenFunction r ()
store = Record
  r
  (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
  (Parameter a)
-> Parameter a
-> Value (Ptr (Struct (Struct (Repr a), (Struct (Repr D4 a), ()))))
-> CodeGenFunction r ()
forall r o llvmValue.
Record r o llvmValue
-> llvmValue -> Value (Ptr o) -> CodeGenFunction r ()
Memory.storeRecord Record r (ParameterStruct a) (Parameter a)
Record
  r
  (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
  (Parameter a)
forall a r.
(C a, Vector D4 a) =>
Record r (ParameterStruct a) (Parameter a)
parameterMemory
   decompose :: forall r.
Value (Struct (Parameter a)) -> CodeGenFunction r (Parameter a)
decompose = Record
  r
  (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
  (Parameter a)
-> Value (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
-> CodeGenFunction r (Parameter a)
forall r o llvmValue.
Record r o llvmValue -> Value o -> CodeGenFunction r llvmValue
Memory.decomposeRecord Record r (ParameterStruct a) (Parameter a)
Record
  r
  (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
  (Parameter a)
forall a r.
(C a, Vector D4 a) =>
Record r (ParameterStruct a) (Parameter a)
parameterMemory
   compose :: forall r.
Parameter a -> CodeGenFunction r (Value (Struct (Parameter a)))
compose = Record
  r
  (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
  (Parameter a)
-> Parameter a
-> CodeGenFunction
     r (Value (Struct (Struct (Repr a), (Struct (Repr D4 a), ()))))
forall o r llvmValue.
IsType o =>
Record r o llvmValue -> llvmValue -> CodeGenFunction r (Value o)
Memory.composeRecord Record r (ParameterStruct a) (Parameter a)
Record
  r
  (Struct (Struct (Repr a), (Struct (Repr D4 a), ())))
  (Parameter a)
forall a r.
(C a, Vector D4 a) =>
Record r (ParameterStruct a) (Parameter a)
parameterMemory


data ParameterExp a =
   ParameterExp (forall r. LLVM.CodeGenFunction r (Parameter a))

instance Expr.Aggregate (ParameterExp a) (Parameter a) where
   type MultiValuesOf (ParameterExp a) = Parameter a
   type ExpressionsOf (Parameter a) = ParameterExp a
   dissect :: Parameter a -> ParameterExp a
dissect Parameter a
x = (forall r. CodeGenFunction r (Parameter a)) -> ParameterExp a
forall a.
(forall r. CodeGenFunction r (Parameter a)) -> ParameterExp a
ParameterExp (Parameter a -> CodeGenFunction r (Parameter a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return Parameter a
x)
   bundle :: forall r. ParameterExp a -> CodeGenFunction r (Parameter a)
bundle (ParameterExp forall r. CodeGenFunction r (Parameter a)
code) = CodeGenFunction r (Parameter a)
forall r. CodeGenFunction r (Parameter a)
code


type State = MultiVector.T D4


{-# DEPRECATED bandpassParameter "only for testing, use Universal or Moog filter for production code" #-}
bandpassParameter ::
   (MultiVector.C a, MultiValue.Transcendental a,
    MultiValue.RationalConstant a) =>
   Exp a -> Exp a -> ParameterExp a
bandpassParameter :: forall a.
(C a, Transcendental a, RationalConstant a) =>
Exp a -> Exp a -> ParameterExp a
bandpassParameter (Exp forall r. CodeGenFunction r (T a)
reson) (Exp forall r. CodeGenFunction r (T a)
cutoff) =
   (forall r. CodeGenFunction r (Parameter a)) -> ParameterExp a
forall a.
(forall r. CodeGenFunction r (Parameter a)) -> ParameterExp a
ParameterExp (do
      T a
r <- CodeGenFunction r (T a)
forall r. CodeGenFunction r (T a)
reson
      T a
c <- CodeGenFunction r (T a)
forall r. CodeGenFunction r (T a)
cutoff
      T a -> T a -> CodeGenFunction r (Parameter a)
forall a r.
(C a, Transcendental a, RationalConstant a) =>
T a -> T a -> CodeGenFunction r (Parameter a)
bandpassParameterCode T a
r T a
c)

bandpassParameterCode ::
   (MultiVector.C a, MultiValue.Transcendental a,
    MultiValue.RationalConstant a) =>
   MultiValue.T a ->
   MultiValue.T a ->
   LLVM.CodeGenFunction r (Parameter a)
bandpassParameterCode :: forall a r.
(C a, Transcendental a, RationalConstant a) =>
T a -> T a -> CodeGenFunction r (Parameter a)
bandpassParameterCode T a
reson T a
cutoff = do
   Parameter (T a)
p <- T a -> T a -> CodeGenFunction r (Parameter (T a))
forall a r.
(Transcendental a, RationalConstant a) =>
a -> a -> CodeGenFunction r (Parameter a)
Filt2L.bandpassParameterCode T a
reson T a
cutoff
   T D4 a
v <-
      Vector D4 (T a) -> CodeGenFunction r (T D4 a)
forall n a r.
(Positive n, C a) =>
Vector n (T a) -> CodeGenFunction r (T n a)
MultiVector.assembleFromVector (Vector D4 (T a) -> CodeGenFunction r (T D4 a))
-> Vector D4 (T a) -> CodeGenFunction r (T D4 a)
forall a b. (a -> b) -> a -> b
$ ((Parameter (T a) -> T a) -> T a)
-> Vector D4 (Parameter (T a) -> T a) -> Vector D4 (T a)
forall a b. (a -> b) -> Vector D4 a -> Vector D4 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Parameter (T a) -> T a) -> Parameter (T a) -> T a
forall a b. (a -> b) -> a -> b
$ Parameter (T a)
p) (Vector D4 (Parameter (T a) -> T a) -> Vector D4 (T a))
-> Vector D4 (Parameter (T a) -> T a) -> Vector D4 (T a)
forall a b. (a -> b) -> a -> b
$
      (Parameter (T a) -> T a)
-> (Parameter (T a) -> T a)
-> (Parameter (T a) -> T a)
-> (Parameter (T a) -> T a)
-> Vector D4 (Parameter (T a) -> T a)
forall f n u.
(ConsVector f, ResultSize f ~ n, NumberOfArguments f ~ u,
 u ~ ToUnary n, FromUnary u ~ n, Natural n) =>
f
LLVM.consVector Parameter (T a) -> T a
forall a. Parameter a -> a
Filt2.c1 Parameter (T a) -> T a
forall a. Parameter a -> a
Filt2.d1 Parameter (T a) -> T a
forall a. Parameter a -> a
Filt2.c2 Parameter (T a) -> T a
forall a. Parameter a -> a
Filt2.d2
   Parameter a -> CodeGenFunction r (Parameter a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Parameter a -> CodeGenFunction r (Parameter a))
-> Parameter a -> CodeGenFunction r (Parameter a)
forall a b. (a -> b) -> a -> b
$ T a -> T D4 a -> Parameter a
forall a. T a -> T D4 a -> Parameter a
Parameter (Parameter (T a) -> T a
forall a. Parameter a -> a
Filt2.c0 Parameter (T a)
p) T D4 a
v


next ::
   (MultiVector.PseudoRing a) =>
   (Parameter a, MultiValue.T a) ->
   State a ->
   LLVM.CodeGenFunction r (MultiValue.T a, State a)
next :: forall a r.
PseudoRing a =>
(Parameter a, T a) -> State a -> CodeGenFunction r (T a, State a)
next (Parameter T a
c0 T D4 a
k1, T a
x0) T D4 a
y1 = do
   T a
s0 <- T a -> T a -> CodeGenFunction r (T a)
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
forall r. T a -> T a -> CodeGenFunction r (T a)
A.mul T a
c0 T a
x0
   T a
s1 <- T D4 a -> T D4 a -> CodeGenFunction r (T a)
forall n a r.
(Positive n, PseudoRing a) =>
T n a -> T n a -> CodeGenFunction r (T a)
MultiVector.dotProduct T D4 a
k1 T D4 a
y1
   T a
y0 <- T a -> T a -> CodeGenFunction r (T a)
forall a r. Additive a => a -> a -> CodeGenFunction r a
forall r. T a -> T a -> CodeGenFunction r (T a)
A.add T a
s0 T a
s1
   T a
x1new <- Value Word32 -> T D4 a -> CodeGenFunction r (T a)
forall a n r.
(C a, Positive n) =>
Value Word32 -> T n a -> CodeGenFunction r (T a)
forall n r.
Positive n =>
Value Word32 -> T n a -> CodeGenFunction r (T a)
MultiVector.extract (Word32 -> Value Word32
forall a. IsConst a => a -> Value a
LLVM.valueOf Word32
0) T D4 a
y1
   T a
y1new <- Value Word32 -> T D4 a -> CodeGenFunction r (T a)
forall a n r.
(C a, Positive n) =>
Value Word32 -> T n a -> CodeGenFunction r (T a)
forall n r.
Positive n =>
Value Word32 -> T n a -> CodeGenFunction r (T a)
MultiVector.extract (Word32 -> Value Word32
forall a. IsConst a => a -> Value a
LLVM.valueOf Word32
1) T D4 a
y1
   T D4 a
yv <- Vector D4 (T a) -> CodeGenFunction r (T D4 a)
forall n a r.
(Positive n, C a) =>
Vector n (T a) -> CodeGenFunction r (T n a)
MultiVector.assembleFromVector (Vector D4 (T a) -> CodeGenFunction r (T D4 a))
-> Vector D4 (T a) -> CodeGenFunction r (T D4 a)
forall a b. (a -> b) -> a -> b
$ T a -> T a -> T a -> T a -> Vector D4 (T a)
forall f n u.
(ConsVector f, ResultSize f ~ n, NumberOfArguments f ~ u,
 u ~ ToUnary n, FromUnary u ~ n, Natural n) =>
f
LLVM.consVector T a
x0 T a
y0 T a
x1new T a
y1new
   (T a, T D4 a) -> CodeGenFunction r (T a, T D4 a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (T a
y0, T D4 a
yv)

causal ::
   (MultiVector.PseudoRing a) =>
   (Marshal.Vector D4 a) =>
   Causal.T (Parameter a, MultiValue.T a) (MultiValue.T a)
causal :: forall a. (PseudoRing a, Vector D4 a) => T (Parameter a, T a) (T a)
causal = (forall r.
 (Parameter a, T a) -> State a -> CodeGenFunction r (T a, State a))
-> (forall r. CodeGenFunction r (State a))
-> T (Parameter a, T a) (T a)
forall state a b.
C state =>
(forall r. a -> state -> CodeGenFunction r (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
Causal.mapAccum (Parameter a, T a) -> State a -> CodeGenFunction r (T a, State a)
forall r.
(Parameter a, T a) -> State a -> CodeGenFunction r (T a, State a)
forall a r.
PseudoRing a =>
(Parameter a, T a) -> State a -> CodeGenFunction r (T a, State a)
next (State a -> CodeGenFunction r (State a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return State a
forall a. Additive a => a
A.zero)