{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
module Synthesizer.LLVM.Filter.Butterworth (
   parameter, parameterCausal, Cascade.ParameterValue,
   Cascade.causal, Cascade.causalPacked,
   Cascade.fixSize,
   ) where

import qualified Synthesizer.LLVM.Filter.SecondOrderCascade as Cascade
import qualified Synthesizer.LLVM.Filter.SecondOrder as Filt2
import qualified Synthesizer.LLVM.Causal.Private as Causal
import qualified Synthesizer.LLVM.Generator.Private as Sig

import qualified Synthesizer.Plain.Filter.Recursive.Butterworth as Butterworth
import Synthesizer.Plain.Filter.Recursive (Passband)
import Synthesizer.Causal.Class (($<))

import qualified LLVM.DSL.Expression as Expr

import qualified LLVM.Extra.Multi.Value.Marshal as Marshal
import qualified LLVM.Extra.Multi.Value as MultiValue
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Extra.Control as U

import qualified LLVM.Core as LLVM

import Data.Word (Word)


import qualified Type.Data.Num.Decimal as TypeNum
import Type.Data.Num.Decimal.Number ((:*:))
import Type.Base.Proxy (Proxy)

import qualified Algebra.Transcendental as Trans

import NumericPrelude.Numeric
import NumericPrelude.Base



parameterCausal ::
   (TypeNum.Positive (n :*: LLVM.SizeOf (Marshal.Struct a)),
    TypeNum.Natural (n :*: LLVM.UnknownSize),
    TypeNum.Natural n, Trans.C a,
    Marshal.C a, MultiValue.RationalConstant a, MultiValue.Transcendental a) =>
   Proxy n -> Passband ->
   Causal.T (MultiValue.T a, MultiValue.T a) (Cascade.ParameterValue n a)
parameterCausal :: forall n a.
(Positive (n :*: SizeOf (Struct a)), Natural (n :*: UnknownSize),
 Natural n, C a, C a, RationalConstant a, Transcendental a) =>
Proxy n -> Passband -> T (T a, T a) (ParameterValue n a)
parameterCausal Proxy n
n Passband
kind =
   (forall r.
 ((Value (Ptr (Array n (Struct a))),
   Value (Ptr (Array n (ParameterStruct (Struct a))))),
  (T a, T a))
 -> CodeGenFunction r (ParameterValue n a))
-> T ((Value (Ptr (Array n (Struct a))),
       Value (Ptr (Array n (ParameterStruct (Struct a))))),
      (T a, T a))
     (ParameterValue n a)
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
Causal.map
      (\((Value (Ptr (Array n (Struct a)))
psine, Value (Ptr (Array n (ParameterStruct (Struct a))))
ps), (T a
ratio, T a
freq)) ->
         Proxy n
-> Passband
-> Value (Ptr (Struct (Array n a)))
-> Value (Ptr (ParameterStruct n a))
-> T a
-> T a
-> CodeGenFunction r (ParameterValue n a)
forall n a r.
(Positive (n :*: SizeOf (Struct a)), Natural (n :*: UnknownSize),
 Natural n, C a, C a, RationalConstant a, Transcendental a) =>
Proxy n
-> Passband
-> Value (Ptr (Struct (Array n a)))
-> Value (Ptr (ParameterStruct n a))
-> T a
-> T a
-> CodeGenFunction r (ParameterValue n a)
parameterCore Proxy n
n Passband
kind Value (Ptr (Struct (Array n a)))
Value (Ptr (Array n (Struct a)))
psine Value (Ptr (ParameterStruct n a))
Value (Ptr (Array n (ParameterStruct (Struct a))))
ps T a
ratio T a
freq)
   T ((Value (Ptr (Array n (Struct a))),
    Value (Ptr (Array n (ParameterStruct (Struct a))))),
   (T a, T a))
  (ParameterValue n a)
-> SignalOf
     T
     (Value (Ptr (Array n (Struct a))),
      Value (Ptr (Array n (ParameterStruct (Struct a)))))
-> T (T a, T a) (ParameterValue n a)
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process a -> process b c
$<
   (forall r.
 Value (Ptr (Array n (Struct a)))
 -> Value (Ptr (Array n (ParameterStruct (Struct a))))
 -> CodeGenFunction
      r
      (Value (Ptr (Array n (Struct a))),
       Value (Ptr (Array n (ParameterStruct (Struct a))))))
-> T (Value (Ptr (Array n (Struct a))))
-> T (Value (Ptr (Array n (ParameterStruct (Struct a)))))
-> T (Value (Ptr (Array n (Struct a))),
      Value (Ptr (Array n (ParameterStruct (Struct a)))))
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T a -> T b -> T c
Sig.zipWith (((Value (Ptr (Array n (Struct a))),
  Value (Ptr (Array n (ParameterStruct (Struct a)))))
 -> CodeGenFunction
      r
      (Value (Ptr (Array n (Struct a))),
       Value (Ptr (Array n (ParameterStruct (Struct a))))))
-> Value (Ptr (Array n (Struct a)))
-> Value (Ptr (Array n (ParameterStruct (Struct a))))
-> CodeGenFunction
     r
     (Value (Ptr (Array n (Struct a))),
      Value (Ptr (Array n (ParameterStruct (Struct a)))))
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Value (Ptr (Array n (Struct a))),
 Value (Ptr (Array n (ParameterStruct (Struct a)))))
-> CodeGenFunction
     r
     (Value (Ptr (Array n (Struct a))),
      Value (Ptr (Array n (ParameterStruct (Struct a)))))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return) T (Value (Ptr (Array n (Struct a))))
