BendModulation.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
Various LLVM related instances of the BM.T type.
I have setup a separate module since these instances are orphan
and need several language extensions.
-}
module Synthesizer.LLVM.ALSA.BendModulation (
   BM.T(..),
   BM.deflt,
   BM.shift,
   ) where

import qualified Synthesizer.MIDIValue.BendModulation as BM

import qualified LLVM.Extra.Vector as Vector
import qualified LLVM.Extra.Class as Class
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Control as C
import qualified LLVM.Util.Loop as Loop
import qualified LLVM.Core as LLVM

import Control.Applicative (liftA2, )
import qualified Data.TypeLevel.Num as TypeNum


instance (Class.Zero a) => Class.Zero (BM.T a) where
   zeroTuple = Class.zeroTuplePointed

{-
instance (LLVM.ValueTuple a) => LLVM.ValueTuple (BM.T a) where
   buildTuple f = Class.buildTupleTraversable (LLVM.buildTuple f)

instance LLVM.IsTuple a => LLVM.IsTuple (BM.T a) where
   tupleDesc = Class.tupleDescFoldable
-}

instance (Class.Undefined a) => Class.Undefined (BM.T a) where
   undefTuple = Class.undefTuplePointed

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

{-
instance LLVM.CmpRet a b =>
      LLVM.CmpRet (BM.T a) (BM.T b) where
-}

instance Class.MakeValueTuple h l =>
      Class.MakeValueTuple (BM.T h) (BM.T l) where
   valueTupleOf = Class.valueTupleOfFunctor

memory ::
   (Memory.C l s, LLVM.IsSized s ss) =>
   Memory.Record r (LLVM.Struct (s, (s, ()))) (BM.T l)
memory =
   liftA2 BM.Cons
      (Memory.element BM.bend  TypeNum.d0)
      (Memory.element BM.depth TypeNum.d1)

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


instance (Loop.Phi a) => Loop.Phi (BM.T a) where
   phis = Class.phisTraversable
   addPhis = Class.addPhisFoldable


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

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