module Synthesizer.LLVM.Filter.SecondOrderPacked (
Parameter, bandpassParameter, State, causal, causalP,
) where
import qualified Synthesizer.LLVM.Filter.SecondOrder as Filt2L
import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2
import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
import qualified Synthesizer.LLVM.Causal.Process as Causal
import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Vector as Vector
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Core as LLVM
import LLVM.Core
(Value, valueOf, Struct,
IsFirstClass, IsFloating,
Vector, IsPrimitive, IsSized,
CodeGenFunction)
import qualified Type.Data.Num.Decimal as TypeNum
import Type.Data.Num.Decimal (D4, d0, d1, (:*:))
import Control.Applicative (liftA2)
import qualified Algebra.Transcendental as Trans
import NumericPrelude.Numeric
import NumericPrelude.Base
data Parameter a =
Parameter (Value a) (Value (Vector D4 a))
instance (IsFirstClass a, IsPrimitive a) => Tuple.Phi (Parameter a) where
phi bb (Parameter r i) = do
r' <- Tuple.phi bb r
i' <- Tuple.phi bb i
return (Parameter r' i')
addPhi bb (Parameter r i) (Parameter r' i') = do
Tuple.addPhi bb r r'
Tuple.addPhi bb i i'
instance (IsFirstClass a, IsPrimitive a) => Tuple.Undefined (Parameter a) where
undef = Parameter Tuple.undef Tuple.undef
type ParameterStruct a = Struct (a, (Vector D4 a, ()))
parameterMemory ::
(IsPrimitive a, IsSized a, TypeNum.Positive (D4 :*: LLVM.SizeOf a)) =>
Memory.Record r (ParameterStruct a) (Parameter a)
parameterMemory =
liftA2 Parameter
(Memory.element (\(Parameter c0 _) -> c0) d0)
(Memory.element (\(Parameter _ cd) -> cd) d1)
instance
(IsPrimitive a, IsSized a, TypeNum.Positive (D4 :*: LLVM.SizeOf a)) =>
Memory.C (Parameter a) where
type Struct (Parameter a) = ParameterStruct a
load = Memory.loadRecord parameterMemory
store = Memory.storeRecord parameterMemory
decompose = Memory.decomposeRecord parameterMemory
compose = Memory.composeRecord parameterMemory
type State = Vector D4
bandpassParameter ::
(Trans.C a, IsFloating a, SoV.TranscendentalConstant a, IsPrimitive a) =>
Value a ->
Value a ->
CodeGenFunction r (Parameter a)
bandpassParameter reson cutoff = do
p <- Filt2L.bandpassParameter reson cutoff
v <- Vector.assemble [Filt2.c1 p, Filt2.d1 p, Filt2.c2 p, Filt2.d2 p]
return $ Parameter (Filt2.c0 p) v
next ::
(Vector.Arithmetic a) =>
(Parameter a, Value a) ->
Value (State a) ->
CodeGenFunction r (Value a, Value (State a))
next (Parameter c0 k1, x0) y1 = do
s0 <- A.mul c0 x0
s1 <- Vector.dotProduct k1 y1
y0 <- A.add s0 s1
x1new <- Vector.extract (valueOf 0) y1
y1new <- Vector.extract (valueOf 1) y1
yv <- Vector.assemble [x0, y0, x1new, y1new]
return (y0, yv)
causal ::
(Causal.C process,
Vector.Arithmetic a, Value (State a) ~ value, Memory.C value) =>
process (Parameter a, Value a) (Value a)
causal =
Causal.mapAccum next (return A.zero)
causalP ::
(Vector.Arithmetic a, Value (State a) ~ value, Memory.C value) =>
CausalP.T p (Parameter a, Value a) (Value a)
causalP = causal