Frame.hs

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

import qualified Synthesizer.LLVM.Frame.Stereo as Stereo

import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Vector as Vector
import qualified LLVM.Extra.Class as Class
import qualified LLVM.Extra.Control as C
import qualified LLVM.Extra.Arithmetic as A

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

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

import Foreign.Storable.Tuple ()

import Data.Word (Word32, )

import qualified Data.Traversable as Trav

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 x =
   return $ Stereo.cons x x

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


stereoFromVector ::
   (IsPrimitive a) =>
   Value (Vector D2 a) ->
   CodeGenFunction r (Stereo.T (Value a))
stereoFromVector x =
   Trav.mapM (LLVM.extractelement x . LLVM.valueOf) $ Stereo.cons 0 1

vectorFromStereo ::
   (IsPrimitive a) =>
   Stereo.T (Value a) ->
   CodeGenFunction r (Value (Vector D2 a))
vectorFromStereo =
   Vector.assemble . listFromStereo


quadroFromVector ::
   (IsPrimitive a) =>
   Value (Vector D4 a) ->
   CodeGenFunction r (Stereo.T (Stereo.T (Value a)))
quadroFromVector x =
   Trav.mapM (Trav.mapM (LLVM.extractelement x . LLVM.valueOf)) $
   Stereo.cons (Stereo.cons 0 1) (Stereo.cons 2 3)

vectorFromQuadro ::
   (IsPrimitive a) =>
   Stereo.T (Stereo.T (Value a)) ->
   CodeGenFunction r (Value (Vector D4 a))
vectorFromQuadro =
   Vector.assemble .
   concatMap listFromStereo . listFromStereo

listFromStereo :: Stereo.T a -> [a]
listFromStereo s =
   [Stereo.left s, Stereo.right s]


mix ::
   (A.Additive a) =>
   a -> a -> CodeGenFunction r a
mix = 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 x y =
   do xv <- vectorFromStereo x
      yv <- vectorFromStereo y
      stereoFromVector =<< A.add xv yv

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

mixVectorToStereo ::
   (Vector.Arithmetic a, TypeNum.Pos n) =>
   Value (Vector n a) ->
   CodeGenFunction r (Stereo.T (Value a))
mixVectorToStereo =
   fmap (uncurry Stereo.cons) .
   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.Pos n) =>
   Value (Vector n a) ->
   CodeGenFunction r (Stereo.T (Value a))
mixInterleavedVectorToStereo =
   fmap (uncurry Stereo.cons) .
   Vector.sumInterleavedToPair


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

amplifyStereo ::
   (A.PseudoRing a) =>
   a -> Stereo.T a -> CodeGenFunction r (Stereo.T a)
amplifyStereo x =
   Trav.mapM (A.mul x)


subsampleVector ::
   (Vector.Access n a v) =>
   v -> CodeGenFunction r a
subsampleVector =
   Vector.extract (LLVM.value LLVM.zero :: Value Word32)


signum ::
   (SoV.IntegerConstant a,
    LLVM.IsFirstClass a,
    LLVM.CmpRet a Bool) =>
   Value a -> CodeGenFunction r (Value a)
signum x = do
   negative <- A.cmp LLVM.CmpLT x Class.zeroTuple
   positive <- A.cmp LLVM.CmpGT x Class.zeroTuple
   C.select negative (A.fromInteger' (-1))
      =<< C.select positive (A.fromInteger' 1) (A.fromInteger' 0)