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 Synthesizer.LLVM.Simple.Value as Value
import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Vector as Vector
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 LLVM.Core
(Value, valueOf, Struct,
IsPrimitive, IsFloating, IsSized,
Vector, insertelement,
CodeGenFunction)
import qualified Type.Data.Num.Decimal as TypeNum
import Type.Data.Num.Decimal (D4, d0, d1, (:*:))
import Control.Applicative (liftA2)
import NumericPrelude.Numeric
import NumericPrelude.Base
data Parameter a =
Parameter (Value (Vector D4 a)) (Value (Vector D4 a))
instance 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 IsPrimitive a => Tuple.Undefined (Parameter a) where
undef = Parameter Tuple.undef Tuple.undef
type ParameterStruct a = Struct (Vector D4 a, (Vector D4 a, ()))
parameterMemory ::
(IsPrimitive a, IsSized a,
TypeNum.Positive (TypeNum.D4 :*: LLVM.SizeOf a)) =>
Memory.Record r (ParameterStruct a) (Parameter a)
parameterMemory =
liftA2 Parameter
(Memory.element (\(Parameter kr _) -> kr) d0)
(Memory.element (\(Parameter _ ki) -> ki) d1)
instance
(IsPrimitive a, IsSized a,
TypeNum.Positive (TypeNum.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
parameter ::
(SoV.TranscendentalConstant a, IsFloating a, IsPrimitive a) =>
Value a -> Value a -> CodeGenFunction r (Parameter a)
parameter reson freq = do
amp <- A.fdiv A.one reson
k <- A.sub A.one amp
w <- A.mul freq =<< Value.decons Value.twoPi
kr <- A.mul k =<< A.cos w
ki <- A.mul k =<< A.sin w
kin <- A.neg ki
kvr <- Vector.assemble [kr,kin,amp, A.zero]
kvi <- Vector.assemble [ki,kr, amp, A.zero]
return (Parameter kvr kvi)
type State a = Vector D4 a
next ::
(Vector.Arithmetic a) =>
(Parameter a, Stereo.T (Value a)) ->
Value (State a) ->
CodeGenFunction r (Stereo.T (Value a), (Value (State 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 ::
(Vector.Arithmetic a) =>
CodeGenFunction r (Value (State a))
start = return A.zero
causal ::
(Causal.C process, Vector.Arithmetic a, Memory.C (Value (State a))) =>
process
(Parameter a, Stereo.T (Value a))
(Stereo.T (Value a))
causal =
Causal.mapAccum next start
causalP ::
(Vector.Arithmetic a, Memory.C (Value (State a))) =>
CausalP.T p
(Parameter a, Stereo.T (Value a))
(Stereo.T (Value a))
causalP =
CausalP.mapAccumSimple next start