forall a. IsSized a => T (Value (Ptr a))
Sig.alloca T (Value (Ptr (Array n (ParameterStruct (Struct a)))))
forall a. IsSized a => T (Value (Ptr a))
Sig.alloca

parameter ::
   (TypeNum.Positive (n :*: LLVM.SizeOf (Marshal.Struct a)),
    TypeNum.Natural (n :*: LLVM.UnknownSize),
    TypeNum.Natural n, Trans.C a,
    Marshal.C a, MultiValue.RationalConstant a, MultiValue.Transcendental a) =>
   Proxy n -> Passband -> MultiValue.T a -> MultiValue.T a ->
   LLVM.CodeGenFunction r (Cascade.ParameterValue n a)
parameter :: forall n a r.
(Positive (n :*: SizeOf (Struct a)), Natural (n :*: UnknownSize),
 Natural n, C a, C a, RationalConstant a, Transcendental a) =>
Proxy n
-> Passband -> T a -> T a -> CodeGenFunction r (ParameterValue n a)
parameter Proxy n
n Passband
kind T a
ratio T a
freq = do
   Value (Ptr (Array n (Struct a)))
psine <- CodeGenFunction r (Value (Ptr (Array n (Struct a))))
forall a r. IsSized a => CodeGenFunction r (Value (Ptr a))
LLVM.malloc
   Value (Ptr (Array n (ParameterStruct (Struct a))))
ps <- CodeGenFunction
  r (Value (Ptr (Array n (ParameterStruct (Struct a)))))
forall a r. IsSized a => CodeGenFunction r (Value (Ptr a))
LLVM.malloc
   ParameterValue n a
pv <- Proxy n
-> Passband
-> Value (Ptr (Struct (Array n a)))
-> Value (Ptr (ParameterStruct n a))
-> T a
-> T a
-> CodeGenFunction r (ParameterValue n a)
forall n a r.
(Positive (n :*: SizeOf (Struct a)), Natural (n :*: UnknownSize),
 Natural n, C a, C a, RationalConstant a, Transcendental a) =>
Proxy n
-> Passband
-> Value (Ptr (Struct (Array n a)))
-> Value (Ptr (ParameterStruct n a))
-> T a
-> T a
-> CodeGenFunction r (ParameterValue n a)
parameterCore Proxy n
n Passband
kind Value (Ptr (Struct (Array n a)))
Value (Ptr (Array n (Struct a)))
psine Value (Ptr (ParameterStruct n a))
Value (Ptr (Array n (ParameterStruct (Struct a))))
ps T a
ratio T a
freq
   Value (Ptr (Array n (ParameterStruct (Struct a))))
-> CodeGenFunction r ()
forall a r. IsType a => Value (Ptr a) -> CodeGenFunction r ()
LLVM.free Value (Ptr (Array n (ParameterStruct (Struct a))))
ps
   Value (Ptr (Array n (Struct a))) -> CodeGenFunction r ()
