{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE Rank2Types #-} module Synthesizer.LLVM.Filter.ComplexFirstOrderPacked ( Parameter(Parameter), parameterPlain, parameter, causal, ParameterMV, ) where import qualified Synthesizer.LLVM.Filter.ComplexFirstOrder as ComplexFilter import qualified Synthesizer.LLVM.Causal.Private as Causal import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp(Exp)) import qualified LLVM.Extra.Multi.Value.Marshal as Marshal import qualified LLVM.Extra.Multi.Value as MultiValue import qualified LLVM.Extra.Multi.Vector as MultiVector 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 Type.Data.Num.Decimal (D3, d0, d1) import Control.Applicative (liftA2) import qualified Algebra.Transcendental as Trans import qualified Number.Complex as Complex import NumericPrelude.Numeric import NumericPrelude.Base data Parameter a = Parameter (LLVM.Vector D3 a) (LLVM.Vector D3 a) data ParameterMV a = ParameterMV (MultiVector.T D3 a) (MultiVector.T D3 a) instance (MultiVector.C a) => Tuple.Phi (ParameterMV a) where phi :: forall r. BasicBlock -> ParameterMV a -> CodeGenFunction r (ParameterMV a) phi BasicBlock bb (ParameterMV T D3 a r T D3 a i) = do T D3 a r' <- BasicBlock -> T D3 a -> CodeGenFunction r (T D3 a) forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a forall r. BasicBlock -> T D3 a -> CodeGenFunction r (T D3 a) Tuple.phi BasicBlock bb T D3 a r T D3 a i' <- BasicBlock -> T D3 a -> CodeGenFunction r (T D3 a) forall a r. Phi a => BasicBlock -> a -> CodeGenFunction r a forall r. BasicBlock -> T D3 a -> CodeGenFunction r (T D3 a) Tuple.phi BasicBlock bb T D3 a i ParameterMV a -> CodeGenFunction r (ParameterMV a) forall a. a -> CodeGenFunction r a forall (m :: * -> *) a. Monad m => a -> m a return (T D3 a -> T D3 a -> ParameterMV a forall a. T D3 a -> T D3 a -> ParameterMV a ParameterMV T D3 a r' T D3 a i') addPhi :: forall r. BasicBlock -> ParameterMV a -> ParameterMV a -> CodeGenFunction r () addPhi BasicBlock bb (ParameterMV T D3 a r T D3 a i) (ParameterMV T D3 a r' T D3 a i') = do BasicBlock -> T D3 a -> T D3 a -> CodeGenFunction r () forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r () forall r. BasicBlock -> T D3 a -> T D3 a -> CodeGenFunction r () Tuple.addPhi BasicBlock bb T D3 a r T D3 a r' BasicBlock -> T D3 a -> T D3 a -> CodeGenFunction r () forall a r. Phi a => BasicBlock -> a -> a -> CodeGenFunction r () forall r. BasicBlock -> T D3 a -> T D3 a -> CodeGenFunction r () Tuple.addPhi BasicBlock bb T D3 a i T D3 a i' instance (MultiVector.C a) => Tuple.Undefined (ParameterMV a) where undef :: ParameterMV a undef = T D3 a -> T D3 a -> ParameterMV a forall a. T D3 a -> T D3 a -> ParameterMV a ParameterMV T D3 a forall a. Undefined a => a Tuple.undef T D3 a forall a. Undefined a => a Tuple.undef type ParameterStruct a = Marshal.Struct (LLVM.Vector D3 a, LLVM.Vector D3 a) parameterMemory :: (Marshal.Vector D3 a) => Memory.Record r (ParameterStruct a) (ParameterMV a) parameterMemory :: forall a r. Vector D3 a => Record r (ParameterStruct a) (ParameterMV a) parameterMemory = (T D3 a -> T D3 a -> ParameterMV a) -> Element r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) (T D3 a) -> Element r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) (T D3 a) -> Element r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) (ParameterMV a) forall a b c. (a -> b -> c) -> Element r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) a -> Element r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) b -> Element r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) c forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 T D3 a -> T D3 a -> ParameterMV a forall a. T D3 a -> T D3 a -> ParameterMV a ParameterMV ((ParameterMV a -> T D3 a) -> Proxy D0 -> Element r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) (T D3 a) forall x o n v r. (C x, GetValue o n, ValueType o n ~ Struct x, GetElementPtr o (n, ()), ElementPtrType o (n, ()) ~ Struct x) => (v -> x) -> n -> Element r o v x Memory.element (\(ParameterMV T D3 a kr T D3 a _) -> T D3 a kr) Proxy D0 d0) ((ParameterMV a -> T D3 a) -> Proxy D1 -> Element r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) (T D3 a) forall x o n v r. (C x, GetValue o n, ValueType o n ~ Struct x, GetElementPtr o (n, ()), ElementPtrType o (n, ()) ~ Struct x) => (v -> x) -> n -> Element r o v x Memory.element (\(ParameterMV T D3 a _ T D3 a ki) -> T D3 a ki) Proxy D1 d1) instance (Marshal.Vector D3 a) => Memory.C (ParameterMV a) where type Struct (ParameterMV a) = ParameterStruct a load :: forall r. Value (Ptr (Struct (ParameterMV a))) -> CodeGenFunction r (ParameterMV a) load = Record r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) -> Value (Ptr (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ())))) -> CodeGenFunction r (ParameterMV a) forall r o llvmValue. Record r o llvmValue -> Value (Ptr o) -> CodeGenFunction r llvmValue Memory.loadRecord Record r (ParameterStruct a) (ParameterMV a) Record r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) forall a r. Vector D3 a => Record r (ParameterStruct a) (ParameterMV a) parameterMemory store :: forall r. ParameterMV a -> Value (Ptr (Struct (ParameterMV a))) -> CodeGenFunction r () store = Record r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) -> ParameterMV a -> Value (Ptr (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ())))) -> CodeGenFunction r () forall r o llvmValue. Record r o llvmValue -> llvmValue -> Value (Ptr o) -> CodeGenFunction r () Memory.storeRecord Record r (ParameterStruct a) (ParameterMV a) Record r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) forall a r. Vector D3 a => Record r (ParameterStruct a) (ParameterMV a) parameterMemory decompose :: forall r. Value (Struct (ParameterMV a)) -> CodeGenFunction r (ParameterMV a) decompose = Record r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) -> Value (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) -> CodeGenFunction r (ParameterMV a) forall r o llvmValue. Record r o llvmValue -> Value o -> CodeGenFunction r llvmValue Memory.decomposeRecord Record r (ParameterStruct a) (ParameterMV a) Record r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) forall a r. Vector D3 a => Record r (ParameterStruct a) (ParameterMV a) parameterMemory compose :: forall r. ParameterMV a -> CodeGenFunction r (Value (Struct (ParameterMV a))) compose = Record r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) -> ParameterMV a -> CodeGenFunction r (Value (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ())))) forall o r llvmValue. IsType o => Record r o llvmValue -> llvmValue -> CodeGenFunction r (Value o) Memory.composeRecord Record r (ParameterStruct a) (ParameterMV a) Record r (Struct (Struct (Repr D3 a), (Struct (Repr D3 a), ()))) (ParameterMV a) forall a r. Vector D3 a => Record r (ParameterStruct a) (ParameterMV a) parameterMemory data ParameterExp a = ParameterExp (forall r. LLVM.CodeGenFunction r (ParameterMV a)) instance Expr.Aggregate (ParameterExp a) (ParameterMV a) where type MultiValuesOf (ParameterExp a) = ParameterMV a type ExpressionsOf (ParameterMV a) = ParameterExp a dissect :: ParameterMV a -> ParameterExp a dissect ParameterMV a x = (forall r. CodeGenFunction r (ParameterMV a)) -> ParameterExp a forall a. (forall r. CodeGenFunction r (ParameterMV a)) -> ParameterExp a ParameterExp (ParameterMV a -> CodeGenFunction r (ParameterMV a) forall a. a -> CodeGenFunction r a forall (m :: * -> *) a. Monad m => a -> m a return ParameterMV a x) bundle :: forall r. ParameterExp a -> CodeGenFunction r (ParameterMV a) bundle (ParameterExp forall r. CodeGenFunction r (ParameterMV a) code) = CodeGenFunction r (ParameterMV a) forall r. CodeGenFunction r (ParameterMV a) code parameterPlain :: (Trans.C a) => a -> a -> Parameter a parameterPlain :: forall a. C a => a -> a -> Parameter a parameterPlain a reson a freq = let (ComplexFilter.Parameter a amp T a k) = a -> a -> Parameter a forall a. C a => a -> a -> Parameter a ComplexFilter.parameter a reson a freq kr :: a kr = T a -> a forall a. T a -> a Complex.real T a k ki :: a ki = T a -> a forall a. T a -> a Complex.imag T a k in Vector D3 a -> Vector D3 a -> Parameter a forall a. Vector D3 a -> Vector D3 a -> Parameter a Parameter (a -> a -> a -> Vector D3 a forall f n u. (ConsVector f, ResultSize f ~ n, NumberOfArguments f ~ u, u ~ ToUnary n, FromUnary u ~ n, Natural n) => f LLVM.consVector a kr (-a ki) a amp) (a -> a -> a -> Vector D3 a forall f n u. (ConsVector f, ResultSize f ~ n, NumberOfArguments f ~ u, u ~ ToUnary n, FromUnary u ~ n, Natural n) => f LLVM.consVector a ki a kr a amp) parameter :: (MultiVector.Transcendental a, MultiVector.RationalConstant a) => Exp a -> Exp a -> ParameterExp a parameter :: forall a. (Transcendental a, RationalConstant a) => Exp a -> Exp a -> ParameterExp a parameter (Exp forall r. CodeGenFunction r (T a) reson) (Exp forall r. CodeGenFunction r (T a) freq) = (forall r. CodeGenFunction r (ParameterMV a)) -> ParameterExp a forall a. (forall r. CodeGenFunction r (ParameterMV a)) -> ParameterExp a ParameterExp (do T a r <- CodeGenFunction r (T a) forall r. CodeGenFunction r (T a) reson T a f <- CodeGenFunction r (T a) forall r. CodeGenFunction r (T a) freq ~(ComplexFilter.Parameter T a amp T (T a) k) <- T a -> T a -> CodeGenFunction r (Parameter (T a)) forall a r. (Transcendental a, RationalConstant a) => a -> a -> CodeGenFunction r (Parameter a) ComplexFilter.parameterCode T a r T a f let kr :: T a kr = T (T a) -> T a forall a. T a -> a Complex.real T (T a) k let ki :: T a ki = T (T a) -> T a forall a. T a -> a Complex.imag T (T a) k T a kin <- T a -> CodeGenFunction r (T a) forall a r. Additive a => a -> CodeGenFunction r a forall r. T a -> CodeGenFunction r (T a) A.neg T a ki (T D3 a -> T D3 a -> ParameterMV a) -> CodeGenFunction r (T D3 a) -> CodeGenFunction r (T D3 a) -> CodeGenFunction r (ParameterMV a) forall a b c. (a -> b -> c) -> CodeGenFunction r a -> CodeGenFunction r b -> CodeGenFunction r c forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 T D3 a -> T D3 a -> ParameterMV a forall a. T D3 a -> T D3 a -> ParameterMV a ParameterMV (Vector D3 (T a) -> CodeGenFunction r (T D3 a) forall n a r. (Positive n, C a) => Vector n (T a) -> CodeGenFunction r (T n a) MultiVector.assembleFromVector (Vector D3 (T a) -> CodeGenFunction r (T D3 a)) -> Vector D3 (T a) -> CodeGenFunction r (T D3 a) forall a b. (a -> b) -> a -> b $ T a -> T a -> T a -> Vector D3 (T a) forall f n u. (ConsVector f, ResultSize f ~ n, NumberOfArguments f ~ u, u ~ ToUnary n, FromUnary u ~ n, Natural n) => f LLVM.consVector T a kr T a kin T a amp) (Vector D3 (T a) -> CodeGenFunction r (T D3 a) forall n a r. (Positive n, C a) => Vector n (T a) -> CodeGenFunction r (T n a) MultiVector.assembleFromVector (Vector D3 (T a) -> CodeGenFunction r (T D3 a)) -> Vector D3 (T a) -> CodeGenFunction r (T D3 a) forall a b. (a -> b) -> a -> b $ T a -> T a -> T a -> Vector D3 (T a) forall f n u. (ConsVector f, ResultSize f ~ n, NumberOfArguments f ~ u, u ~ ToUnary n, FromUnary u ~ n, Natural n) => f LLVM.consVector T a ki T a kr T a amp)) type State a = MultiVector.T D3 a next :: (MultiVector.PseudoRing a) => (ParameterMV a, Stereo.T (MultiValue.T a)) -> State a -> LLVM.CodeGenFunction r (Stereo.T (MultiValue.T a), State a) next :: forall a r. PseudoRing a => (ParameterMV a, T (T a)) -> State a -> CodeGenFunction r (T (T a), State a) next (ParameterMV T D3 a kr T D3 a ki, T (T a) x) T D3 a s = do let two :: Value Word32 two = Word32 -> Value Word32 forall a. IsConst a => a -> Value a LLVM.valueOf Word32 2 T D3 a sr <- Value Word32 -> T a -> T D3 a -> CodeGenFunction r (T D3 a) forall a n r. (C a, Positive n) => Value Word32 -> T a -> T n a -> CodeGenFunction r (T n a) forall n r. Positive n => Value Word32 -> T a -> T n a -> CodeGenFunction r (T n a) MultiVector.insert Value Word32 two (T (T a) -> T a forall a. T a -> a Stereo.left T (T a) x) T D3 a s T a yr <- T D3 a -> T D3 a -> CodeGenFunction r (T a) forall n a r. (Positive n, PseudoRing a) => T n a -> T n a -> CodeGenFunction r (T a) MultiVector.dotProduct T D3 a kr T D3 a sr T D3 a si <- Value Word32 -> T a -> T D3 a -> CodeGenFunction r (T D3 a) forall a n r. (C a, Positive n) => Value Word32 -> T a -> T n a -> CodeGenFunction r (T n a) forall n r. Positive n => Value Word32 -> T a -> T n a -> CodeGenFunction r (T n a) MultiVector.insert Value Word32 two (T (T a) -> T a forall a. T a -> a Stereo.right T (T a) x) T D3 a s T a yi <- T D3 a -> T D3 a -> CodeGenFunction r (T a) forall n a r. (Positive n, PseudoRing a) => T n a -> T n a -> CodeGenFunction r (T a) MultiVector.dotProduct T D3 a ki T D3 a si T D3 a sv <- Vector D3 (T a) -> CodeGenFunction r (T D3 a) forall n a r. (Positive n, C a) => Vector n (T a) -> CodeGenFunction r (T n a) MultiVector.assembleFromVector (Vector D3 (T a) -> CodeGenFunction r (T D3 a)) -> Vector D3 (T a) -> CodeGenFunction r (T D3 a) forall a b. (a -> b) -> a -> b $ T a -> T a -> T a -> Vector D3 (T a) forall f n u. (ConsVector f, ResultSize f ~ n, NumberOfArguments f ~ u, u ~ ToUnary n, FromUnary u ~ n, Natural n) => f LLVM.consVector T a yr T a yi T a forall a. Undefined a => a Tuple.undef (T (T a), T D3 a) -> CodeGenFunction r (T (T a), T D3 a) forall a. a -> CodeGenFunction r a forall (m :: * -> *) a. Monad m => a -> m a return (T a -> T a -> T (T a) forall a. a -> a -> T a Stereo.cons T a yr T a yi, T D3 a sv) causal :: (Marshal.Vector n a, n ~ D3, MultiVector.PseudoRing a) => Causal.T (ParameterMV a, Stereo.T (MultiValue.T a)) (Stereo.T (MultiValue.T a)) causal :: forall n a. (Vector n a, n ~ D3, PseudoRing a) => T (ParameterMV a, T (T a)) (T (T a)) causal = (forall r. (ParameterMV a, T (T a)) -> State a -> CodeGenFunction r (T (T a), State a)) -> (forall r. CodeGenFunction r (State a)) -> T (ParameterMV a, T (T a)) (T (T a)) forall state a b. C state => (forall r. a -> state -> CodeGenFunction r (b, state)) -> (forall r. CodeGenFunction r state) -> T a b Causal.mapAccum (ParameterMV a, T (T a)) -> State a -> CodeGenFunction r (T (T a), State a) forall r. (ParameterMV a, T (T a)) -> State a -> CodeGenFunction r (T (T a), State a) forall a r. PseudoRing a => (ParameterMV a, T (T a)) -> State a -> CodeGenFunction r (T (T a), State a) next (State a -> CodeGenFunction r (State a) forall a. a -> CodeGenFunction r a forall (m :: * -> *) a. Monad m => a -> m a return State a forall a. Additive a => a A.zero)