{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
module Synthesizer.LLVM.Filter.Butterworth (
   parameter, Cascade.ParameterValue,
   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.Plain.Filter.Recursive.Butterworth as Butterworth
import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2Core
import Synthesizer.Plain.Filter.Recursive (Passband, )

import qualified Synthesizer.LLVM.Simple.Value as Value

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, constOf,
    IsConst, IsFloating, IsSized, SizeOf,
    CodeGenFunction, )
import Data.Word (Word32, )

import qualified Types.Data.Num as TypeNum
import Types.Data.Num.Ops ((:*:), )

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


parameter, parameterMalloc, _parameterAlloca ::
   (Trans.C a, SoV.TranscendentalConstant a, IsFloating a, IsSized a,
    TypeNum.NaturalT n,
    TypeNum.PositiveT (n :*: SizeOf a),
    IsSized (Cascade.ParameterStruct n a)) =>
   n -> Passband -> Value a -> Value a ->
   CodeGenFunction r (Cascade.ParameterValue n a)
parameter = parameterMalloc

parameterMalloc n kind ratio freq = do
   let order = 2 * TypeNum.fromIntegerT n
   partialRatio <-
      Value.decons (Butterworth.partialRatio order (Value.constantValue ratio))
   let sines =
          (flip const :: n -> LLVM.Value (LLVM.Array n a)
                           -> LLVM.Value (LLVM.Array n a)) n $
          LLVM.value $
          LLVM.constArray $
          map constOf $ Butterworth.makeSines 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 $ (TypeNum.fromIntegerT n :: Word32)
   _ <- U.arrayLoop len p s $ \ptri si -> do
      sinw <- LLVM.load si
      flip LLVM.store ptri =<<
         Filt2.composeParameter =<<
         Value.flatten
            (Filt2Core.adjustPassband kind
               (flip
                  (Butterworth.partialParameter
                      (Value.constantValue partialRatio))
                  (Value.constantValue sinw))
               (Value.constantValue freq))
      A.advanceArrayElementPtr si
   pv <- LLVM.load ps
   LLVM.free psine
   LLVM.free ps
   return (Cascade.ParameterValue pv)

_parameterAlloca n kind ratio freq = do
   let order = 2 * TypeNum.fromIntegerT n
   partialRatio <-
      Value.decons (Butterworth.partialRatio order (Value.constantValue ratio))
   let sines =
          (flip const :: n -> LLVM.Value (LLVM.Array n a)
                           -> LLVM.Value (LLVM.Array n a)) n $
          LLVM.value $
          LLVM.constArray $
          map constOf $ Butterworth.makeSines order
   psine <- LLVM.alloca
   LLVM.store sines psine
   s <- LLVM.getElementPtr0 psine (valueOf (0::Word32), ())
   ps <- LLVM.alloca
   p <- LLVM.getElementPtr0 ps (valueOf (0::Word32), ())
   let len = valueOf $ (TypeNum.fromIntegerT n :: Word32)
   _ <- U.arrayLoop len p s $ \ptri si -> do
      sinw <- LLVM.load si
      flip LLVM.store ptri =<<
         Filt2.composeParameter =<<
         Value.flatten
            (Filt2Core.adjustPassband kind
               (flip
                  (Butterworth.partialParameter
                      (Value.constantValue partialRatio))
                  (Value.constantValue sinw))
               (Value.constantValue freq))
      A.advanceArrayElementPtr si
   fmap Cascade.ParameterValue $ LLVM.load ps