forall a r. IsType a => Value (Ptr a) -> CodeGenFunction r ()
LLVM.free Value (Ptr (Array n (Struct a)))
psine
   ParameterValue n a -> CodeGenFunction r (ParameterValue n a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return ParameterValue n a
pv

parameterCore ::
   (TypeNum.Positive (n :*: LLVM.SizeOf (Marshal.Struct a)),
    TypeNum.Natural (n :*: LLVM.UnknownSize),
    TypeNum.Natural n, Trans.C a,
    Marshal.C a, MultiValue.RationalConstant a, MultiValue.Transcendental a) =>
   Proxy n -> Passband ->
   LLVM.Value (LLVM.Ptr (Marshal.Struct (MultiValue.Array n a))) ->
   LLVM.Value (LLVM.Ptr (Cascade.ParameterStruct n a)) ->
   MultiValue.T a -> MultiValue.T a ->
   LLVM.CodeGenFunction r (Cascade.ParameterValue n a)
parameterCore :: forall n a r.
(Positive (n :*: SizeOf (Struct a)), Natural (n :*: UnknownSize),
 Natural n, C a, C a, RationalConstant a, Transcendental a) =>
Proxy n
-> Passband
-> Value (Ptr (Struct (Array n a)))
-> Value (Ptr (ParameterStruct n a))
-> T a
-> T a
-> CodeGenFunction r (ParameterValue n a)
parameterCore Proxy n
n Passband
kind Value (Ptr (Struct (Repr (Array n a))))
psine Value (Ptr (Struct (Repr (Parameter n a))))
ps T a
ratio T a
freq = do
   let order :: Int
order = Int
2 Int -> Int -> Int
forall a. C a => a -> a -> a
* Proxy n -> Int
forall n a. (Integer n, Num a) => Proxy n -> a
TypeNum.integralFromProxy Proxy n
n
   T a
partialRatio <- (Exp a -> Exp a) -> T a -> CodeGenFunction r (T a)
forall ae am be bm r.
(Aggregate ae am, Aggregate be bm) =>
(ae -> be) -> am -> CodeGenFunction r bm
Expr.unliftM1 (Int -> Exp a -> Exp a
forall a. C a => Int -> a -> a
Butterworth.partialRatio Int
order) T a
ratio
   let evalSines :: (Trans.C a) => mv a -> Int -> [a]
       evalSines :: forall a (mv :: * -> *). C a => mv a -> Int -> [a]
evalSines mv a
_ = Int -> [a]
forall a. C a => Int -> [a]
Butterworth.makeSines
   let sines :: T (Array n a)
sines = Proxy n -> [a] -> T (Array n a)
forall n a. (Natural n, C a) => Proxy n -> [a] -> T (Array n a)
Cascade.constArray Proxy n
n ([a] -> T (Array n a)) -> [a] -> T (Array n a)
forall a b. (a -> b) -> a -> b
$ T a -> Int -> [a]
forall a (mv :: * -> *). C a => mv a -> Int -> [a]
evalSines T a
freq Int
order
   T (Array n a)
-> Value (Ptr (Struct (T (Array n a)))) -> CodeGenFunction r ()
forall r.
T (Array n a)
-> Value (Ptr (Struct (T (Array n a)))) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store T (Array n a)
sines Value (Ptr (Struct (Repr (Array n a))))
Value (Ptr (Struct (T (Array n a))))
psine
   Value (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))
s <- Value (Ptr (Array n (Struct a)))
-> (Value Word, ())
-> CodeGenFunction
     r
     (Value
        (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ()))))
forall o i r.
GetElementPtr o i =>
Value (Ptr o)
-> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr0 Value (Ptr (Struct (Repr (Array n a))))
Value (Ptr (Array n (Struct a)))
psine (Word -> Value Word
forall a. IsConst a => a -> Value a
LLVM.valueOf (Word
0::Word), ())
   Value
  (Ptr
     (ElementPtrType
        (Array n (ParameterStruct (Struct a))) (Value Word, ())))
p <- Value (Ptr (Array n (ParameterStruct (Struct a))))
-> (Value Word, ())
-> CodeGenFunction
     r
     (Value
        (Ptr
           (ElementPtrType
              (Array n (ParameterStruct (Struct a))) (Value Word, ()))))
forall o i r.
GetElementPtr o i =>
Value (Ptr o)
-> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr0 Value (Ptr (Struct (Repr (Parameter n a))))
Value (Ptr (Array n (ParameterStruct (Struct a))))
ps (Word -> Value Word
forall a. IsConst a => a -> Value a
LLVM.valueOf (Word
0::Word), ())
   let len :: Value Word
len = Word -> Value Word
forall a. IsConst a => a -> Value a
LLVM.valueOf (Proxy n -> Word
forall n a. (Integer n, Num a) => Proxy n -> a
TypeNum.integralFromProxy Proxy n
n :: Word)
   Value (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))
_ <- Value Word
-> Value
     (Ptr
        (ElementPtrType
           (Array n (ParameterStruct (Struct a))) (Value Word, ())))
-> Value
     (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))
-> (Value
      (Ptr
         (ElementPtrType
            (Array n (ParameterStruct (Struct a))) (Value Word, ())))
    -> Value
         (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))
    -> CodeGenFunction
         r
         (Value
            (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))))
-> CodeGenFunction
     r
     (Value
        (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ()))))
forall a b i r.
(Phi a, IsType b, Num i, IsConst i, IsInteger i, CmpRet i,
 IsPrimitive i) =>
Value i
-> Value (Ptr b)
-> a
-> (Value (Ptr b) -> a -> CodeGenFunction r a)
-> CodeGenFunction r a
U.arrayLoop Value Word
len Value
  (Ptr
     (ElementPtrType
        (Array n (ParameterStruct (Struct a))) (Value Word, ())))
