module Synthesizer.LLVM.Filter.ComplexFirstOrderPacked (
Parameter, parameter,
causal, causalP,
) where
import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
import qualified Synthesizer.LLVM.Causal.Process as Causal
import qualified LLVM.Extra.Representation as Rep
import qualified Synthesizer.LLVM.Simple.Value as Value
import qualified LLVM.Extra.Vector as Vector
import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Core as LLVM
import LLVM.Core
(Value, valueOf, value, Struct,
IsPrimitive, IsConst, IsFloating, IsSized,
Undefined, undefTuple,
Vector, insertelement,
neg, CodeGenFunction, )
import LLVM.Util.Loop (Phi, phis, addPhis, )
import Data.TypeLevel.Num (Add, D4, d0, d1, )
import qualified Data.TypeLevel.Num.Sets as Sets
import Control.Applicative (liftA2, )
import qualified Algebra.Transcendental as Trans
import NumericPrelude.Numeric
import NumericPrelude.Base
data Parameter a =
Parameter (Value (Vector D4 a)) (Value (Vector D4 a))
instance 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 IsPrimitive a => Undefined (Parameter a) where
undefTuple = Parameter undefTuple undefTuple
parameterMemory ::
(IsPrimitive l, IsSized l s, Add s s s2, Add s2 s s3, Add s3 s s4, Sets.Pos s4) =>
Rep.MemoryRecord r (Struct (Vector D4 l, (Vector D4 l, ()))) (Parameter l)
parameterMemory =
liftA2 Parameter
(Rep.memoryElement (\(Parameter kr _) -> kr) d0)
(Rep.memoryElement (\(Parameter _ ki) -> ki) d1)
instance (IsPrimitive l, IsSized l s, Add s s s2, Add s2 s s3, Add s3 s s4, Sets.Pos s4) =>
Rep.Memory (Parameter l) (Struct (Vector D4 l, (Vector D4 l, ()))) where
load = Rep.loadRecord parameterMemory
store = Rep.storeRecord parameterMemory
decompose = Rep.decomposeRecord parameterMemory
compose = Rep.composeRecord parameterMemory
parameter ::
(Trans.C a,
IsPrimitive a, IsConst a, IsFloating a) =>
Value a -> Value a -> CodeGenFunction r (Parameter a)
parameter reson freq = do
amp <- A.fdiv (valueOf 1) reson
k <- A.sub (valueOf 1) amp
w <- A.mul freq =<< Value.decons Value.twoPi
kr <- A.mul k =<< A.cos w
ki <- A.mul k =<< A.sin w
kin <- neg ki
kvr <- Vector.assemble [kr,kin,amp, value LLVM.zero]
kvi <- Vector.assemble [ki,kr, amp, value LLVM.zero]
return (Parameter kvr kvi)
next ::
(Vector.Arithmetic a, IsConst a) =>
(Parameter a, Stereo.T (Value a)) ->
(Value (Vector D4 a)) ->
CodeGenFunction r (Stereo.T (Value a), (Value (Vector D4 a)))
next (Parameter kr ki, x) s = do
sr <- insertelement s (Stereo.left x) (valueOf 2)
yr <- Vector.dotProduct kr sr
si <- insertelement s (Stereo.right x) (valueOf 2)
yi <- Vector.dotProduct ki si
sv <- Vector.assemble [yr,yi]
return (Stereo.cons yr yi, sv)
start ::
(IsPrimitive a, IsConst a) =>
CodeGenFunction r (Value (Vector D4 a))
start =
return (value LLVM.zero)
causal ::
(IsConst a, Vector.Arithmetic a,
IsSized (Vector D4 a) as) =>
Causal.T
(Parameter a, Stereo.T (Value a))
(Stereo.T (Value a))
causal =
Causal.mapAccum next start
causalP ::
(IsConst a, Vector.Arithmetic a,
IsSized (Vector D4 a) as) =>
CausalP.T p
(Parameter a, Stereo.T (Value a))
(Stereo.T (Value a))
causalP =
CausalP.mapAccumSimple next start