{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE Rank2Types #-}
module Synthesizer.LLVM.Filter.ComplexFirstOrderPacked (
   Parameter(Parameter), parameterPlain, parameter, causal,
   ParameterMV,
   ) where

import qualified Synthesizer.LLVM.Filter.ComplexFirstOrder as ComplexFilter

import qualified Synthesizer.LLVM.Causal.Private as Causal

import qualified Synthesizer.LLVM.Frame.Stereo as Stereo

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.Arithmetic as A
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Tuple as Tuple

import qualified LLVM.Core as LLVM

import Type.Data.Num.Decimal (D3, d0, d1)

import Control.Applicative (liftA2)

import qualified Algebra.Transcendental as Trans

import qualified Number.Complex as Complex

import NumericPrelude.Numeric
import NumericPrelude.Base


data Parameter a = Parameter (LLVM.Vector D3 a) (LLVM.Vector D3 a)

data ParameterMV a = ParameterMV (MultiVector.T D3 a) (MultiVector.T D3 a)

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

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


type ParameterStruct a = Marshal.Struct (LLVM.Vector D3 a, LLVM.Vector D3 a)

parameterMemory ::
   (Marshal.Vector D3 a) =>
   Memory.Record r (ParameterStruct a) (ParameterMV a)
parameterMemory :: forall a r.
Vector D3 a =>
Record r (ParameterStruct a) (ParameterMV a)
parameterMemory =
   (T D3 a -> T D3 a -> ParameterMV a)
-> Element
     r
     (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ())))
     (ParameterMV a)
     (T D3 a)
-> Element
     r
     (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ())))
     (ParameterMV a)
     (T D3 a)
-> Element
     r
     (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ())))
     (ParameterMV a)
     (ParameterMV a)
forall a b c.
(a -> b -> c)
-> Element
     r
     (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ())))
     (ParameterMV a)
     a
-> Element
     r
     (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ())))
     (ParameterMV a)
     b
-> Element
     r
     (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ())))
     (ParameterMV a)
     c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 T D3 a -> T D3 a -> ParameterMV a
forall a. T D3 a -> T D3 a -> ParameterMV a
ParameterMV
      ((ParameterMV a -> T D3 a)
-> Proxy D0
-> Element
     r
     (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ())))
     (ParameterMV a)
     (T D3 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 (\(ParameterMV T D3 a
kr T D3 a
_) -> T D3 a
kr) Proxy D0
d0)
      ((ParameterMV a -> T D3 a)
-> Proxy D1
-> Element
     r
     (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ())))
     (ParameterMV a)
     (T D3 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 (\(ParameterMV T D3 a
_ T D3 a
ki) -> T D3 a
ki) Proxy D1
d1)

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


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

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


parameterPlain :: (Trans.C a) => a -> a -> Parameter a
parameterPlain :: forall a. C a => a -> a -> Parameter a
parameterPlain a
reson a
freq =
   let (ComplexFilter.Parameter a
amp T a
k) = a -> a -> Parameter a
forall a. C a => a -> a -> Parameter a
ComplexFilter.parameter a
reson a
freq
       kr :: a
kr = T a -> a
forall a. T a -> a
Complex.real T a
k
       ki :: a
ki = T a -> a
forall a. T a -> a
Complex.imag T a
k
   in Vector D3 a -> Vector D3 a -> Parameter a
forall a. Vector D3 a -> Vector D3 a -> Parameter a
Parameter
         (a -> a -> a -> Vector D3 a
forall f n u.
(ConsVector f, ResultSize f ~ n, NumberOfArguments f ~ u,
 u ~ ToUnary n, FromUnary u ~ n, Natural n) =>
f
LLVM.consVector a
kr (-a
ki) a
amp)
         (a -> a -> a -> Vector D3 a
forall f n u.
(ConsVector f, ResultSize f ~ n, NumberOfArguments f ~ u,
 u ~ ToUnary n, FromUnary u ~ n, Natural n) =>
f
LLVM.consVector a
ki   a
kr  a
amp)

parameter ::
   (MultiVector.Transcendental a, MultiVector.RationalConstant a) =>
   Exp a -> Exp a -> ParameterExp a
parameter :: forall a.
(Transcendental a, RationalConstant a) =>
Exp a -> Exp a -> ParameterExp a
parameter (Exp forall r. CodeGenFunction r (T a)
reson) (Exp forall r. CodeGenFunction r (T a)
freq) =
   (forall r. CodeGenFunction r (ParameterMV a)) -> ParameterExp a
