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 LLVM.Extra.Class (Undefined, undefTuple, )
import qualified LLVM.Core as LLVM
import LLVM.Core
(Value, valueOf, Struct,
IsPrimitive, IsFloating, IsSized,
Vector, insertelement,
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 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
type ParameterStruct a = Struct (Vector D4 a, (Vector D4 a, ()))
parameterMemory ::
(Memory.FirstClass a, Memory.Stored a ~ am,
IsPrimitive a, IsPrimitive am,
TypeNum.Positive (TypeNum.D4 :*: LLVM.SizeOf am),
IsSized am) =>
Memory.Record r (ParameterStruct am) (Parameter a)
parameterMemory =
liftA2 Parameter
(Memory.element (\(Parameter kr _) -> kr) d0)
(Memory.element (\(Parameter _ ki) -> ki) d1)
instance
(Memory.FirstClass a, Memory.Stored a ~ am,
IsPrimitive a, IsPrimitive am,
IsSized am,
TypeNum.Positive (TypeNum.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
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