{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
module Synthesizer.LLVM.Filter.Chebyshev (
   parameterCausalA, parameterCausalB,
   parameterA, parameterB, 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.Chebyshev as Chebyshev
import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2Core
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
   (Value, valueOf, IsSized, SizeOf, IsFloating, CodeGenFunction, )
import Data.Word (Word32, )

import Foreign.Ptr (Ptr, )

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

import qualified Synthesizer.LLVM.Complex as ComplexL

import qualified Number.Complex as Complex

import qualified Algebra.Transcendental as Trans

import NumericPrelude.Numeric
import NumericPrelude.Base


{- |
@n@ must be at least one in order to allow amplification
by the first partial filter.
The causal processes should be more efficient
than 'parameterA' and 'parameterB'
because they use stack-based @alloca@ instead of @malloc@.
-}
parameterCausalA, parameterCausalB ::
   (Causal.C process,
    Trans.C a, SoV.TranscendentalConstant a, IsFloating a, IsSized a,
    TypeNum.Positive n, TypeNum.Natural n,
    TypeNum.Positive (n :*: SizeOf a),
    IsSized (Cascade.ParameterStruct n a), SizeOf (Cascade.ParameterStruct n a) ~ paramSize,
    (n :*: LLVM.UnknownSize) ~ paramSize, TypeNum.Positive paramSize) =>
   Proxy n -> Passband ->
   process (Value a, Value a) (Cascade.ParameterValue n a)
parameterCausalA n kind =
   Causal.map
      (\((psine, ps), (ratio, freq)) ->
         fmap Cascade.ParameterValue $
         adjustAmplitude ratio =<<
         parameter Chebyshev.partialParameterA n kind psine ps ratio freq)
   $<
   allocaArrays

parameterCausalB n kind =
   Causal.map
      (\((psine, ps), (ratio, freq)) ->
         fmap Cascade.ParameterValue $
         parameter Chebyshev.partialParameterB n kind psine ps ratio freq)
   $<
   allocaArrays

allocaArrays ::
   (Sig.C signal, IsSized a, IsSized b) => signal (Value (Ptr a), Value (Ptr b))
allocaArrays = Sig.zipWith (curry return) Sig.alloca Sig.alloca

parameterA, parameterB ::
   (Trans.C a, SoV.TranscendentalConstant a, IsFloating a, IsSized a,
    TypeNum.Positive n, TypeNum.Natural n,
    TypeNum.Positive (n :*: SizeOf a),
    IsSized (Cascade.ParameterStruct n a), SizeOf (Cascade.ParameterStruct n a) ~ paramSize,
    (n :*: LLVM.UnknownSize) ~ paramSize, TypeNum.Positive paramSize) =>
   Proxy n -> Passband -> Value a -> Value a ->
   CodeGenFunction r (Cascade.ParameterValue n a)
parameterA n kind ratio freq =
   withArrays $ \psine ps ->
      fmap Cascade.ParameterValue $
      adjustAmplitude ratio =<<
      parameter Chebyshev.partialParameterA n kind psine ps ratio freq

parameterB n kind ratio freq =
   withArrays $ \psine ps ->
      fmap Cascade.ParameterValue $
      parameter Chebyshev.partialParameterB n kind psine ps ratio freq

withArrays ::
   (LLVM.IsSized a, LLVM.IsSized b) =>
   (Value (Ptr a) -> Value (Ptr b) -> CodeGenFunction r c) ->
   CodeGenFunction r c
withArrays act = do
   psine <- LLVM.malloc
   ps <- LLVM.malloc
   x <- act psine ps
   LLVM.free psine
   LLVM.free ps
   return x


-- | adjust amplification of the first filter
adjustAmplitude ::
   (LLVM.IsArithmetic a, IsSized a, SoV.IntegerConstant a,
    Filt2.ParameterStruct a ~ filt2, TypeNum.Natural n) =>
   Value a -> Value (LLVM.Array n filt2) ->
   CodeGenFunction r (Value (LLVM.Array n filt2))
adjustAmplitude ratio pv = do
   filt0 <-
      Filt2.decomposeParameter =<<
      LLVM.extractvalue pv (0::Word32)
   flip (LLVM.insertvalue pv) (0::Word32) =<<
      Filt2.composeParameter =<<
      Value.flatten
         (Filt2Core.amplify (Value.constantValue ratio) (Value.unfold filt0))


parameter ::
   (Trans.C a, SoV.RationalConstant a, IsFloating a, IsSized a,
    Value.T (Value a) ~ av,
    TypeNum.Positive n, TypeNum.Natural n,
    TypeNum.Positive (n :*: SizeOf a),
    IsSized (Cascade.ParameterStruct n a), SizeOf (Cascade.ParameterStruct n a) ~ paramSize,
    (n :*: LLVM.UnknownSize) ~ paramSize, TypeNum.Positive paramSize) =>
   (Passband -> Int -> av -> Complex.T av -> av -> Filt2Core.Parameter av) ->
   Proxy n -> Passband ->
   Value (Ptr (LLVM.Array n (ComplexL.Struct a))) ->
   Value (Ptr (Cascade.ParameterStruct n a)) ->
   Value a -> Value a ->
   CodeGenFunction r (Value (Cascade.ParameterStruct n a))
parameter partialParameter n kind psine ps ratio freq = do
   let order = TypeNum.integralFromProxy n
   let sines =
          Cascade.constArray n $
          map ComplexL.constOf $
          Chebyshev.makeCirclePoints order
   LLVM.store sines psine
   s <- LLVM.getElementPtr0 psine (valueOf (0::Word32), ())
   p <- LLVM.getElementPtr0 ps (valueOf (0::Word32), ())
   let len = valueOf $ (TypeNum.integralFromProxy n :: Word32)
   _ <- U.arrayLoop len p s $ \ptri si -> do
      c <- LLVM.load si
      flip LLVM.store ptri =<<
         Filt2.composeParameter =<<
         Value.flatten
            (partialParameter kind order
               (Value.constantValue ratio)
               (ComplexL.unfold c)
               (Value.constantValue freq))
      A.advanceArrayElementPtr si

   LLVM.load ps