{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
module Synthesizer.LLVM.Frame where

import qualified Synthesizer.LLVM.Frame.Stereo as Stereo

import qualified LLVM.Extra.Vector as Vector
import qualified LLVM.Extra.Arithmetic as A

import qualified LLVM.Core as LLVM
import LLVM.Core
          (CodeGenFunction, Value, Vector,
           IsPrimitive, IsArithmetic)

import qualified Type.Data.Num.Decimal as TypeNum
import Type.Data.Num.Decimal (D2, D4)

import qualified Data.Traversable as Trav
import qualified Data.Foldable as Fold

import NumericPrelude.Numeric hiding (zero, one, div, signum)
import NumericPrelude.Base


{- |
Copy mono signal to both stereo channels.
-}
stereoFromMono ::
   a -> CodeGenFunction r (Stereo.T a)
stereoFromMono :: forall a r. a -> CodeGenFunction r (T a)
stereoFromMono a
x =
   T a -> CodeGenFunction r (T a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (T a -> CodeGenFunction r (T a)) -> T a -> CodeGenFunction r (T a)
forall a b. (a -> b) -> a -> b
$ a -> a -> T a
forall a. a -> a -> T a
Stereo.cons a
x a
x

mixMonoFromStereo ::
   (A.Additive a) =>
   Stereo.T a -> CodeGenFunction r a
mixMonoFromStereo :: forall a r. Additive a => T a -> CodeGenFunction r a
mixMonoFromStereo T a
s =
   a -> a -> CodeGenFunction r a
forall a r. Additive a => a -> a -> CodeGenFunction r a
mix (T a -> a
forall a. T a -> a
Stereo.left T a
s) (T a -> a
forall a. T a -> a
Stereo.right T a
s)


stereoFromVector ::
   (IsPrimitive a) =>
   Value (Vector D2 a) ->
   CodeGenFunction r (Stereo.T (Value a))
stereoFromVector :: forall a r.
IsPrimitive a =>
Value (Vector D2 a) -> CodeGenFunction r (T (Value a))
stereoFromVector Value (Vector D2 a)
x =
   (Word32 -> CodeGenFunction r (Value a))
-> T Word32 -> CodeGenFunction r (T (Value a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> T a -> m (T b)
Trav.mapM (Value (Vector D2 a) -> Value Word32 -> CodeGenFunction r (Value a)
forall n a r.
(Positive n, IsPrimitive a) =>
Value (Vector n a) -> Value Word32 -> CodeGenFunction r (Value a)
LLVM.extractelement Value (Vector D2 a)
x (Value Word32 -> CodeGenFunction r (Value a))
-> (Word32 -> Value Word32)
-> Word32
-> CodeGenFunction r (Value a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Value Word32
forall a. IsConst a => a -> Value a
LLVM.valueOf) (T Word32 -> CodeGenFunction r (T (Value a)))
-> T Word32 -> CodeGenFunction r (T (Value a))
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> T Word32
forall a. a -> a -> T a
Stereo.cons Word32
0 Word32
1

vectorFromStereo ::
   (IsPrimitive a) =>
   Stereo.T (Value a) ->
   CodeGenFunction r (Value (Vector D2 a))
vectorFromStereo :: forall a r.
IsPrimitive a =>
T (Value a) -> CodeGenFunction r (Value (Vector D2 a))
vectorFromStereo =
   [Element (Value (Vector D2 a))]
-> CodeGenFunction r (Value (Vector D2 a))
[Value a] -> CodeGenFunction r (Value (Vector D2 a))
forall v r. C v => [Element v] -> CodeGenFunction r v
Vector.assemble ([Value a] -> CodeGenFunction r (Value (Vector D2 a)))
-> (T (Value a) -> [Value a])
-> T (Value a)
-> CodeGenFunction r (Value (Vector D2 a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (Value a) -> [Value a]
forall a. T a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList


quadroFromVector ::
   (IsPrimitive a) =>
   Value (Vector D4 a) ->
   CodeGenFunction r (Stereo.T (Stereo.T (Value a)))
quadroFromVector :: forall a r.
IsPrimitive a =>
Value (Vector D4 a) -> CodeGenFunction r (T (T (Value a)))
quadroFromVector Value (Vector D4 a)
x =
   (T Word32 -> CodeGenFunction r (T (Value a)))
-> T (T Word32) -> CodeGenFunction r (T (T (Value a)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> T a -> m (T b)
Trav.mapM ((Word32 -> CodeGenFunction r (Value a))
-> T Word32 -> CodeGenFunction r (T (Value a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> T a -> m (T b)
Trav.mapM (Value (Vector D4 a) -> Value Word32 -> CodeGenFunction r (Value a)
forall n a r.
(Positive n, IsPrimitive a) =>
Value (Vector n a) -> Value Word32 -> CodeGenFunction r (Value a)
LLVM.extractelement Value (Vector D4 a)
x (Value Word32 -> CodeGenFunction r (Value a))
-> (Word32 -> Value Word32)
-> Word32
-> CodeGenFunction r (Value a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Value Word32
forall a. IsConst a => a -> Value a
LLVM.valueOf)) (T (T Word32) -> CodeGenFunction r (T (T (Value a))))
-> T (T Word32) -> CodeGenFunction r (T (T (Value a)))
forall a b. (a -> b) -> a -> b
$
   T Word32 -> T Word32 -> T (T Word32)
forall a. a -> a -> T a
Stereo.cons (Word32 -> Word32 -> T Word32
forall a. a -> a -> T a
Stereo.cons Word32
0 Word32
1) (Word32 -> Word32 -> T Word32
forall a. a -> a -> T a
Stereo.cons Word32
2 Word32
3)

vectorFromQuadro ::
   (IsPrimitive a) =>
   Stereo.T (Stereo.T (Value a)) ->
   CodeGenFunction r (Value (Vector D4 a))
vectorFromQuadro :: forall a r.
IsPrimitive a =>
T (T (Value a)) -> CodeGenFunction r (Value (Vector D4 a))
vectorFromQuadro =
   [Element (Value (Vector D4 a))]
-> CodeGenFunction r (Value (Vector D4 a))
[Value a] -> CodeGenFunction r (Value (Vector D4 a))
forall v r. C v => [Element v] -> CodeGenFunction r v
Vector.assemble ([Value a] -> CodeGenFunction r (Value (Vector D4 a)))
-> (T (T (Value a)) -> [Value a])
-> T (T (Value a))
-> CodeGenFunction r (Value (Vector D4 a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (T (Value a) -> [Value a]) -> [T (Value a)] -> [Value a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap T (Value a) -> [Value a]
forall a. T a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList ([T (Value a)] -> [Value a])
-> (T (T (Value a)) -> [T (Value a)])
-> T (T (Value a))
-> [Value a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (T (Value a)) -> [T (Value a)]
forall a. T a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList


mix ::
   (A.Additive a) =>
   a -> a -> CodeGenFunction r a
mix :: forall a r. Additive a => a -> a -> CodeGenFunction r a
mix = a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. Additive a => a -> a -> CodeGenFunction r a
A.add


{- |
This may mean more shuffling and is not necessarily better than mixStereo.
-}
mixStereoV ::
   (IsArithmetic a, IsPrimitive a) =>
   Stereo.T (Value a) -> Stereo.T (Value a) ->
   CodeGenFunction r (Stereo.T (Value a))
mixStereoV :: forall a r.
(IsArithmetic a, IsPrimitive a) =>
T (Value a) -> T (Value a) -> CodeGenFunction r (T (Value a))
mixStereoV T (Value a)
x T (Value a)
y =
   do Value (Vector D2 a)
xv <- T (Value a) -> CodeGenFunction r (Value (Vector D2 a))
forall a r.
IsPrimitive a =>
T (Value a) -> CodeGenFunction r (Value (Vector D2 a))
vectorFromStereo T (Value a)
x
      Value (Vector D2 a)
yv <- T (Value a) -> CodeGenFunction r (Value (Vector D2 a))
forall a r.
IsPrimitive a =>
T (Value a) -> CodeGenFunction r (Value (Vector D2 a))
vectorFromStereo T (Value a)
y
      Value (Vector D2 a) -> CodeGenFunction r (T (Value a))
forall a r.
IsPrimitive a =>
Value (Vector D2 a) -> CodeGenFunction r (T (Value a))
stereoFromVector (Value (Vector D2 a) -> CodeGenFunction r (T (Value a)))
-> CodeGenFunction r (Value (Vector D2 a))
-> CodeGenFunction r (T (Value a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Vector D2 a)
-> Value (Vector D2 a) -> CodeGenFunction r (Value (Vector D2 a))
forall a r. Additive a => a -> a -> CodeGenFunction r a
forall r.
Value (Vector D2 a)
-> Value (Vector D2 a) -> CodeGenFunction r (Value (Vector D2 a))
A.add Value (Vector D2 a)
xv Value (Vector D2 a)
yv

mixVector ::
   (Vector.Arithmetic a, TypeNum.Positive n) =>
   Value (Vector n a) ->
   CodeGenFunction r (Value a)
mixVector :: forall a n r.
(Arithmetic a, Positive n) =>
Value (Vector n a) -> CodeGenFunction r (Value a)
mixVector = Value (Vector n a) -> CodeGenFunction r (Value a)
forall a n r.
(Arithmetic a, Positive n) =>
Value (Vector n a) -> CodeGenFunction r (Value a)
forall n r.
Positive n =>
Value (Vector n a) -> CodeGenFunction r (Value a)
Vector.sum

mixVectorToStereo ::
   (Vector.Arithmetic a, TypeNum.Positive n) =>
   Value (Vector n a) ->
   CodeGenFunction r (Stereo.T (Value a))
mixVectorToStereo :: forall a n r.
(Arithmetic a, Positive n) =>
Value (Vector n a) -> CodeGenFunction r (T (Value a))
mixVectorToStereo =
   ((Value a, Value a) -> T (Value a))
-> CodeGenFunction r (Value a, Value a)
-> CodeGenFunction r (T (Value a))
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value a -> Value a -> T (Value a))
-> (Value a, Value a) -> T (Value a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Value a -> Value a -> T (Value a)
forall a. a -> a -> T a
Stereo.cons) (CodeGenFunction r (Value a, Value a)
 -> CodeGenFunction r (T (Value a)))
-> (Value (Vector n a) -> CodeGenFunction r (Value a, Value a))
-> Value (Vector n a)
-> CodeGenFunction r (T (Value a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Value (Vector n a) -> CodeGenFunction r (Value a, Value a)
forall a n r.
(Arithmetic a, Positive n) =>
Value (Vector n a) -> CodeGenFunction r (Value a, Value a)
forall n r.
Positive n =>
Value (Vector n a) -> CodeGenFunction r (Value a, Value a)
Vector.sumInterleavedToPair

{- |
Mix components with even index to the left channel
and components with odd index to the right channel.
-}
mixInterleavedVectorToStereo ::
   (Vector.Arithmetic a, TypeNum.Positive n) =>
   Value (Vector n a) ->
   CodeGenFunction r (Stereo.T (Value a))
mixInterleavedVectorToStereo :: forall a n r.
(Arithmetic a, Positive n) =>
Value (Vector n a) -> CodeGenFunction r (T (Value a))
mixInterleavedVectorToStereo =
   ((Value a, Value a) -> T (Value a))
-> CodeGenFunction r (Value a, Value a)
-> CodeGenFunction r (T (Value a))
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Value a -> Value a -> T (Value a))
-> (Value a, Value a) -> T (Value a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Value a -> Value a -> T (Value a)
forall a. a -> a -> T a
Stereo.cons) (CodeGenFunction r (Value a, Value a)
 -> CodeGenFunction r (T (Value a)))
-> (Value (Vector n a) -> CodeGenFunction r (Value a, Value a))
-> Value (Vector n a)
-> CodeGenFunction r (T (Value a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Value (Vector n a) -> CodeGenFunction r (Value a, Value a)
forall a n r.
(Arithmetic a, Positive n) =>
Value (Vector n a) -> CodeGenFunction r (Value a, Value a)
forall n r.
Positive n =>
Value (Vector n a) -> CodeGenFunction r (Value a, Value a)
Vector.sumInterleavedToPair


amplifyMono ::
   (A.PseudoRing a) =>
   a -> a -> CodeGenFunction r a
amplifyMono :: forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
amplifyMono = a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
A.mul

amplifyStereo ::
   (A.PseudoRing a) =>
   a -> Stereo.T a -> CodeGenFunction r (Stereo.T a)
amplifyStereo :: forall a r. PseudoRing a => a -> T a -> CodeGenFunction r (T a)
amplifyStereo a
x =
   (a -> CodeGenFunction r a) -> T a -> CodeGenFunction r (T a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> T a -> m (T b)
Trav.mapM (a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
A.mul a
x)