module Synthesizer.LLVM.Filter.Moog
(Parameter, parameter,
causal, causalInit,
causalP, causalInitP,
) where
import qualified Synthesizer.LLVM.Filter.FirstOrder as Filt1
import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as FirstOrder
import qualified Synthesizer.Plain.Filter.Recursive.Moog as Moog
import Synthesizer.Plain.Filter.Recursive (Pole(..))
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.Parameter as Param
import Foreign.Storable (Storable, )
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.Class as Class
import LLVM.Extra.Class (Undefined, undefTuple, )
import qualified LLVM.Core as LLVM
import LLVM.Core (CodeGenFunction, )
import LLVM.Util.Loop (Phi, phis, addPhis, )
import qualified Type.Data.Num.Decimal as TypeNum
import Type.Data.Num.Decimal (d0, d1, )
import Type.Base.Proxy (Proxy(Proxy), )
import qualified Control.Arrow as Arrow
import qualified Control.Applicative as App
import qualified Data.Foldable as Fold
import qualified Data.Traversable as Trav
import Control.Arrow (arr, (>>>), (&&&), )
import Control.Applicative (liftA2, )
import NumericPrelude.Numeric
import NumericPrelude.Base
newtype Parameter n a = Parameter {getParam :: Moog.Parameter a}
deriving (Functor, App.Applicative, Fold.Foldable, Trav.Traversable)
instance (Phi a, TypeNum.Natural n) =>
Phi (Parameter n a) where
phis = Class.phisTraversable
addPhis = Class.addPhisFoldable
instance (Undefined a, TypeNum.Natural n) =>
Undefined (Parameter n a) where
undefTuple = Class.undefTuplePointed
instance (Class.Zero a, TypeNum.Natural n) =>
Class.Zero (Parameter n a) where
zeroTuple = Class.zeroTuplePointed
type ParameterStruct a = LLVM.Struct (a, (a, ()))
parameterMemory ::
(Memory.C a, TypeNum.Natural n) =>
Memory.Record r (ParameterStruct (Memory.Struct a)) (Parameter n a)
parameterMemory =
liftA2 (\f k -> Parameter (Moog.Parameter f k))
(Memory.element (Moog.feedback . getParam) d0)
(Memory.element (Moog.lowpassParam . getParam) d1)
instance
(Memory.C a, TypeNum.Natural n) =>
Memory.C (Parameter n a) where
type Struct (Parameter n a) = ParameterStruct (Memory.Struct a)
load = Memory.loadRecord parameterMemory
store = Memory.storeRecord parameterMemory
decompose = Memory.decomposeRecord parameterMemory
compose = Memory.composeRecord parameterMemory
instance (Value.Flatten a, TypeNum.Natural n) => Value.Flatten (Parameter n a) where
type Registers (Parameter n a) = Parameter n (Value.Registers a)
flattenCode = Value.flattenCodeTraversable
unfoldCode = Value.unfoldCodeTraversable
instance (Vector.Simple v, TypeNum.Natural n) => Vector.Simple (Parameter n v) where
type Element (Parameter n v) = Parameter n (Vector.Element v)
type Size (Parameter n v) = Vector.Size v
shuffleMatch = Vector.shuffleMatchTraversable
extract = Vector.extractTraversable
instance (Vector.C v, TypeNum.Natural n) => Vector.C (Parameter n v) where
insert = Vector.insertTraversable
parameter ::
(A.Transcendental a, A.RationalConstant a, TypeNum.Natural n) =>
Proxy n -> a -> a ->
CodeGenFunction r (Parameter n a)
parameter order =
Value.unlift2 $ \reson freq ->
Parameter $ Moog.parameter (TypeNum.integralFromProxy order) (Pole reson freq)
merge ::
(a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a) =>
(Parameter n a, v) -> v ->
CodeGenFunction r (FirstOrder.Parameter a, v)
merge (Parameter (Moog.Parameter f k), x) y0 =
let c :: a -> Value.T a
c = Value.constantValue
in Value.flatten (fmap c k, c x c f *> c y0)
amplify ::
(a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a) =>
Parameter n a ->
v ->
CodeGenFunction r v
amplify =
Value.unlift2 $ \p y1 ->
case fmap (Moog.feedback . getParam) p of
f -> (1 + f) *> y1
causal ::
(Causal.C process,
Memory.C v, A.PseudoModule v, A.Scalar v ~ a, A.IntegerConstant a,
TypeNum.Natural n) =>
process (Parameter n a, v) v
causal =
causalSize
(flip Causal.feedbackControlledZero (arr snd))
Proxy
causalP ::
(Memory.C v, A.PseudoModule v, A.Scalar v ~ a, A.IntegerConstant a,
TypeNum.Natural n) =>
CausalP.T p (Parameter n a, v) v
causalP = causal
causalInit, causalInitP ::
(Storable vh, Class.MakeValueTuple vh,
Class.ValueTuple vh ~ v, Memory.C v,
A.PseudoModule v, A.Scalar v ~ a, A.IntegerConstant a,
TypeNum.Natural n) =>
Param.T p vh -> CausalP.T p (Parameter n a, v) v
causalInit = causalInitP
causalInitP initial =
let selectOutput :: Param.T p vh -> (b, Class.ValueTuple vh) -> Class.ValueTuple vh
selectOutput _ = snd
in causalSize
(flip
(CausalP.feedbackControlled initial)
(arr $ selectOutput initial))
Proxy
causalSize ::
(Causal.C process,
Memory.C v, A.PseudoModule v, A.Scalar v ~ a, A.IntegerConstant a,
TypeNum.Natural n) =>
(process ((Parameter n a, v), v) v ->
process (Parameter n a, v) v) ->
Proxy n ->
process (Parameter n a, v) v
causalSize feedback n =
let order = TypeNum.integralFromProxy n
in Arrow.arr fst &&&
feedback
(Causal.zipWith merge >>>
Causal.replicateControlled order Filt1.lowpassCausal)
>>> Causal.zipWith amplify