{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Synthesizer.LLVM.Filter.Universal (
   Result(Result, lowpass, highpass, bandpass, bandlimit),
   Parameter, parameter, causal, 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.Causal.Process as Causal
import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
import qualified Synthesizer.LLVM.Simple.Value as Value

import qualified LLVM.Extra.Storable as Storable
import qualified LLVM.Extra.Marshal as Marshal
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Extra.Vector as Vector
import qualified LLVM.Extra.Arithmetic as A

import qualified LLVM.Core as LLVM
import LLVM.Core (CodeGenFunction)

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

import qualified Control.Applicative.HT as App
import Control.Applicative ((<$>))


instance (Tuple.Phi a) => Tuple.Phi (Parameter a) where
   phi = Tuple.phiTraversable
   addPhi = Tuple.addPhiFoldable

instance Tuple.Undefined a => Tuple.Undefined (Parameter a) where
   undef = Tuple.undefPointed


type ParameterStruct a = LLVM.Struct (a, (a, (a, (a, (a, (a, ()))))))

parameterMemory ::
   (Memory.C a) =>
   Memory.Record r (ParameterStruct (Memory.Struct a)) (Parameter a)
parameterMemory =
   App.lift6 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) => Memory.C (Parameter a) where
   type Struct (Parameter a) = ParameterStruct (Memory.Struct a)
   load = Memory.loadRecord parameterMemory
   store = Memory.storeRecord parameterMemory
   decompose = Memory.decomposeRecord parameterMemory
   compose = Memory.composeRecord parameterMemory

instance (Marshal.C a) => Marshal.C (Parameter a) where
   pack p =
      case Marshal.pack <$> p of
         Parameter k1 k2 ampIn ampI1 ampI2 ampLimit ->
            LLVM.consStruct k1 k2 ampIn ampI1 ampI2 ampLimit
   unpack = fmap Marshal.unpack . LLVM.uncurryStruct Parameter

instance (Storable.C a) => Storable.C (Parameter a) where
   load = Storable.loadApplicative
   store = Storable.storeFoldable

{-
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 (Tuple.Value a) => Tuple.Value (Result a) where
   type ValueOf (Result a) = Result (Tuple.ValueOf a)
   valueOf = Tuple.valueOfFunctor

instance (Value.Flatten a) => Value.Flatten (Result a) where
   type Registers (Result a) = Result (Value.Registers a)
   flattenCode = Value.flattenCodeTraversable
   unfoldCode = Value.unfoldCodeTraversable


{-
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 (Tuple.Value a) => Tuple.Value (Parameter a) where
   type ValueOf (Parameter a) = Parameter (Tuple.ValueOf a)
   valueOf = Tuple.valueOfFunctor

instance (Value.Flatten a) => Value.Flatten (Parameter a) where
   type Registers (Parameter a) = Parameter (Value.Registers a)
   flattenCode = Value.flattenCodeTraversable
   unfoldCode = Value.unfoldCodeTraversable


instance (Vector.Simple v) => Vector.Simple (Parameter v) where
   type Element (Parameter v) = Parameter (Vector.Element v)
   type Size (Parameter v) = Vector.Size v
   shuffleMatch = Vector.shuffleMatchTraversable
   extract = Vector.extractTraversable

instance (Vector.C v) => Vector.C (Parameter v) where
   insert = Vector.insertTraversable


instance (Tuple.Phi a) => Tuple.Phi (Result a) where
   phi = Tuple.phiTraversable
   addPhi = Tuple.addPhiFoldable

instance Tuple.Undefined a => Tuple.Undefined (Result a) where
   undef = Tuple.undefPointed

instance (Vector.Simple v) => Vector.Simple (Result v) where
   type Element (Result v) = Result (Vector.Element v)
   type Size (Result v) = Vector.Size v
   shuffleMatch = Vector.shuffleMatchTraversable
   extract = Vector.extractTraversable

instance (Vector.C v) => Vector.C (Result v) where
   insert  = Vector.insertTraversable

instance (Serial.Sized v) => Serial.Sized (Result v) where
   type Size (Result v) = Serial.Size v

instance (Serial.Read v) => Serial.Read (Result v) where
   type Element (Result v) = Result (Serial.Element v)
   type ReadIt (Result v) = Result (Serial.ReadIt v)
   extract = Serial.extractTraversable
   readStart = Serial.readStartTraversable
   readNext = Serial.readNextTraversable

instance (Serial.C v) => Serial.C (Result v) where
   type WriteIt (Result v) = Result (Serial.WriteIt v)
   insert  = Serial.insertTraversable
   writeStart = Serial.writeStartTraversable
   writeNext = Serial.writeNextTraversable
   writeStop = Serial.writeStopTraversable


parameter ::
   (A.Transcendental a, A.RationalConstant a) =>
   a -> a -> CodeGenFunction r (Parameter a)
parameter =
   Value.unlift2 $ \reson freq ->
   Universal.parameter (Pole reson freq)


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

causal ::
   (Causal.C process,
    a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a, Memory.C v) =>
   process (Parameter a, v) (Result v)
causal = Causal.fromModifier modifier

{-# DEPRECATED causalP "use causal instead" #-}
causalP ::
   (a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a, Memory.C v) =>
   CausalP.T p (Parameter a, v) (Result v)
causalP = causal

{-
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.
-}