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

import qualified Synthesizer.LLVM.Filter.SecondOrderCascade as Cascade
import qualified Synthesizer.LLVM.Filter.SecondOrder as Filt2
import qualified Synthesizer.LLVM.Causal.ProcessPrivate as Causal
import qualified Synthesizer.LLVM.Simple.SignalPrivate as Sig
import qualified Synthesizer.LLVM.Simple.Value as Value

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

import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Control as U
import qualified LLVM.Extra.Arithmetic as A

import qualified LLVM.Core as LLVM
import LLVM.Core
   (CodeGenFunction, Value, valueOf, constOf,
    IsFloating, IsSized, SizeOf)

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 ::
   (Causal.C process,
    Trans.C a, SoV.TranscendentalConstant a, IsFloating a, IsSized a,
    TypeNum.Natural n,
    TypeNum.Positive (n :*: SizeOf a),
    IsSized (Cascade.ParameterStruct n a)) =>
   Proxy n -> Passband ->
   process (Value a, Value a) (Cascade.ParameterValue n a)
parameterCausal n kind =
   Causal.map
      (\((psine, ps), (ratio, freq)) ->
         parameterCore n kind psine ps ratio freq)
   $<
   Sig.zipWith (curry return) Sig.alloca Sig.alloca

parameter ::
   (Trans.C a, SoV.TranscendentalConstant a, IsFloating a, IsSized a,
    TypeNum.Natural n,
    TypeNum.Positive (n :*: SizeOf a),
    IsSized (Cascade.ParameterStruct n a)) =>
   Proxy n -> Passband -> Value a -> Value a ->
   CodeGenFunction r (Cascade.ParameterValue n a)
parameter n kind ratio freq = do
   psine <- LLVM.malloc
   ps <- LLVM.malloc
   pv <- parameterCore n kind psine ps ratio freq
   LLVM.free ps
   LLVM.free psine
   return pv

parameterCore ::
   (Trans.C a, SoV.TranscendentalConstant a, IsFloating a, IsSized a,
    TypeNum.Natural n,
    TypeNum.Positive (n :*: SizeOf a),
    IsSized (Cascade.ParameterStruct n a)) =>
   Proxy n -> Passband ->
   Value (LLVM.Ptr (LLVM.Array n a)) ->
   Value (LLVM.Ptr (Cascade.ParameterStruct n a)) ->
   Value a -> Value a ->
   CodeGenFunction r (Cascade.ParameterValue n a)
parameterCore n kind psine ps ratio freq = do
   let order = 2 * TypeNum.integralFromProxy n
   partialRatio <- Value.unlift1 (Butterworth.partialRatio order) ratio
   let sines =
          Cascade.constArray n $
          map constOf $ Butterworth.makeSines order
   LLVM.store sines psine
   s <- LLVM.getElementPtr0 psine (valueOf (0::Word), ())
   p <- LLVM.getElementPtr0 ps (valueOf (0::Word), ())
   let len = valueOf $ (TypeNum.integralFromProxy n :: Word)
   _ <- U.arrayLoop len p s $ \ptri si -> do
      sinw <- LLVM.load si
      flip LLVM.store ptri =<<
         Filt2.composeParameter =<<
         Value.unlift3 (Butterworth.partialParameter kind) partialRatio sinw freq
      A.advanceArrayElementPtr si
   fmap Cascade.ParameterValue $ LLVM.load ps