{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Synthesizer.LLVM.Filter.Universal (
   Result(Result, lowpass, highpass, bandpass, bandlimit),
   Parameter, parameter, causalP,
   ) where

import qualified Synthesizer.Plain.Filter.Recursive.Universal as Universal
import Synthesizer.Plain.Filter.Recursive.Universal
          (Parameter(Parameter), Result, )
import Synthesizer.Plain.Filter.Recursive (Pole(..))

import qualified Synthesizer.Plain.Modifier as Modifier

import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
import qualified Synthesizer.LLVM.Simple.Value as Value

import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Class as Class
import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Vector as Vector
import LLVM.Extra.Class (Undefined, undefTuple, )

import LLVM.Core
   (Value, Struct, IsFloating, IsSized, CodeGenFunction, )
import LLVM.Util.Loop (Phi, phis, addPhis, )

import Data.TypeLevel.Num (d0, d1, d2, d3, d4, d5, )

import Synthesizer.ApplicativeUtility (liftA6, )

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


instance (Phi a) => Phi (Parameter a) where
   phis = Class.phisTraversable
   addPhis = Class.addPhisFoldable

instance Undefined a => Undefined (Parameter a) where
   undefTuple = Class.undefTuplePointed

parameterMemory ::
   (Memory.C a s, IsSized s ss) =>
   Memory.Record r (Struct (s, (s, (s, (s, (s, (s, ()))))))) (Parameter a)
parameterMemory =
   liftA6 Parameter
      (Memory.element Universal.k1       d0)
      (Memory.element Universal.k2       d1)
      (Memory.element Universal.ampIn    d2)
      (Memory.element Universal.ampI1    d3)
      (Memory.element Universal.ampI2    d4)
      (Memory.element Universal.ampLimit d5)


instance
      (Memory.C a s, IsSized s ss) =>
      Memory.C (Parameter a) (Struct (s, (s, (s, (s, (s, (s, ()))))))) where
   load = Memory.loadRecord parameterMemory
   store = Memory.storeRecord parameterMemory
   decompose = Memory.decomposeRecord parameterMemory
   compose = Memory.composeRecord parameterMemory

{-
instance LLVM.ValueTuple a => LLVM.ValueTuple (Result a) where
   buildTuple f = Class.buildTupleTraversable (LLVM.buildTuple f)

instance LLVM.IsTuple a => LLVM.IsTuple (Result a) where
   tupleDesc = Class.tupleDescFoldable
-}

instance (Class.MakeValueTuple ah al) =>
      Class.MakeValueTuple (Result ah) (Result al) where
   valueTupleOf = Class.valueTupleOfFunctor

instance (Value.Flatten ah al) =>
      Value.Flatten (Result ah) (Result al) where
   flatten = Value.flattenTraversable
   unfold =  Value.unfoldFunctor


{-
instance LLVM.ValueTuple a => LLVM.ValueTuple (Parameter a) where
   buildTuple f = Class.buildTupleTraversable (LLVM.buildTuple f)

instance LLVM.IsTuple a => LLVM.IsTuple (Parameter a) where
   tupleDesc = Class.tupleDescFoldable
-}

instance (Class.MakeValueTuple ah al) =>
      Class.MakeValueTuple (Parameter ah) (Parameter al) where
   valueTupleOf = Class.valueTupleOfFunctor

instance (Value.Flatten ah al) =>
      Value.Flatten (Parameter ah) (Parameter al) where
   flatten = Value.flattenTraversable
   unfold =  Value.unfoldFunctor


instance (Vector.ShuffleMatch d v) =>
      Vector.ShuffleMatch d (Parameter v) where
   shuffleMatch = Vector.shuffleMatchTraversable

instance (Vector.Access d a v) =>
      Vector.Access d (Parameter a) (Parameter v) where
   insert  = Vector.insertTraversable
   extract = Vector.extractTraversable


instance (Phi a) => Phi (Result a) where
   phis = Class.phisTraversable
   addPhis = Class.addPhisFoldable

instance Undefined a => Undefined (Result a) where
   undefTuple = Class.undefTuplePointed

instance (Vector.ShuffleMatch d v) =>
      Vector.ShuffleMatch d (Result v) where
   shuffleMatch = Vector.shuffleMatchTraversable

instance (Vector.Access d a v) =>
      Vector.Access d (Result a) (Result v) where
   insert  = Vector.insertTraversable
   extract = Vector.extractTraversable


parameter ::
   (Trans.C a, SoV.RationalConstant a, IsFloating a) =>
   Value a -> Value a ->
   CodeGenFunction r (Parameter (Value a))
parameter reson freq =
   Value.flatten $
   Universal.parameter
      (Pole (Value.constantValue reson) (Value.constantValue freq))
--      (Pole (Value.unfold reson) (Value.unfold freq))


modifier ::
   (SoV.PseudoModule a v, SoV.IntegerConstant a) =>
   Modifier.Simple
      (Universal.State (Value.T v))
      (Parameter (Value.T a))
      (Value.T v) (Result (Value.T v))
modifier =
   Universal.modifier

causalP ::
   (SoV.PseudoModule a v, SoV.IntegerConstant a,
    Memory.FirstClass a am, IsSized a as, IsSized am ams,
    Memory.FirstClass v vm, IsSized v vs, IsSized vm vms) =>
   CausalP.T p
      (Parameter (Value a), Value v) (Result (Value v))
causalP =
   CausalP.fromModifier modifier

{-
The state variable filter could be vectorised
by writing the integrator network as matrix recursion
and applying the doubling trick to that recursion.
However the initially sparse matrix with several 1s in it
has dense power matrices with no nice structure.
This will only payoff for large vectors.

We could write another version,
that expresses the state variable filter in terms of the general second order filter.
The general second order filter is already vectorized.
-}