module Synthesizer.LLVM.Filter.FirstOrder (
Result(Result,lowpass_,highpass_), Parameter, parameter,
causalP, lowpassCausalP, highpassCausalP,
causalPackedP, lowpassCausalPackedP, highpassCausalPackedP,
causalRecursivePackedP,
) where
import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as FirstOrder
import Synthesizer.Plain.Filter.Recursive.FirstOrder
(Parameter(Parameter), Result(Result,lowpass_,highpass_))
import qualified Synthesizer.Plain.Modifier as Modifier
import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
import qualified LLVM.Extra.Representation as Rep
import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Vector as Vector
import qualified Synthesizer.LLVM.Simple.Value as Value
import qualified LLVM.Extra.Class as Class
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Core as LLVM
import LLVM.Core
(Value, valueOf, Vector, Undefined, undefTuple,
IsFirstClass, IsConst, IsArithmetic, IsFloating,
IsPrimitive, IsPowerOf2, IsSized,
CodeGenFunction, )
import LLVM.Util.Loop (Phi, phis, addPhis, )
import Control.Arrow (arr, (&&&), (<<<), )
import Control.Monad (liftM2, foldM, )
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Module as Module
import qualified Algebra.Ring as Ring
import NumericPrelude.Numeric
import NumericPrelude.Base
instance (Phi a) => Phi (Parameter a) where
phis = Class.phisTraversable
addPhis = Class.addPhisFoldable
instance Undefined a => Undefined (Parameter a) where
undefTuple = Class.undefTuplePointed
instance
(Rep.Memory a s, IsSized s ss) =>
Rep.Memory (Parameter a) s where
load = Rep.loadNewtype Parameter
store = Rep.storeNewtype (\(Parameter k) -> k)
decompose = Rep.decomposeNewtype Parameter
compose = Rep.composeNewtype (\(Parameter k) -> k)
instance (Value.Flatten ah al) =>
Value.Flatten (Parameter ah) (Parameter al) where
flatten = Value.flattenTraversable
unfold = Value.unfoldFunctor
instance LLVM.ValueTuple a => LLVM.ValueTuple (Parameter a) where
buildTuple f = Class.buildTupleTraversable (LLVM.buildTuple f)
instance LLVM.IsTuple a => LLVM.IsTuple (Parameter a) where
tupleDesc = Class.tupleDescFoldable
instance (LLVM.MakeValueTuple ah al) =>
LLVM.MakeValueTuple (Parameter ah) (Parameter al) where
valueTupleOf = Class.valueTupleOfFunctor
parameter ::
(Trans.C a, IsConst a, IsFloating a) =>
Value a ->
CodeGenFunction r (Parameter (Value a))
parameter reson =
Value.flatten $
FirstOrder.parameter
(Value.constantValue reson)
lowpassModifier, highpassModifier ::
(Module.C (Value.T a) (Value.T v), IsArithmetic a, IsConst a) =>
Modifier.Simple
(Value.T v)
(Parameter (Value.T a))
(Value.T v) (Value.T v)
lowpassModifier = FirstOrder.lowpassModifier
highpassModifier = FirstOrder.highpassModifier
causalP ::
(Ring.C a, Module.C (Value.T a) (Value.T v),
IsFirstClass a, IsSized a as, IsConst a, IsArithmetic a,
IsFirstClass v, IsSized v vs, IsConst v, IsArithmetic v) =>
CausalP.T p
(Parameter (Value a), Value v) (Result (Value v))
causalP =
CausalP.mapSimple (\(l,x) -> do
h <- A.sub x l
return (Result{FirstOrder.lowpass_ = l,
FirstOrder.highpass_ = h}))
<<< (lowpassCausalP &&& arr snd)
lowpassCausalP, highpassCausalP ::
(Ring.C a, Module.C (Value.T a) (Value.T v),
IsFirstClass a, IsSized a as, IsConst a,
IsFirstClass v, IsSized v vs, IsConst v,
IsArithmetic a) =>
CausalP.T p
(Parameter (Value a), Value v) (Value v)
lowpassCausalP = CausalP.fromModifier lowpassModifier
highpassCausalP = CausalP.fromModifier highpassModifier
lowpassCausalPackedP, highpassCausalPackedP, causalRecursivePackedP ::
(Ring.C a,
IsFirstClass a, IsConst a, IsSized a as,
IsPowerOf2 n,
IsArithmetic a, IsPrimitive a) =>
CausalP.T p
(Parameter (Value a), Value (Vector n a)) (Value (Vector n a))
highpassCausalPackedP =
CausalP.mapSimple (uncurry A.sub) <<<
(arr snd &&& lowpassCausalPackedP)
lowpassCausalPackedP =
causalRecursivePackedP <<<
(arr fst &&&
CausalP.mapSimple
(\(FirstOrder.Parameter k, x) ->
A.mul x =<< SoV.replicate =<< A.sub (valueOf 1) k))
causalRecursivePackedP =
CausalP.mapAccumSimple
(\(FirstOrder.Parameter k, xk0) y1 -> do
y1k <- A.mul k y1
xk1 <- Vector.modify (valueOf 0) (A.add y1k) xk0
let size = Vector.sizeInTuple xk0
kv <- SoV.replicate k
xk2 <-
fmap fst $
foldM
(\(y,k0) d ->
liftM2 (,)
(A.add y =<<
Vector.shiftUpMultiZero d =<<
A.mul y k0)
(A.mul k0 k0))
(xk1,kv)
(takeWhile (< size) $ iterate (2*) 1)
y0 <- Vector.extract (valueOf $ fromIntegral $ size 1) xk2
return (xk2, y0))
(return (LLVM.value LLVM.zero))
causalPackedP ::
(Ring.C a, IsArithmetic a, IsPrimitive a,
IsFirstClass a, IsConst a, IsSized a as,
IsPowerOf2 n) =>
CausalP.T p
(Parameter (Value a), Value (Vector n a))
(Result (Value (Vector n a)))
causalPackedP =
CausalP.mapSimple (\(l,x) -> do
h <- A.sub x l
return (Result{FirstOrder.lowpass_ = l,
FirstOrder.highpass_ = h}))
<<< (lowpassCausalPackedP &&& arr snd)