Stereo.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
Re-export functions from "Sound.Frame.Stereo"
and add (orphan) instances for various LLVM type classes.
If you want to use the Stereo datatype with synthesizer-llvm
we recommend to import this module instead of
"Sound.Frame.Stereo" or "Sound.Frame.NumericPrelude.Stereo".
-}
module Synthesizer.LLVM.Frame.Stereo (
   Stereo.T, Stereo.cons, Stereo.left, Stereo.right,
   Stereo.arrowFromMono,
   Stereo.arrowFromMonoControlled,
   Stereo.arrowFromChannels,
   interleave,
   ) where

import qualified Synthesizer.Frame.Stereo as Stereo

import qualified LLVM.Extra.Class as Class
import qualified LLVM.Core as LLVM
import LLVM.Core
   (ValueTuple, buildTuple,
    Undefined, undefTuple,
    IsTuple, tupleDesc,
    MakeValueTuple, valueTupleOf,
    Struct, IsSized, )
import LLVM.Util.Loop (Phi, phis, addPhis, )

import qualified LLVM.Extra.Representation as Rep
import qualified LLVM.Extra.Control as C
import qualified LLVM.Extra.Vector as Vector
import Data.TypeLevel.Num (d0, d1, )

import Control.Monad (liftM2, )
import Control.Applicative (liftA2, )
import qualified Control.Applicative as App


-- if it turns out to be useful, we may move it to sample-frame package
interleave :: (Stereo.T a, Stereo.T b) -> Stereo.T (a,b)
interleave (p,f) =
   Stereo.cons
      (Stereo.left  p, Stereo.left  f)
      (Stereo.right p, Stereo.right f)


instance (Class.Zero a) => Class.Zero (Stereo.T a) where
   zeroTuple = Stereo.cons Class.zeroTuple Class.zeroTuple

instance ValueTuple a => ValueTuple (Stereo.T a) where
   buildTuple f =
      liftM2 Stereo.cons (buildTuple f) (buildTuple f)

instance (Undefined a) => Undefined (Stereo.T a) where
   undefTuple = Stereo.cons undefTuple undefTuple

instance (C.Select a) => C.Select (Stereo.T a) where
   select = C.selectTraversable

instance LLVM.CmpRet a b => LLVM.CmpRet (Stereo.T a) (Stereo.T b) where

instance MakeValueTuple h l =>
      MakeValueTuple (Stereo.T h) (Stereo.T l) where
   valueTupleOf s =
      Stereo.cons
         (LLVM.valueTupleOf $ Stereo.left s)
         (LLVM.valueTupleOf $ Stereo.right s)

instance IsTuple a => IsTuple (Stereo.T a) where
   tupleDesc s =
      tupleDesc (Stereo.left s) ++
      tupleDesc (Stereo.right s)

instance (Phi a) => Phi (Stereo.T a) where
   phis bb v =
      liftM2 Stereo.cons
         (phis bb (Stereo.left v))
         (phis bb (Stereo.right v))
   addPhis bb x y = do
      addPhis bb (Stereo.left  x) (Stereo.left  y)
      addPhis bb (Stereo.right x) (Stereo.right y)


instance (Vector.ShuffleMatch n v) => Vector.ShuffleMatch n (Stereo.T v) where
   shuffleMatch = Vector.shuffleMatchTraversable

instance (Vector.Access n a v) => Vector.Access n (Stereo.T a) (Stereo.T v) where
   insert  = Vector.insertTraversable
   extract = Vector.extractTraversable


memory ::
   (Rep.Memory l s, IsSized s ss) =>
   Rep.MemoryRecord r (Struct (s, (s, ()))) (Stereo.T l)
memory =
   liftA2 Stereo.cons
      (Rep.memoryElement Stereo.left  d0)
      (Rep.memoryElement Stereo.right d1)

instance
      (Rep.Memory l s, IsSized s ss) =>
      Rep.Memory (Stereo.T l) (Struct (s, (s, ()))) where
   load = Rep.loadRecord memory
   store = Rep.storeRecord memory
   decompose = Rep.decomposeRecord memory
   compose = Rep.composeRecord memory


{-
instance
      (Memory l s, IsSized s ss) =>
      Memory (Stereo.T l) (Struct (s, (s, ()))) where
   load ptr =
      liftM2 Stereo.cons
         (load =<< getElementPtr0 ptr (d0, ()))
         (load =<< getElementPtr0 ptr (d1, ()))
   store y ptr = do
      store (Stereo.left  y) =<< getElementPtr0 ptr (d0, ())
      store (Stereo.right y) =<< getElementPtr0 ptr (d1, ())
-}