p Value (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))
s ((Value
    (Ptr
       (ElementPtrType
          (Array n (ParameterStruct (Struct a))) (Value Word, ())))
  -> Value
       (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))
  -> CodeGenFunction
       r
       (Value
          (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))))
 -> CodeGenFunction
      r
      (Value
         (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))))
-> (Value
      (Ptr
         (ElementPtrType
            (Array n (ParameterStruct (Struct a))) (Value Word, ())))
    -> Value
         (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))
    -> CodeGenFunction
         r
         (Value
            (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))))
-> CodeGenFunction
     r
     (Value
        (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ()))))
forall a b. (a -> b) -> a -> b
$ \Value
  (Ptr
     (ElementPtrType
        (Array n (ParameterStruct (Struct a))) (Value Word, ())))
ptri Value (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))
si -> do
      T a
sinw <- Value (Ptr (Struct (T a))) -> CodeGenFunction r (T a)
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r. Value (Ptr (Struct (T a))) -> CodeGenFunction r (T a)
Memory.load Value (Ptr (Struct (T a)))
Value (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))
si
      (Value (ParameterStruct (Struct a))
 -> Value
      (Ptr
         (ElementPtrType
            (Array n (ParameterStruct (Struct a))) (Value Word, ())))
 -> CodeGenFunction r ())
-> Value
     (Ptr
        (ElementPtrType
           (Array n (ParameterStruct (Struct a))) (Value Word, ())))
-> Value (ParameterStruct (Struct a))
-> CodeGenFunction r ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Value (ParameterStruct (Struct a))
-> Value (Ptr (Struct (Value (ParameterStruct (Struct a)))))
-> CodeGenFunction r ()
Value (ParameterStruct (Struct a))
-> Value
     (Ptr
        (ElementPtrType
           (Array n (ParameterStruct (Struct a))) (Value Word, ())))
-> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
forall r.
Value (ParameterStruct (Struct a))
-> Value (Ptr (Struct (Value (ParameterStruct (Struct a)))))
-> CodeGenFunction r ()
Memory.store Value
  (Ptr
     (ElementPtrType
        (Array n (ParameterStruct (Struct a))) (Value Word, ())))
ptri (Value (ParameterStruct (Struct a)) -> CodeGenFunction r ())
-> CodeGenFunction r (Value (ParameterStruct (Struct a)))
-> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
         Parameter (T a) -> CodeGenFunction r (Value (Struct (Parameter a)))
Parameter (T a)
-> CodeGenFunction r (Value (ParameterStruct (Struct a)))
forall a r.
C a =>
Parameter (T a) -> CodeGenFunction r (Value (Struct (Parameter a)))
Filt2.composeParameterMV (Parameter (T a)
 -> CodeGenFunction r (Value (ParameterStruct (Struct a))))
-> CodeGenFunction r (Parameter (T a))
-> CodeGenFunction r (Value (ParameterStruct (Struct a)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
         (Exp a -> Exp a -> Exp a -> Parameter (Exp a))
-> T a -> T a -> T a -> CodeGenFunction r (Parameter (T a))
forall ae am be bm ce cm de dm r.
(Aggregate ae am, Aggregate be bm, Aggregate ce cm,
 Aggregate de dm) =>
(ae -> be -> ce -> de) -> am -> bm -> cm -> CodeGenFunction r dm
Expr.unliftM3 (Passband -> Exp a -> Exp a -> Exp a -> Parameter (Exp a)
forall a. C a => Passband -> a -> a -> a -> Parameter a
Butterworth.partialParameter Passband
kind)
            T a
partialRatio T a
sinw T a
freq
      Value (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))
-> CodeGenFunction
     r
     (Value
        (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ()))))
forall a r. Value (Ptr a) -> CodeGenFunction r (Value (Ptr a))
A.advanceArrayElementPtr Value (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))
si
   (T (Parameter n a) -> ParameterValue n a)
-> CodeGenFunction r (T (Parameter n a))
-> CodeGenFunction r (ParameterValue n a)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T (Parameter n a) -> ParameterValue n a
forall n a. T (Parameter n a) -> ParameterValue n a
Cascade.ParameterValue (CodeGenFunction r (T (Parameter n a))
 -> CodeGenFunction r (ParameterValue n a))
-> CodeGenFunction r (T (Parameter n a))
-> CodeGenFunction r (ParameterValue n a)
forall a b. (a -> b) -> a -> b
$ Value (Ptr (Struct (T (Parameter n a))))
-> CodeGenFunction r (T (Parameter n a))
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r.
Value (Ptr (Struct (T (Parameter n a))))
-> CodeGenFunction r (T (Parameter n a))
Memory.load Value (Ptr (Struct (Repr (Parameter n a))))
Value (Ptr (Struct (T (Parameter n a))))
ps