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 LLVM.Extra.Class (Undefined, undefTuple, )
import qualified LLVM.Core as LLVM
import LLVM.Core
(Value, valueOf, Struct,
IsFirstClass, IsFloating,
Vector, IsPrimitive, IsSized,
CodeGenFunction, )
import LLVM.Util.Loop (Phi, phis, addPhis, )
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) => Phi (Parameter a) where
phis bb (Parameter r i) = do
r' <- phis bb r
i' <- phis bb i
return (Parameter r' i')
addPhis bb
(Parameter r i)
(Parameter r' i') = do
addPhis bb r r'
addPhis bb i i'
instance (IsFirstClass a, IsPrimitive a) => Undefined (Parameter a) where
undefTuple = Parameter undefTuple undefTuple
type ParameterStruct a = Struct (a, (Vector D4 a, ()))
parameterMemory ::
(Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,
IsPrimitive a, IsPrimitive am,
TypeNum.Positive (D4 :*: LLVM.SizeOf am)) =>
Memory.Record r (ParameterStruct am) (Parameter a)
parameterMemory =
liftA2 Parameter
(Memory.element (\(Parameter c0 _) -> c0) d0)
(Memory.element (\(Parameter _ cd) -> cd) d1)
instance
(Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,
IsPrimitive a, IsPrimitive am,
TypeNum.Positive (D4 :*: LLVM.SizeOf am)) =>
Memory.C (Parameter a) where
type Struct (Parameter a) = ParameterStruct (Memory.Stored 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, Memory.C (Value (State a))) =>
process (Parameter a, Value a) (Value a)
causal =
Causal.mapAccum next (return A.zero)
causalP ::
(Vector.Arithmetic a, Memory.C (Value (State a))) =>
CausalP.T p (Parameter a, Value a) (Value a)
causalP = causal