{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
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