forall a.
(forall r. CodeGenFunction r (ParameterMV a)) -> ParameterExp a
ParameterExp (do
      T a
r <- CodeGenFunction r (T a)
forall r. CodeGenFunction r (T a)
reson
      T a
f <- CodeGenFunction r (T a)
forall r. CodeGenFunction r (T a)
freq
      ~(ComplexFilter.Parameter T a
amp T (T a)
k) <- T a -> T a -> CodeGenFunction r (Parameter (T a))
forall a r.
(Transcendental a, RationalConstant a) =>
a -> a -> CodeGenFunction r (Parameter a)
ComplexFilter.parameterCode T a
r T a
f
      let kr :: T a
kr = T (T a) -> T a
forall a. T a -> a
Complex.real T (T a)
k
      let ki :: T a
ki = T (T a) -> T a
forall a. T a -> a
Complex.imag T (T a)
k
      T a
kin <- T a -> CodeGenFunction r (T a)
forall a r. Additive a => a -> CodeGenFunction r a
forall r. T a -> CodeGenFunction r (T a)
A.neg T a
ki
      (T D3 a -> T D3 a -> ParameterMV a)
-> CodeGenFunction r (T D3 a)
-> CodeGenFunction r (T D3 a)
-> CodeGenFunction r (ParameterMV a)
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 T D3 a -> T D3 a -> ParameterMV a
forall a. T D3 a -> T D3 a -> ParameterMV a
ParameterMV
         (Vector D3 (T a) -> CodeGenFunction r (T D3 a)
forall n a r.
(Positive n, C a) =>
Vector n (T a) -> CodeGenFunction r (T n a)
MultiVector.assembleFromVector (Vector D3 (T a) -> CodeGenFunction r (T D3 a))
-> Vector D3 (T a) -> CodeGenFunction r (T D3 a)
forall a b. (a -> b) -> a -> b
$ T a -> T a -> T a -> Vector D3 (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
kr T a
kin T a
amp)
         (Vector D3 (T a) -> CodeGenFunction r (T D3 a)
forall n a r.
(Positive n, C a) =>
Vector n (T a) -> CodeGenFunction r (T n a)
MultiVector.assembleFromVector (Vector D3 (T a) -> CodeGenFunction r (T D3 a))
-> Vector D3 (T a) -> CodeGenFunction r (T D3 a)
forall a b. (a -> b) -> a -> b
$ T a -> T a -> T a -> Vector D3 (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
ki T a
kr  T a
amp))


type State a = MultiVector.T D3 a

next ::
   (MultiVector.PseudoRing a) =>
   (ParameterMV a, Stereo.T (MultiValue.T a)) ->
   State a -> LLVM.CodeGenFunction r (Stereo.T (MultiValue.T a), State a)
next :: forall a r.
PseudoRing a =>
(ParameterMV a, T (T a))
-> State a -> CodeGenFunction r (T (T a), State a)
next (ParameterMV T D3 a
kr T D3 a
ki, T (T a)
x) T D3 a
s = do
   let two :: Value Word32
two = Word32 -> Value Word32
forall a. IsConst a => a -> Value a
LLVM.valueOf Word32
2
   T D3 a
sr <- Value Word32 -> T a -> T D3 a -> CodeGenFunction r (T D3 a)
forall a n r.
(C a, Positive n) =>
Value Word32 -> T a -> T n a -> CodeGenFunction r (T n a)
forall n r.
Positive n =>
Value Word32 -> T a -> T n a -> CodeGenFunction r (T n a)
MultiVector.insert Value Word32
two (T (T a) -> T a
forall a. T a -> a
Stereo.left  T (T a)
x) T D3 a
s
   T a
yr <- T D3 a -> T D3 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 D3 a
kr T D3 a
sr

   T D3 a
si <- Value Word32 -> T a -> T D3 a -> CodeGenFunction r (T D3 a)
forall a n r.
(C a, Positive n) =>
Value Word32 -> T a -> T n a -> CodeGenFunction r (T n a)
forall n r.
Positive n =>
Value Word32 -> T a -> T n a -> CodeGenFunction r (T n a)
MultiVector.insert Value Word32
two (T (T a) -> T a
forall a. T a -> a
Stereo.right T (T a)
x) T D3 a
s
   T a
yi <- T D3 a -> T D3 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 D3 a
ki T D3 a
si

   T D3 a
sv <- Vector D3 (T a) -> CodeGenFunction r (T D3 a)
forall n a r.
(Positive n, C a) =>
Vector n (T a) -> CodeGenFunction r (T n a)
MultiVector.assembleFromVector (Vector D3 (T a) -> CodeGenFunction r (T D3 a))
-> Vector D3 (T a) -> CodeGenFunction r (T D3 a)
forall a b. (a -> b) -> a -> b
$ T a -> T a -> T a -> Vector D3 (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
yr T a
yi T a
forall a. Undefined a => a
Tuple.undef
   (T (T a), T D3 a) -> CodeGenFunction r (T (T a), T D3 a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (T a -> T a -> T (T a)
forall a. a -> a -> T a
Stereo.cons T a
yr T a
yi, T D3 a
sv)

causal ::
   (Marshal.Vector n a, n ~ D3, MultiVector.PseudoRing a) =>
   Causal.T
      (ParameterMV a, Stereo.T (MultiValue.T a))
      (Stereo.T (MultiValue.T a))
causal :: forall n a.
(Vector n a, n ~ D3, PseudoRing a) =>
T (ParameterMV a, T (T a)) (T (T a))
causal = (forall r.
 (ParameterMV a, T (T a))
 -> State a -> CodeGenFunction r (T (T a), State a))
-> (forall r. CodeGenFunction r (State a))
-> T (ParameterMV a, T (T a)) (T (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 (ParameterMV a, T (T a))
-> State a -> CodeGenFunction r (T (T a), State a)
forall r.
(ParameterMV a, T (T a))
-> State a -> CodeGenFunction r (T (T a), State a)
forall a r.
PseudoRing a =>
(ParameterMV a, T (T a))
-> State a -> CodeGenFunction r (T (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)