{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{- |
This is like "Synthesizer.LLVM.CausalExp.Controlled"
but for vectorised signals.
-}
module Synthesizer.LLVM.Causal.ControlledPacked (
   C(..),
   processCtrlRate,
   ) where

import qualified Synthesizer.LLVM.Filter.SecondOrderCascade as Cascade
import qualified Synthesizer.LLVM.Filter.Allpass as Allpass
import qualified Synthesizer.LLVM.Filter.FirstOrder as Filt1
import qualified Synthesizer.LLVM.Filter.SecondOrder as Filt2
import qualified Synthesizer.LLVM.Filter.Moog as Moog
import qualified Synthesizer.LLVM.Filter.Universal as UniFilter

import qualified Synthesizer.LLVM.Causal.ProcessPacked as CausalP
import qualified Synthesizer.LLVM.Causal.Process as Causal
import qualified Synthesizer.LLVM.Generator.Signal as Sig
import qualified Synthesizer.LLVM.Frame.SerialVector.Class as Serial

import Synthesizer.Causal.Class (($<))

import qualified LLVM.DSL.Expression as Expr
import LLVM.DSL.Expression (Exp)

import qualified LLVM.Extra.Multi.Value.Marshal as Marshal
import qualified LLVM.Extra.Multi.Value as MultiValue
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Extra.Arithmetic as A

import qualified LLVM.Core as LLVM

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

import qualified Algebra.Module as Module
import qualified NumericPrelude.Numeric as NP

import Control.Arrow ((<<<), arr, first)



processCtrlRate ::
   (C parameter av bv, Memory.C parameter,
    Serial.Read  av, n ~ Serial.Size av,
    Serial.Write bv, n ~ Serial.Size bv) =>
   (Marshal.C r, MultiValue.RationalConstant r,
    MultiValue.Field r, MultiValue.Comparison r) =>
   Exp r -> (Exp r -> Sig.T parameter) -> Causal.T av bv
processCtrlRate :: forall parameter av bv n r.
(C parameter av bv, C parameter, Read av, n ~ Size av, Write bv,
 n ~ Size bv, C r, RationalConstant r, Field r, Comparison r) =>
Exp r -> (Exp r -> T parameter) -> T av bv
processCtrlRate Exp r
reduct Exp r -> T parameter
ctrlGen = (Int -> T av bv) -> T av bv
forall v (m :: * -> *). Sized v => (Int -> m v) -> m v
Serial.withSize ((Int -> T av bv) -> T av bv) -> (Int -> T av bv) -> T av bv
forall a b. (a -> b) -> a -> b
$ \Int
n ->
   T (parameter, av) bv
forall parameter a b. C parameter a b => T (parameter, a) b
process T (parameter, av) bv -> SignalOf T parameter -> T av bv
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process a -> process b c
$<
      Exp r -> T parameter -> T parameter
forall a b.
(C a, C b, IntegerConstant b, Additive b, Comparison b) =>
Exp b -> T a -> T a
Sig.interpolateConstant (Exp r
reduct Exp r -> Exp r -> Exp r
forall a. Fractional a => a -> a -> a
/ Int -> Exp r
forall a b. (C a, C b) => a -> b
NP.fromIntegral Int
n) (Exp r -> T parameter
ctrlGen Exp r
reduct)


{- |
A filter parameter type uniquely selects a filter function.
However it does not uniquely determine the input and output type,
since the same filter can run on mono and stereo signals.
-}
class (Output parameter a ~ b, Input parameter b ~ a) => C parameter a b where
   type Output parameter a
   type Input  parameter b
   process :: Causal.T (parameter, a) b


{-
Instances for the particular filters shall be defined here
in order to avoid orphan instances.
-}

instance
   (Serial.Write v, Serial.Element v ~ a,
    A.PseudoRing v, A.IntegerConstant v,
    A.PseudoRing a, A.IntegerConstant a, Expr.Aggregate ae a,
    Tuple.Phi a, Tuple.Undefined a, Memory.C a) =>
      C (Filt1.Parameter a) v (Filt1.Result v) where
   type Input  (Filt1.Parameter a) (Filt1.Result v) = v
   type Output (Filt1.Parameter a) v = Filt1.Result v
   process :: T (Parameter a, v) (Result v)
process = T (Parameter a, v) (Result v)
forall v a.
(Write v, Element v ~ a, PseudoRing v, IntegerConstant v,
 PseudoRing a, IntegerConstant a, C a) =>
T (Parameter a, v) (Result v)
Filt1.causalPacked

instance
   (Serial.Write v, Serial.Element v ~ a,
    A.PseudoRing v, A.IntegerConstant v,
    A.PseudoRing a, A.IntegerConstant a, Expr.Aggregate ae a,
    Tuple.Phi a, Tuple.Undefined a, Memory.C a, Memory.C v) =>
      C (Filt2.Parameter a) v v where
   type Input  (Filt2.Parameter a) v = v
   type Output (Filt2.Parameter a) v = v
   process :: T (Parameter a, v) v
process = T (Parameter a, v) v
forall v a.
(Write v, Element v ~ a, C v, C a, IntegerConstant v,
 IntegerConstant a, PseudoRing v, PseudoRing a) =>
T (Parameter a, v) v
Filt2.causalPacked

instance
   (Serial.Write v, Serial.Element v ~ MultiValue.T a,
    Memory.C v, A.PseudoRing v, A.IntegerConstant v,
    Marshal.C a, MultiValue.PseudoRing a, MultiValue.IntegerConstant a,
    TypeNum.Positive (n :*: LLVM.UnknownSize),
    TypeNum.Natural n) =>
      C (Cascade.ParameterValue n a) v v where
   type Input  (Cascade.ParameterValue n a) v = v
   type Output (Cascade.ParameterValue n a) v = v
   process :: T (ParameterValue n a, v) v
process = T (ParameterValue n a, v) v
forall a v n.
(C a, PseudoRing a, IntegerConstant a, Write v, Element v ~ T a,
 C v, PseudoRing v, IntegerConstant v, Natural n,
 Positive (n :*: UnknownSize)) =>
T (ParameterValue n a, v) v
Cascade.causalPacked

instance
   (Serial.Write v, Serial.Element v ~ a,
    A.PseudoRing a, A.IntegerConstant a, Memory.C a,
    A.PseudoRing v, A.IntegerConstant v) =>
      C (Allpass.Parameter a) v v where
   type Input  (Allpass.Parameter a) v = v
   type Output (Allpass.Parameter a) v = v
   process :: T (Parameter a, v) v
process = T (Parameter a, v) v
forall v a.
(Write v, Element v ~ a, PseudoRing a, IntegerConstant a, C a,
 PseudoRing v, IntegerConstant v) =>
T (Parameter a, v) v
Allpass.causalPacked

instance
   (TypeNum.Natural n,
    Serial.Write v, Serial.Element v ~ a,
    A.PseudoRing a, A.IntegerConstant a, Memory.C a,
    A.PseudoRing v, A.RationalConstant v) =>
      C (Allpass.CascadeParameter n a) v v where
   type Input  (Allpass.CascadeParameter n a) v = v
   type Output (Allpass.CascadeParameter n a) v = v
   process :: T (CascadeParameter n a, v) v
process = T (CascadeParameter n a, v) v
forall n v a.
(Natural n, Write v, Element v ~ a, PseudoRing a,
 IntegerConstant a, C a, PseudoRing v, RationalConstant v) =>
T (CascadeParameter n a, v) v
Allpass.cascadePacked


instance
   (TypeNum.Natural n,
    Serial.Write v, Serial.Element v ~ b, Memory.C b,
    Tuple.Phi a, Tuple.Undefined a,
    Expr.Aggregate ae a, Expr.Aggregate be b, Module.C ae be) =>
      C (Moog.Parameter n a) v v where
   type Input  (Moog.Parameter n a) v = v
   type Output (Moog.Parameter n a) v = v
   process :: T (Parameter n a, v) v
process = T (Parameter n a, b) b
-> T (Constant (Size v) (Parameter n a), v) v
forall va n a vb b.
(Read va, n ~ Size va, a ~ Element va, Write vb, n ~ Size vb,
 b ~ Element vb) =>
T a b -> T va vb
CausalP.pack T (Parameter n a, b) b
forall n v ae ve a.
(Natural n, C v, C ae ve, Aggregate ae a, Aggregate ve v) =>
T (Parameter n a, v) v
Moog.causal T (Constant (Size v) (Parameter n a), v) v
-> T (Parameter n a, v) (Constant (Size v) (Parameter n a), v)
-> T (Parameter n a, v) v
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< T (Parameter n a) (Constant (Size v) (Parameter n a))
-> T (Parameter n a, v) (Constant (Size v) (Parameter n a), v)
forall b c d. T b c -> T (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Parameter n a -> Constant (Size v) (Parameter n a))
-> T (Parameter n a) (Constant (Size v) (Parameter n a))
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Parameter n a -> Constant (Size v) (Parameter n a)
forall n a. Positive n => a -> Constant n a
Serial.constant)


