module Synthesizer.LLVM.Filter.Moog
(Parameter, parameter,
causalP,
) 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.Simple.Value as Value
import Foreign.Storable (Storable, )
import qualified LLVM.Extra.Representation as Rep
import qualified LLVM.Extra.Class as Class
import qualified LLVM.Extra.Vector as Vector
import qualified LLVM.Core as LLVM
import LLVM.Core
(valueOf, Value, Struct,
IsFirstClass, IsConst, IsArithmetic, IsFloating, IsSized,
Undefined, undefTuple,
CodeGenFunction, )
import LLVM.Util.Loop (Phi, phis, addPhis, )
import qualified Data.TypeLevel.Num as TypeNum
import Data.TypeLevel.Num (d0, d1, )
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 qualified Algebra.Transcendental as Trans
import qualified Algebra.Module as Module
import qualified Algebra.Ring as Ring
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.Nat n) =>
Phi (Parameter n a) where
phis = Class.phisTraversable
addPhis = Class.addPhisFoldable
instance (Undefined a, TypeNum.Nat n) =>
Undefined (Parameter n a) where
undefTuple = Class.undefTuplePointed
instance (Class.Zero a, TypeNum.Nat n) =>
Class.Zero (Parameter n a) where
zeroTuple = Class.zeroTuplePointed
parameterMemory ::
(Rep.Memory a s, IsSized s ss, TypeNum.Nat n) =>
Rep.MemoryRecord r (Struct (s, (s, ()))) (Parameter n a)
parameterMemory =
liftA2 (\f k -> Parameter (Moog.Parameter f k))
(Rep.memoryElement (Moog.feedback . getParam) d0)
(Rep.memoryElement (Moog.lowpassParam . getParam) d1)
instance
(Rep.Memory a s, IsSized s ss, TypeNum.Nat n) =>
Rep.Memory (Parameter n a) (Struct (s, (s, ()))) where
load = Rep.loadRecord parameterMemory
store = Rep.storeRecord parameterMemory
decompose = Rep.decomposeRecord parameterMemory
compose = Rep.composeRecord parameterMemory
instance (Value.Flatten ah al, TypeNum.Nat n) =>
Value.Flatten (Parameter n ah) (Parameter n al) where
flatten = Value.flattenTraversable
unfold = Value.unfoldFunctor
instance (Vector.ShuffleMatch m v, TypeNum.Nat n) =>
Vector.ShuffleMatch m (Parameter n v) where
shuffleMatch = Vector.shuffleMatchTraversable
instance (Vector.Access m a v, TypeNum.Nat n) =>
Vector.Access m (Parameter n a) (Parameter n v) where
insert = Vector.insertTraversable
extract = Vector.extractTraversable
parameter ::
(Trans.C a, IsConst a, IsFloating a, TypeNum.Nat n) =>
n -> Value a -> Value a ->
CodeGenFunction r (Parameter n (Value a))
parameter order reson freq =
Value.flatten $
Parameter $ Moog.parameter (TypeNum.toInt order)
(Pole (Value.constantValue reson) (Value.constantValue freq))
merge ::
(Module.C (Value.T a) (Value.T v),
LLVM.MakeValueTuple v (Value v), IsConst v,
LLVM.MakeValueTuple a (Value a), IsConst a) =>
(Parameter n (Value a), Value v) -> Value v ->
CodeGenFunction r (FirstOrder.Parameter (Value a), Value v)
merge (Parameter (Moog.Parameter f k), x) y0 =
let c :: (LLVM.MakeValueTuple a (Value a)) => Value a -> Value.T a
c = Value.constantValue
in Value.flatten (fmap c k, c x c f *> c y0)
amplify ::
(Module.C (Value.T a) (Value.T v)) =>
Parameter n (Value a) ->
Value v ->
CodeGenFunction r (Value v)
amplify (Parameter (Moog.Parameter f _k)) y1 =
Value.decons $
(1 + Value.constantValue f) *> Value.constantValue y1
causalP ::
(Module.C (Value.T a) (Value.T v),
Module.C a v, Storable v,
LLVM.MakeValueTuple v (Value v),
LLVM.MakeValueTuple a (Value a),
IsFirstClass a, IsSized a as, IsConst a, IsArithmetic a,
IsFirstClass v, IsSized v vs, IsConst v,
TypeNum.Nat n) =>
CausalP.T p
(Parameter n (Value a), Value v) (Value v)
causalP =
causalPSize undefined
causalPSize ::
(Module.C (Value.T a) (Value.T v),
Module.C a v, Storable v,
LLVM.MakeValueTuple v (Value v),
LLVM.MakeValueTuple a (Value a),
IsFirstClass a, IsSized a as, IsConst a, IsArithmetic a,
IsFirstClass v, IsSized v vs, IsConst v,
TypeNum.Nat n) =>
n ->
CausalP.T p
(Parameter n (Value a), Value v) (Value v)
causalPSize n =
let order = TypeNum.toInt n
feedZero = zero
selectOutput = snd `asTypeOf` const (valueOf feedZero)
in Arrow.arr fst &&&
CausalP.feedbackControlled
(return feedZero)
(CausalP.mapSimple (uncurry merge) >>>
CausalP.replicateControlled order Filt1.lowpassCausalP)
(Arrow.arr selectOutput)
>>> CausalP.mapSimple (uncurry amplify)