{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
module Synthesizer.LLVM.Filter.Chebyshev (
   parameterA, parameterB, Cascade.ParameterValue,
   Cascade.causalP, Cascade.causalPackedP,
   Cascade.fixSize,
   ) where

import qualified Synthesizer.LLVM.Filter.SecondOrderCascade as Cascade

import qualified Synthesizer.Plain.Filter.Recursive.Chebyshev as Chebyshev
import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2
import Synthesizer.Plain.Filter.Recursive (Passband, )

import qualified Synthesizer.LLVM.Simple.Value as Value
import qualified LLVM.Extra.Representation as Rep
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, ConstValue,
    Struct, IsSized, IsConst, IsFloating,
    CodeGenFunction, )
import Data.Word (Word32, )

import qualified Data.TypeLevel.Num      as TypeNum
import qualified Data.TypeLevel.Num.Sets as TypeSet

import qualified Number.Complex as Complex

import qualified Algebra.Transcendental as Trans
-- import qualified Algebra.Field as Field
-- import qualified Algebra.Module as Module
import qualified Algebra.Ring as Ring

import NumericPrelude.Numeric
import NumericPrelude.Base


constComplexOf :: IsConst a =>
   Complex.T a -> ConstValue (Struct (a, (a, ())))
constComplexOf x =
   LLVM.constStruct
      (LLVM.constOf $ Complex.real x,
        (LLVM.constOf $ Complex.imag x,
          ()))

valueComplex ::
   Value (Struct (a, (a, ()))) -> Complex.T (Value.T a)
valueComplex x =
   Value.Cons (LLVM.extractvalue x TypeNum.d0)
   Complex.+:
   Value.Cons (LLVM.extractvalue x TypeNum.d1)


{- |
'n' must be at least one in order to allow amplification
by the first partial filter.
-}
parameterA, parameterB ::
   (Trans.C a, IsConst a, IsFloating a, IsSized a as,
    TypeSet.Pos n,
    TypeNum.Mul n as sineSize,
    TypeSet.Pos sineSize,
    IsSized (Cascade.Parameter n a) paramSize,
    TypeNum.Mul n LLVM.UnknownSize paramSize, TypeSet.Pos paramSize) =>
   n -> Passband -> Value a -> Value a ->
   CodeGenFunction r (Cascade.ParameterValue n a)
parameterA n kind ratio freq = do
   pv <- parameter Chebyshev.partialParameterA n kind ratio freq

   -- adjust amplification of the first filter
   filt0 <-
      Rep.decompose =<<
      LLVM.extractvalue pv (0::Word32)
   fmap Cascade.ParameterValue $
      flip (LLVM.insertvalue pv) (0::Word32) =<<
         Rep.compose =<<
         Value.flatten
            (Filt2.amplify (Value.constantValue ratio) (Value.unfold filt0))

parameterB n kind ratio freq =
   fmap Cascade.ParameterValue $
   parameter Chebyshev.partialParameterB n kind ratio freq


parameter ::
   (Trans.C a, IsConst a, IsFloating a, IsSized a as,
    TypeSet.Pos n,
    TypeNum.Mul n as sineSize,
    TypeSet.Pos sineSize,
    IsSized (Cascade.Parameter n a) paramSize,
    TypeNum.Mul n LLVM.UnknownSize paramSize, TypeSet.Pos paramSize) =>
   (Int -> Value.T a -> Value.T a ->
    Complex.T (Value.T a) -> Filt2.Parameter (Value.T a)) ->
   n -> Passband -> Value a -> Value a ->
   CodeGenFunction r (Value (Cascade.Parameter n a))
parameter partialParameter n kind ratio freq = do
   let order = 2 * TypeNum.toInt n
   let sines =
          (flip const :: n -> LLVM.Value (LLVM.Array n a)
                           -> LLVM.Value (LLVM.Array n a)) n $
          LLVM.value $
          LLVM.constArray $
          map constComplexOf $
          Chebyshev.makeCirclePoints order
   psine <- LLVM.malloc
   LLVM.store sines psine
   s <- LLVM.getElementPtr0 psine (valueOf (0::Word32), ())
   ps <- LLVM.malloc
   p <- LLVM.getElementPtr0 ps (valueOf (0::Word32), ())
   let len = valueOf $ (fromIntegral $ TypeNum.toInt n :: Word32)
   U.arrayLoop len p s $ \ptri si -> do
      c <- LLVM.load si
      flip Rep.store ptri =<<
         Value.flatten
            (Filt2.adjustPassband kind
               (flip
                  (partialParameter order
                      (Value.constantValue ratio))
                  (valueComplex c))
               (Value.constantValue freq))
      A.advanceArrayElementPtr si

   pv <- LLVM.load ps
   LLVM.free psine
   LLVM.free ps
   return pv