{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# 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.MIDI.BendModulation (
   BM.T(..),
   BM.deflt,
   BM.shift,
   multiValue,
   unMultiValue,
   ) where

import qualified Synthesizer.MIDI.Value.BendModulation as BM
import qualified Synthesizer.LLVM.Causal.Functional as F

import qualified LLVM.DSL.Expression as Expr

import qualified LLVM.Extra.Multi.Value.Storable as StorableMV
import qualified LLVM.Extra.Multi.Value.Marshal as MarshalMV
import qualified LLVM.Extra.Multi.Value as MultiValue
import qualified LLVM.Extra.Vector as Vector
import qualified LLVM.Extra.Tuple as Tuple
import qualified LLVM.Extra.Storable as Storable
import qualified LLVM.Extra.Marshal as Marshal
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Control as C
import qualified LLVM.Core as LLVM

import qualified Type.Data.Num.Decimal as TypeNum

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

import Control.Applicative (liftA2)


instance (Tuple.Zero a) => Tuple.Zero (BM.T a) where
   zero :: T a
zero = T a
forall a (f :: * -> *). (Zero a, Applicative f) => f a
Tuple.zeroPointed

instance (Tuple.Undefined a) => Tuple.Undefined (BM.T a) where
   undef :: T a
undef = T a
forall a (f :: * -> *). (Undefined a, Applicative f) => f a
Tuple.undefPointed

instance (C.Select a) => C.Select (BM.T a) where
   select :: forall r. Value Bool -> T a -> T a -> CodeGenFunction r (T a)
select = Value Bool -> T a -> T a -> CodeGenFunction r (T a)
forall a (f :: * -> *) r.
(Select a, Traversable f, Applicative f) =>
Value Bool -> f a -> f a -> CodeGenFunction r (f a)
C.selectTraversable

instance Tuple.Value h => Tuple.Value (BM.T h) where
   type ValueOf (BM.T h) = BM.T (Tuple.ValueOf h)
   valueOf :: T h -> ValueOf (T h)
valueOf = T h -> ValueOf (T h)
T h -> T (ValueOf h)
forall h (f :: * -> *).
(Value h, Functor f) =>
f h -> f (ValueOf h)
Tuple.valueOfFunctor


instance (Expr.Aggregate e mv) => Expr.Aggregate (BM.T e) (BM.T mv) where
   type MultiValuesOf (BM.T e) = BM.T (Expr.MultiValuesOf e)
   type ExpressionsOf (BM.T mv) = BM.T (Expr.ExpressionsOf mv)
   bundle :: forall r. T e -> CodeGenFunction r (T mv)
bundle = (e -> CodeGenFunction r mv) -> T e -> CodeGenFunction r (T mv)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> T a -> f (T b)
Trav.traverse e -> CodeGenFunction r mv
forall r. e -> CodeGenFunction r mv
forall exp mv r. Aggregate exp mv => exp -> CodeGenFunction r mv
Expr.bundle
   dissect :: T mv -> T e
dissect = (mv -> e) -> T mv -> T e
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap mv -> e
forall exp mv. Aggregate exp mv => mv -> exp
Expr.dissect

instance (MultiValue.C a) => MultiValue.C (BM.T a) where
   type Repr (BM.T a) = BM.T (MultiValue.Repr a)
   cons :: T a -> T (T a)
cons = T (T a) -> T (T a)
forall a. T (T a) -> T (T a)
multiValue (T (T a) -> T (T a)) -> (T a -> T (T a)) -> T a -> T (T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> T a) -> T a -> T (T a)
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> T a
forall a. C a => a -> T a
MultiValue.cons
   undef :: T (T a)
undef = T (T a) -> T (T a)
forall a. T (T a) -> T (T a)
multiValue (T (T a) -> T (T a)) -> T (T a) -> T (T a)
forall a b. (a -> b) -> a -> b
$ T a -> T (T a)
forall a. a -> T a
forall (f :: * -> *) a. Applicative f => a -> f a
pure T a
forall a. C a => T a
MultiValue.undef
   zero :: T (T a)
zero = T (T a) -> T (T a)
forall a. T (T a) -> T (T a)
multiValue (T (T a) -> T (T a)) -> T (T a) -> T (T a)
forall a b. (a -> b) -> a -> b
$ T a -> T (T a)
forall a. a -> T a
forall (f :: * -> *) a. Applicative f => a -> f a
pure T a
forall a. C a => T a
MultiValue.zero
   phi :: forall r. BasicBlock -> T (T a) -> CodeGenFunction r (T (T a))