instance
   (Serial.Write v, Serial.Element v ~ b, Memory.C b,
    Tuple.Phi a, Tuple.Undefined a,
    Expr.Aggregate ae a, Expr.Aggregate be b, Module.C ae be) =>
      C (UniFilter.Parameter a) v (UniFilter.Result v) where
   type Input  (UniFilter.Parameter a) (UniFilter.Result v) = v
   type Output (UniFilter.Parameter a) v = UniFilter.Result v
   process :: T (Parameter a, v) (Result v)
process =
      T (Parameter a, b) (Result b)
-> T (Constant (Size v) (Parameter a), v) (Result v)
forall va n a vb b.
(Read va, n ~ Size va, a ~ Element va, Write vb, n ~ Size vb,
 b ~ Element vb) =>
T a b -> T va vb
CausalP.pack T (Parameter a, b) (Result b)
forall ae ve a v.
(C ae ve, Aggregate ae a, Aggregate ve v, C v) =>
T (Parameter a, v) (Result v)
UniFilter.causalExp T (Constant (Size v) (Parameter a), v) (Result v)
-> T (Parameter a, v) (Constant (Size v) (Parameter a), v)
-> T (Parameter a, v) (Result v)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< T (Parameter a) (Constant (Size v) (Parameter a))
-> T (Parameter a, v) (Constant (Size v) (Parameter a), v)
forall b c d. T b c -> T (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Parameter a -> Constant (Size v) (Parameter a))
-> T (Parameter a) (Constant (Size v) (Parameter a))
forall b c. (b -> c) -> T b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr Parameter a -> Constant (Size v) (Parameter a)
forall n a. Positive n => a -> Constant n a
Serial.constant)