phi BasicBlock
bb = (T (T a) -> T (T a))
-> CodeGenFunction r (T (T a)) -> CodeGenFunction r (T (T 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 T (T a) -> T (T a)
forall a. T (T a) -> T (T a)
multiValue (CodeGenFunction r (T (T a)) -> CodeGenFunction r (T (T a)))
-> (T (T a) -> CodeGenFunction r (T (T a)))
-> T (T a)
-> CodeGenFunction r (T (T a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T a -> CodeGenFunction r (T a))
-> T (T a) -> CodeGenFunction r (T (T a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> T a -> f (T b)
Trav.traverse (BasicBlock -> T a -> CodeGenFunction r (T a)
forall a r. C a => BasicBlock -> T a -> CodeGenFunction r (T a)
forall r. BasicBlock -> T a -> CodeGenFunction r (T a)
MultiValue.phi BasicBlock
bb) (T (T a) -> CodeGenFunction r (T (T a)))
-> (T (T a) -> T (T a)) -> T (T a) -> CodeGenFunction r (T (T a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T (T a) -> T (T a)
forall a. T (T a) -> T (T a)
unMultiValue
   addPhi :: forall r. BasicBlock -> T (T a) -> T (T a) -> CodeGenFunction r ()
addPhi BasicBlock
bb T (T a)
a T (T a)
b =
      T (CodeGenFunction r ()) -> CodeGenFunction r ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
Fold.sequence_ (T (CodeGenFunction r ()) -> CodeGenFunction r ())
-> T (CodeGenFunction r ()) -> CodeGenFunction r ()
forall a b. (a -> b) -> a -> b
$
      (T a -> T a -> CodeGenFunction r ())
-> T (T a) -> T (T a) -> T (CodeGenFunction r ())
forall a b c. (a -> b -> c) -> T a -> T b -> T c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall a r. C a => BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall r. BasicBlock -> T a -> T a -> CodeGenFunction r ()
MultiValue.addPhi BasicBlock
bb) (T (T a) -> T (T a)
forall a. T (T a) -> T (T a)
unMultiValue T (T a)
a) (T (T a) -> T (T a)
forall a. T (T a) -> T (T a)
unMultiValue T (T a)
b)

instance (MarshalMV.C l) => MarshalMV.C (BM.T l) where
   pack :: T l -> Struct (T l)
pack (BM.Cons l
bend l
depth) = (l, l) -> Struct (l, l)
forall a. C a => a -> Struct a
MarshalMV.pack (l
bend, l
depth)
   unpack :: Struct (T l) -> T l
unpack = (l -> l -> T l) -> (l, l) -> T l
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry l -> l -> T l
forall a. a -> a -> T a
BM.Cons ((l, l) -> T l)
-> (Struct (Struct (Repr l)) -> (l, l))
-> Struct (Struct (Repr l))
-> T l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct (l, l) -> (l, l)
Struct (Struct (Repr l)) -> (l, l)
forall a. C a => Struct a -> a
MarshalMV.unpack

instance (StorableMV.C l) => StorableMV.C (BM.T l) where
   load :: forall r. Value (Ptr (T l)) -> CodeGenFunction r (T (T l))
load = Value (Ptr (T l)) -> CodeGenFunction r (T (T l))
forall (f :: * -> *) a fa r.
(Applicative f, Traversable f, C a, Repr fa ~ f (Repr a)) =>
Value (Ptr (f a)) -> CodeGenFunction r (T fa)
StorableMV.loadApplicative
   store :: forall r. T (T l) -> Value (Ptr (T l)) -> CodeGenFunction r ()
store = T (T l) -> Value (Ptr (T l)) -> CodeGenFunction r ()
forall (f :: * -> *) a fa r.
(Foldable f, C a, Repr fa ~ f (Repr a)) =>
T fa -> Value (Ptr (f a)) -> CodeGenFunction r ()
StorableMV.storeFoldable

multiValue :: BM.T (MultiValue.T a) -> MultiValue.T (BM.T a)
multiValue :: forall a. T (T a) -> T (T a)
multiValue = Repr (T a) -> T (T a)
T (Repr a) -> T (T a)
forall a. Repr a -> T a
MultiValue.Cons (T (Repr a) -> T (T a))
-> (T (T a) -> T (Repr a)) -> T (T a) -> T (T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T a -> Repr a) -> T (T a) -> T (Repr a)
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(MultiValue.Cons Repr a
a) -> Repr a
a)

unMultiValue :: MultiValue.T (BM.T a) -> BM.T (MultiValue.T a)
unMultiValue :: forall a. T (T a) -> T (T a)
unMultiValue (MultiValue.Cons Repr (T a)
x) = (Repr a -> T a) -> T (Repr a) -> T (T a)
forall a b. (a -> b) -> T a -> T b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Repr a -> T a
forall a. Repr a -> T a
MultiValue.Cons Repr (T a)
T (Repr a)
x


type Struct a = LLVM.Struct (a, (a, ()))

memory :: (Memory.C l) => Memory.Record r (Struct (Memory.Struct l)) (BM.T l)
memory :: forall l r. C l => Record r (Struct (Struct l)) (T l)
memory =
   (l -> l -> T l)
-> Element r (Struct (Struct l)) (T l) l
-> Element r (Struct (Struct l)) (T l) l
-> Element r (Struct (Struct l)) (T l) (T l)
forall a b c.
(a -> b -> c)
-> Element r (Struct (Struct l)) (T l) a
-> Element r (Struct (Struct l)) (T l) b
-> Element r (Struct (Struct l)) (T l) c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 l -> l -> T l
forall a. a -> a -> T a
BM.Cons
      ((T l -> l) -> Proxy D0 -> Element r (Struct (Struct l)) (T l) l
forall x o n v r.
(C x, GetValue o n, ValueType o n ~ Struct x,
 GetElementPtr o (n, ()), ElementPtrType o (n, ()) ~ Struct x) =>
(v -> x) -> n -> Element r o v x
Memory.element T l -> l
forall a. T a -> a
BM.bend  Proxy D0
TypeNum.d0)
      ((T l -> l) -> Proxy D1 -> Element r (Struct (Struct l)) (T l) l
forall x o n v r.
(C x, GetValue o n, ValueType o n ~ Struct x,
 GetElementPtr o (n, ()), ElementPtrType o (n, ()) ~ Struct x) =>
(v -> x) -> n -> Element r o v x
Memory.element T l -> l
forall a. T a -> a
BM.depth Proxy D1
TypeNum.d1)

instance (Memory.C l) => Memory.C (BM.T l) where
   type Struct (BM.T l) = Struct (Memory.Struct l)
   load :: forall r. Value (Ptr (Struct (T l))) -> CodeGenFunction r (T l)
load = Record r (Struct (Struct l)) (T l)
-> Value (Ptr (Struct (Struct l))) -> CodeGenFunction r (T l)
forall r o llvmValue.
Record r o llvmValue
-> Value (Ptr o) -> CodeGenFunction r llvmValue
Memory.loadRecord Record r (Struct (Struct l)) (T l)
forall l r. C l => Record r (Struct (Struct l)) (T l)
memory
   store :: forall r. T l -> Value (Ptr (Struct (T l))) -> CodeGenFunction r ()
store = Record r (Struct (Struct l)) (T l)
-> T l -> Value (Ptr (Struct (Struct l))) -> CodeGenFunction r ()
forall r o llvmValue.
Record r o llvmValue
-> llvmValue -> Value (Ptr o) -> CodeGenFunction r ()
Memory.storeRecord Record r (Struct (Struct l)) (T l)
forall l r. C l => Record r (Struct (Struct l)) (T l)
memory
   decompose :: forall r. Value (Struct (T l)) -> CodeGenFunction r (T l)
decompose = Record r (Struct (Struct l)) (T l)
-> Value (Struct (Struct l)) -> CodeGenFunction r (T l)
forall r o llvmValue.
Record r o llvmValue -> Value o -> CodeGenFunction r llvmValue
Memory.decomposeRecord Record r (Struct (Struct l)) (T l)
forall l r. C l => Record r (Struct (Struct l)) (T l)
memory
   compose :: forall r. T l -> CodeGenFunction r (Value (Struct (T l)))
compose = Record r (Struct (Struct l)) (T l)
-> T l -> CodeGenFunction r (Value (Struct (Struct l)))
forall o r llvmValue.
IsType o =>
Record r o llvmValue -> llvmValue -> CodeGenFunction r (Value o)
Memory.composeRecord Record r (Struct (Struct l)) (T l)
forall l r. C l => Record r (Struct (Struct l)) (T l)
memory

instance (Marshal.C l) => Marshal.C (BM.T l) where
   pack :: T l -> Struct (T l)
pack (BM.Cons l
bend l
depth) = (l, l) -> Struct (l, l)
forall a. C a => a -> Struct a
Marshal.pack (l
bend, l
depth)
   unpack :: Struct (T l) -> T l
unpack = (l -> l -> T l) -> (l, l) -> T l
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry l -> l -> T l
forall a. a -> a -> T a
BM.Cons ((l, l) -> T l)
-> (Struct (Struct l) -> (l, l)) -> Struct (Struct l) -> T l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct (l, l) -> (l, l)
Struct (Struct l) -> (l, l)
forall a. C a => Struct a -> a
Marshal.unpack

instance (Storable.C l) => Storable.C (BM.T l) where
   load :: forall r. Value (Ptr (T l)) -> CodeGenFunction r (ValueOf (T l))
load = Value (Ptr (T l)) -> CodeGenFunction r (ValueOf (T l))
Value (Ptr (T l)) -> CodeGenFunction r (T (ValueOf l))
forall (f :: * -> *) a al r.
(Applicative f, Traversable f, C a, ValueOf a ~ al) =>
Value (Ptr (f a)) -> CodeGenFunction r (f al)
Storable.loadApplicative
   store :: forall r.
ValueOf (T l) -> Value (Ptr (T l)) -> CodeGenFunction r ()
store = ValueOf (T l) -> Value (Ptr (T l)) -> CodeGenFunction r ()
T (ValueOf l) -> Value (Ptr (T l)) -> CodeGenFunction r ()
forall (f :: * -> *) a al r.
(Foldable f, C a, ValueOf a ~ al) =>
f al -> Value (Ptr (f a)) -> CodeGenFunction r ()
Storable.storeFoldable

instance (Tuple.Phi a) => Tuple.Phi (BM.T a) where
   phi :: forall r. BasicBlock -> T a -> CodeGenFunction r (T a)
phi = BasicBlock -> T a -> CodeGenFunction r (T a)
forall a (f :: * -> *) r.
(Phi a, Traversable f) =>
BasicBlock -> f a -> CodeGenFunction r (f a)
Tuple.phiTraversable
   addPhi :: forall r. BasicBlock -> T a -> T a -> CodeGenFunction r ()
addPhi = BasicBlock -> T a -> T a -> CodeGenFunction r ()
forall a (f :: * -> *) r.
(Phi a, Foldable f, Applicative f) =>
BasicBlock -> f a -> f a -> CodeGenFunction r ()
Tuple.addPhiFoldable


instance (Vector.Simple v) => Vector.Simple (BM.T v) where
   type Element (BM.T v) = BM.T (Vector.Element v)
   type Size (BM.T v) = Vector.Size v
   shuffleMatch :: forall r.
ConstValue (Vector (Size (T v)) Word32)
-> T v -> CodeGenFunction r (T v)
shuffleMatch = ConstValue (Vector (Size v) Word32)
-> T v -> CodeGenFunction r (T v)
ConstValue (Vector (Size (T v)) Word32)
-> T v -> CodeGenFunction r (T v)
forall v (f :: * -> *) r.
(Simple v, Traversable f) =>
ConstValue (Vector (Size v) Word32)
-> f v -> CodeGenFunction r (f v)
Vector.shuffleMatchTraversable
   extract :: forall r. Value Word32 -> T v -> CodeGenFunction r (Element (T v))
extract = Value Word32 -> T v -> CodeGenFunction r (Element (T v))
Value Word32 -> T v -> CodeGenFunction r (T (Element v))
forall v (f :: * -> *) r.
(Simple v, Traversable f) =>
Value Word32 -> f v -> CodeGenFunction r (f (Element v))
Vector.extractTraversable

instance (Vector.C v) => Vector.C (BM.T v) where
   insert :: forall r.
Value Word32 -> Element (T v) -> T v -> CodeGenFunction r (T v)
insert  = Value Word32 -> Element (T v) -> T v -> CodeGenFunction r (T v)
Value Word32 -> T (Element v) -> T v -> CodeGenFunction r (T v)
forall v (f :: * -> *) r.
(C v, Traversable f, Applicative f) =>
Value Word32 -> f (Element v) -> f v -> CodeGenFunction r (f v)
Vector.insertTraversable


type instance F.Arguments f (BM.T a) = f (BM.T a)
instance F.MakeArguments (BM.T a) where
   makeArgs :: forall (f :: * -> *). Functor f => f (T a) -> Arguments f (T a)
makeArgs = f (T a) -> f (T a)
f (T a) -> Arguments f (T a)
forall a. a -> a
id