{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Synthesizer.LLVM.Storable.Signal (
unpackStrict, unpack,
unpackStereoStrict, unpackStereo,
makeReversePackedStrict, makeReversePacked,
continue, continuePacked, continuePackedGeneric,
fillBuffer, makeMixer,
makeArranger,
) where
import qualified Synthesizer.LLVM.Frame.SerialVector.Code as Serial
import qualified Synthesizer.LLVM.Frame.StereoInterleaved as StereoVector
import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
import qualified Data.StorableVector.Lazy as SVL
import qualified Data.StorableVector as SV
import qualified Data.StorableVector.Base as SVB
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Data.EventList.Relative.TimeMixed as EventListTM
import qualified Data.EventList.Absolute.TimeBody as AbsEventList
import qualified Number.NonNegative as NonNeg
import qualified LLVM.DSL.Execution as Exec
import qualified LLVM.Extra.Multi.Value.Storable as Storable
import qualified LLVM.Extra.Multi.Value as MultiValue
import qualified LLVM.Core as LLVM
import qualified Type.Data.Num.Decimal as TypeNum
import Control.Monad.HT (void)
import Foreign.Marshal.Array (advancePtr)
import Foreign.ForeignPtr (castForeignPtr)
import Foreign.Storable (Storable)
import Foreign.Ptr (Ptr)
import qualified System.Unsafe as Unsafe
unpackChunk ::
(Storable.C a, TypeNum.Positive n) =>
SV.Vector (Serial.T n a) -> SV.Vector a
unpackChunk :: forall a n. (C a, Positive n) => Vector (T n a) -> Vector a
unpackChunk Vector (T n a)
v =
let getDim ::
(TypeNum.Positive n) =>
SV.Vector (Serial.T n a) -> TypeNum.Singleton n -> Int
getDim :: forall n a. Positive n => Vector (T n a) -> Singleton n -> Int
getDim Vector (T n a)
_ = Singleton n -> Int
forall n a. (Integer n, Num a) => Singleton n -> a
TypeNum.integralFromSingleton
d :: Int
d = Vector (T n a) -> Singleton n -> Int
forall n a. Positive n => Vector (T n a) -> Singleton n -> Int
getDim Vector (T n a)
v Singleton n
forall x. Integer x => Singleton x
TypeNum.singleton
(ForeignPtr (T n a)
fptr,Int
s,Int
l) = Vector (T n a) -> (ForeignPtr (T n a), Int, Int)
forall a. Vector a -> (ForeignPtr a, Int, Int)
SVB.toForeignPtr Vector (T n a)
v
in ForeignPtr a -> Int -> Int -> Vector a
forall a. ForeignPtr a -> Int -> Int -> Vector a
SVB.SV (ForeignPtr (T n a) -> ForeignPtr a
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr (T n a)
fptr) (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d)
unpackStrict ::
(TypeNum.Positive n, Storable.Vector a) =>
SV.Vector (Serial.T n a) -> SV.Vector a
unpackStrict :: forall n a. (Positive n, Vector a) => Vector (T n a) -> Vector a
unpackStrict = Vector (T n a) -> Vector a
forall a n. (C a, Positive n) => Vector (T n a) -> Vector a
unpackChunk
unpack ::
(TypeNum.Positive n, Storable.Vector a) =>
SVL.Vector (Serial.T n a) -> SVL.Vector a
unpack :: forall n a. (Positive n, Vector a) => Vector (T n a) -> Vector a
unpack = [Vector a] -> Vector a
forall a. Storable a => [Vector a] -> Vector a
SVL.fromChunks ([Vector a] -> Vector a)
-> (Vector (T n a) -> [Vector a]) -> Vector (T n a) -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (T n a) -> Vector a) -> [Vector (T n a)] -> [Vector a]
forall a b. (a -> b) -> [a] -> [b]
map Vector (T n a) -> Vector a
forall a n. (C a, Positive n) => Vector (T n a) -> Vector a
unpackChunk ([Vector (T n a)] -> [Vector a])
-> (Vector (T n a) -> [Vector (T n a)])
-> Vector (T n a)
-> [Vector a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (T n a) -> [Vector (T n a)]
forall a. Vector a -> [Vector a]
SVL.chunks
unpackStereoStrict ::
(TypeNum.Positive n, Storable.C a) =>
SV.Vector (StereoVector.T n a) -> SV.Vector (Stereo.T a)
unpackStereoStrict :: forall n a. (Positive n, C a) => Vector (T n a) -> Vector (T a)
unpackStereoStrict Vector (T n a)
v =
let getDim ::
(TypeNum.Positive n) =>
SV.Vector (StereoVector.T n a) -> TypeNum.Singleton n -> Int
getDim :: forall n a. Positive n => Vector (T n a) -> Singleton n -> Int
getDim Vector (T n a)
_ = Singleton n -> Int
forall n a. (Integer n, Num a) => Singleton n -> a
TypeNum.integralFromSingleton
d :: Int
d = Vector (T n a) -> Singleton n -> Int
forall n a. Positive n => Vector (T n a) -> Singleton n -> Int
getDim Vector (T n a)
v Singleton n
forall x. Integer x => Singleton x
TypeNum.singleton
(ForeignPtr (T n a)
fptr,Int
s,Int
l) = Vector (T n a) -> (ForeignPtr (T n a), Int, Int)
forall a. Vector a -> (ForeignPtr a, Int, Int)
SVB.toForeignPtr Vector (T n a)
v
in ForeignPtr (T a) -> Int -> Int -> Vector (T a)
forall a. ForeignPtr a -> Int -> Int -> Vector a
SVB.SV (ForeignPtr (T n a) -> ForeignPtr (T a)
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr (T n a)
fptr) (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d)
unpackStereo ::
(TypeNum.Positive n, Storable.C a) =>
SVL.Vector (StereoVector.T n a) -> SVL.Vector (Stereo.T a)
unpackStereo :: forall n a. (Positive n, C a) => Vector (T n a) -> Vector (T a)
unpackStereo =
[Vector (T a)] -> Vector (T a)
forall a. Storable a => [Vector a] -> Vector a
SVL.fromChunks ([Vector (T a)] -> Vector (T a))
-> (Vector (T n a) -> [Vector (T a)])
-> Vector (T n a)
-> Vector (T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (T n a) -> Vector (T a))
-> [Vector (T n a)] -> [Vector (T a)]
forall a b. (a -> b) -> [a] -> [b]
map Vector (T n a) -> Vector (T a)
forall n a. (Positive n, C a) => Vector (T n a) -> Vector (T a)
unpackStereoStrict ([Vector (T n a)] -> [Vector (T a)])
-> (Vector (T n a) -> [Vector (T n a)])
-> Vector (T n a)
-> [Vector (T a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (T n a) -> [Vector (T n a)]
forall a. Vector a -> [Vector a]
SVL.chunks
makeReverser ::
(Storable.C a, MultiValue.T a ~ value) =>
(value -> LLVM.CodeGenFunction () value) ->
IO (Word -> Ptr a -> Ptr a -> IO ())
makeReverser :: forall a value.
(C a, T a ~ value) =>
(value -> CodeGenFunction () value)
-> IO (Word -> Ptr a -> Ptr a -> IO ())
makeReverser value -> CodeGenFunction () value
rev =
String
-> Exec (Word -> Ptr a -> Ptr a -> IO ())
-> IO (Word -> Ptr a -> Ptr a -> IO ())
forall funcs. String -> Exec funcs -> IO funcs
Exec.compile String
"reverse" (Exec (Word -> Ptr a -> Ptr a -> IO ())
-> IO (Word -> Ptr a -> Ptr a -> IO ()))
-> Exec (Word -> Ptr a -> Ptr a -> IO ())
-> IO (Word -> Ptr a -> Ptr a -> IO ())
forall a b. (a -> b) -> a -> b
$
Importer (Word -> Ptr a -> Ptr a -> IO ())
-> String
-> CodeGen (Word -> Ptr a -> Ptr a -> IO ())
-> Exec (Word -> Ptr a -> Ptr a -> IO ())
forall f.
(ExecutionFunction f, C f) =>
Importer f -> String -> CodeGen f -> Exec f
Exec.createFunction Importer (Word -> Ptr a -> Ptr a -> IO ())
forall a. Importer (Word -> Ptr a -> Ptr a -> IO ())
derefMixPtr String
"reverse" (CodeGen (Word -> Ptr a -> Ptr a -> IO ())
-> Exec (Word -> Ptr a -> Ptr a -> IO ()))
-> CodeGen (Word -> Ptr a -> Ptr a -> IO ())
-> Exec (Word -> Ptr a -> Ptr a -> IO ())
forall a b. (a -> b) -> a -> b
$ \ Value Word
size Value (Ptr a)
ptrA Value (Ptr a)
ptrB -> do
Value Int
sizeInt <- Value Word -> CodeGenFunction () (Value Int)
forall (value :: * -> *) a b r.
(ValueCons value, IsSized a, IsSized b, SizeOf a ~ SizeOf b) =>
value a -> CodeGenFunction r (value b)
LLVM.bitcast Value Word
size
Value (Ptr a)
ptrAEnd <- Value Int -> Value (Ptr a) -> CodeGenFunction () (Value (Ptr a))
forall a ptr r.
(Storable a, Value (Ptr a) ~ ptr) =>
Value Int -> ptr -> CodeGenFunction r ptr
Storable.advancePtr Value Int
sizeInt Value (Ptr a)
ptrA
CodeGenFunction () (Value (Ptr a)) -> CodeGenFunction () ()
forall (m :: * -> *) a. Monad m => m a -> m ()
void (CodeGenFunction () (Value (Ptr a)) -> CodeGenFunction () ())
-> CodeGenFunction () (Value (Ptr a)) -> CodeGenFunction () ()
forall a b. (a -> b) -> a -> b
$ Value Word
-> Value (Ptr a)
-> Value (Ptr a)
-> (Value (Ptr a)
-> Value (Ptr a) -> CodeGenFunction () (Value (Ptr a)))
-> CodeGenFunction () (Value (Ptr a))
forall s i a ptrA r.
(Phi s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i,
Storable a, Value (Ptr a) ~ ptrA) =>
Value i
-> ptrA
-> s
-> (ptrA -> s -> CodeGenFunction r s)
-> CodeGenFunction r s
Storable.arrayLoop Value Word
size Value (Ptr a)
ptrB Value (Ptr a)
ptrAEnd ((Value (Ptr a)
-> Value (Ptr a) -> CodeGenFunction () (Value (Ptr a)))
-> CodeGenFunction () (Value (Ptr a)))
-> (Value (Ptr a)
-> Value (Ptr a) -> CodeGenFunction () (Value (Ptr a)))
-> CodeGenFunction () (Value (Ptr a))
forall a b. (a -> b) -> a -> b
$ \ Value (Ptr a)
ptrBi Value (Ptr a)
ptrAj0 -> do
Value (Ptr a)
ptrAj1 <- Value (Ptr a) -> CodeGenFunction () (Value (Ptr a))
forall a ptr r.
(Storable a, Value (Ptr a) ~ ptr) =>
ptr -> CodeGenFunction r ptr
Storable.decrementPtr Value (Ptr a)
ptrAj0
(T a -> Value (Ptr a) -> CodeGenFunction () ())
-> Value (Ptr a) -> T a -> CodeGenFunction () ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip T a -> Value (Ptr a) -> CodeGenFunction () ()
forall r. T a -> Value (Ptr a) -> CodeGenFunction r ()
forall a r. C a => T a -> Value (Ptr a) -> CodeGenFunction r ()
Storable.store Value (Ptr a)
ptrBi
(T a -> CodeGenFunction () ())
-> CodeGenFunction () (T a) -> CodeGenFunction () ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< value -> CodeGenFunction () value
value -> CodeGenFunction () (T a)
rev
(value -> CodeGenFunction () (T a))
-> CodeGenFunction () value -> CodeGenFunction () (T a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Ptr a) -> CodeGenFunction () (T a)
forall a r. C a => Value (Ptr a) -> CodeGenFunction r (T a)
forall r. Value (Ptr a) -> CodeGenFunction r (T a)
Storable.load Value (Ptr a)
ptrAj1
Value (Ptr a) -> CodeGenFunction () (Value (Ptr a))
forall a. a -> CodeGenFunction () a
forall (m :: * -> *) a. Monad m => a -> m a
return Value (Ptr a)
ptrAj1
makeReversePackedStrict ::
(TypeNum.Positive n, Storable.Vector a, v ~ Serial.T n a) =>
IO (SV.Vector v -> SV.Vector v)
makeReversePackedStrict :: forall n a v.
(Positive n, Vector a, v ~ T n a) =>
IO (Vector v -> Vector v)
makeReversePackedStrict = do
Word -> Ptr v -> Ptr v -> IO ()
rev <- (Value n a -> CodeGenFunction () (Value n a))
-> IO (Word -> Ptr v -> Ptr v -> IO ())
forall a value.
(C a, T a ~ value) =>
(value -> CodeGenFunction () value)
-> IO (Word -> Ptr a -> Ptr a -> IO ())
makeReverser Value n a -> CodeGenFunction () (Value n a)
forall n a r.
(Positive n, C a) =>
Value n a -> CodeGenFunction r (Value n a)
Serial.reverse
(Vector v -> Vector v) -> IO (Vector v -> Vector v)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Vector v -> Vector v) -> IO (Vector v -> Vector v))
-> (Vector v -> Vector v) -> IO (Vector v -> Vector v)
forall a b. (a -> b) -> a -> b
$ \Vector v
v ->
IO (Vector v) -> Vector v
forall a. IO a -> a
Unsafe.performIO (IO (Vector v) -> Vector v) -> IO (Vector v) -> Vector v
forall a b. (a -> b) -> a -> b
$
Vector v -> (Ptr v -> Int -> IO (Vector v)) -> IO (Vector v)
forall a b.
Storable a =>
Vector a -> (Ptr a -> Int -> IO b) -> IO b
SVB.withStartPtr Vector v
v ((Ptr v -> Int -> IO (Vector v)) -> IO (Vector v))
-> (Ptr v -> Int -> IO (Vector v)) -> IO (Vector v)
forall a b. (a -> b) -> a -> b
$ \Ptr v
ptrA Int
len ->
Int -> (Ptr v -> IO ()) -> IO (Vector v)
forall a. Storable a => Int -> (Ptr a -> IO ()) -> IO (Vector a)
SVB.create Int
len ((Ptr v -> IO ()) -> IO (Vector v))
-> (Ptr v -> IO ()) -> IO (Vector v)
forall a b. (a -> b) -> a -> b
$ \Ptr v
ptrB ->
Word -> Ptr v -> Ptr v -> IO ()
rev (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr v
ptrA Ptr v
ptrB
makeReversePacked ::
(TypeNum.Positive n, Storable.Vector a, v ~ Serial.T n a) =>
IO (SVL.Vector v -> SVL.Vector v)
makeReversePacked :: forall n a v.
(Positive n, Vector a, v ~ T n a) =>
IO (Vector v -> Vector v)
makeReversePacked =
((Vector v -> Vector v) -> Vector v -> Vector v)
-> IO (Vector v -> Vector v) -> IO (Vector v -> Vector v)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Vector v -> Vector v
f -> [Vector v] -> Vector v
forall a. Storable a => [Vector a] -> Vector a
SVL.fromChunks ([Vector v] -> Vector v)
-> (Vector v -> [Vector v]) -> Vector v -> Vector v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vector v] -> [Vector v]
forall a. [a] -> [a]
reverse ([Vector v] -> [Vector v])
-> (Vector v -> [Vector v]) -> Vector v -> [Vector v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector v -> Vector v) -> [Vector v] -> [Vector v]
forall a b. (a -> b) -> [a] -> [b]
map Vector v -> Vector v
f ([Vector v] -> [Vector v])
-> (Vector v -> [Vector v]) -> Vector v -> [Vector v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector v -> [Vector v]
forall a. Vector a -> [Vector a]
SVL.chunks) (IO (Vector v -> Vector v) -> IO (Vector v -> Vector v))
-> IO (Vector v -> Vector v) -> IO (Vector v -> Vector v)
forall a b. (a -> b) -> a -> b
$
IO (Vector v -> Vector v)
forall n a v.
(Positive n, Vector a, v ~ T n a) =>
IO (Vector v -> Vector v)
makeReversePackedStrict
continue ::
(Storable a) =>
SVL.Vector a -> (a -> SVL.Vector a) -> SVL.Vector a
continue :: forall a. Storable a => Vector a -> (a -> Vector a) -> Vector a
continue Vector a
x a -> Vector a
y =
[Vector a] -> Vector a
forall a. Storable a => [Vector a] -> Vector a
SVL.fromChunks ([Vector a] -> Vector a) -> [Vector a] -> Vector a
forall a b. (a -> b) -> a -> b
$
Vector a -> [Vector a] -> (Vector a -> [Vector a]) -> [Vector a]
forall a. a -> [a] -> (a -> [a]) -> [a]
withLast Vector a
forall a. Storable a => Vector a
SV.empty
(Vector a -> [Vector a]
forall a. Vector a -> [Vector a]
SVL.chunks Vector a
x)
([Vector a]
-> (Vector a -> a -> [Vector a]) -> Vector a -> [Vector a]
forall a b.
Storable a =>
b -> (Vector a -> a -> b) -> Vector a -> b
SV.switchR [] ((Vector a -> a -> [Vector a]) -> Vector a -> [Vector a])
-> (Vector a -> a -> [Vector a]) -> Vector a -> [Vector a]
forall a b. (a -> b) -> a -> b
$ \Vector a
_ -> Vector a -> [Vector a]
forall a. Vector a -> [Vector a]
SVL.chunks (Vector a -> [Vector a]) -> (a -> Vector a) -> a -> [Vector a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Vector a
y)
continuePacked ::
(TypeNum.Positive n, Storable.Vector a) =>
SVL.Vector (Serial.T n a) ->
(a -> SVL.Vector (Serial.T n a)) ->
SVL.Vector (Serial.T n a)
continuePacked :: forall n a.
(Positive n, Vector a) =>
Vector (T n a) -> (a -> Vector (T n a)) -> Vector (T n a)
continuePacked Vector (T n a)
x a -> Vector (T n a)
y =
[Vector (T n a)] -> Vector (T n a)
forall a. Storable a => [Vector a] -> Vector a
SVL.fromChunks ([Vector (T n a)] -> Vector (T n a))
-> [Vector (T n a)] -> Vector (T n a)
forall a b. (a -> b) -> a -> b
$
Vector (T n a)
-> [Vector (T n a)]
-> (Vector (T n a) -> [Vector (T n a)])
-> [Vector (T n a)]
forall a. a -> [a] -> (a -> [a]) -> [a]
withLast Vector (T n a)
forall a. Storable a => Vector a
SV.empty
(Vector (T n a) -> [Vector (T n a)]
forall a. Vector a -> [Vector a]
SVL.chunks Vector (T n a)
x)
([Vector (T n a)]
-> (Vector a -> a -> [Vector (T n a)])
-> Vector a
-> [Vector (T n a)]
forall a b.
Storable a =>
b -> (Vector a -> a -> b) -> Vector a -> b
SV.switchR [] (\Vector a
_ -> Vector (T n a) -> [Vector (T n a)]
forall a. Vector a -> [Vector a]
SVL.chunks (Vector (T n a) -> [Vector (T n a)])
-> (a -> Vector (T n a)) -> a -> [Vector (T n a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Vector (T n a)
y) (Vector a -> [Vector (T n a)])
-> (Vector (T n a) -> Vector a)
-> Vector (T n a)
-> [Vector (T n a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (T n a) -> Vector a
forall n a. (Positive n, Vector a) => Vector (T n a) -> Vector a
unpackStrict)
continuePackedGeneric ::
(Storable v, Storable a) =>
(SV.Vector v -> SV.Vector a) ->
SVL.Vector v -> (a -> SVL.Vector v) -> SVL.Vector v
continuePackedGeneric :: forall v a.
(Storable v, Storable a) =>
(Vector v -> Vector a) -> Vector v -> (a -> Vector v) -> Vector v
continuePackedGeneric Vector v -> Vector a
unpackGeneric Vector v
x a -> Vector v
y =
[Vector v] -> Vector v
forall a. Storable a => [Vector a] -> Vector a
SVL.fromChunks ([Vector v] -> Vector v) -> [Vector v] -> Vector v
forall a b. (a -> b) -> a -> b
$
Vector v -> [Vector v] -> (Vector v -> [Vector v]) -> [Vector v]
forall a. a -> [a] -> (a -> [a]) -> [a]
withLast Vector v
forall a. Storable a => Vector a
SV.empty
(Vector v -> [Vector v]
forall a. Vector a -> [Vector a]
SVL.chunks Vector v
x)
(\Vector v
lastChunk ->
[Vector v]
-> (Vector a -> a -> [Vector v]) -> Vector a -> [Vector v]
forall a b.
Storable a =>
b -> (Vector a -> a -> b) -> Vector a -> b
SV.switchR [] (\Vector a
_ -> Vector v -> [Vector v]
forall a. Vector a -> [Vector a]
SVL.chunks (Vector v -> [Vector v]) -> (a -> Vector v) -> a -> [Vector v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Vector v
y) (Vector a -> [Vector v]) -> Vector a -> [Vector v]
forall a b. (a -> b) -> a -> b
$ Vector v -> Vector a
unpackGeneric (Vector v -> Vector a) -> Vector v -> Vector a
forall a b. (a -> b) -> a -> b
$
Int -> Vector v -> Vector v
forall a. Storable a => Int -> Vector a -> Vector a
SV.drop (Vector v -> Int
forall a. Vector a -> Int
SV.length Vector v
lastChunk Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Vector v -> Vector v) -> Vector v -> Vector v
forall a b. (a -> b) -> a -> b
$ Vector v
lastChunk)
withLast :: a -> [a] -> (a -> [a]) -> [a]
withLast :: forall a. a -> [a] -> (a -> [a]) -> [a]
withLast a
deflt [a]
x a -> [a]
y =
(a -> (a -> [a]) -> a -> [a]) -> (a -> [a]) -> [a] -> a -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\a
a a -> [a]
cont a
_ -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a]
cont a
a)
a -> [a]
y [a]
x a
deflt
foreign import ccall safe "dynamic" derefFillPtr ::
Exec.Importer (Word -> Ptr a -> IO ())
fillBuffer ::
(Storable.C a, MultiValue.T a ~ value) =>
value -> IO (Word -> Ptr a -> IO ())
fillBuffer :: forall a value.
(C a, T a ~ value) =>
value -> IO (Word -> Ptr a -> IO ())
fillBuffer value
x =
String
-> Exec (Word -> Ptr a -> IO ()) -> IO (Word -> Ptr a -> IO ())
forall funcs. String -> Exec funcs -> IO funcs
Exec.compile String
"constant" (Exec (Word -> Ptr a -> IO ()) -> IO (Word -> Ptr a -> IO ()))
-> Exec (Word -> Ptr a -> IO ()) -> IO (Word -> Ptr a -> IO ())
forall a b. (a -> b) -> a -> b
$
Importer (Word -> Ptr a -> IO ())
-> String
-> CodeGen (Word -> Ptr a -> IO ())
-> Exec (Word -> Ptr a -> IO ())
forall f.
(ExecutionFunction f, C f) =>
Importer f -> String -> CodeGen f -> Exec f
Exec.createFunction Importer (Word -> Ptr a -> IO ())
forall a. Importer (Word -> Ptr a -> IO ())
derefFillPtr String
"constantfill" (CodeGen (Word -> Ptr a -> IO ()) -> Exec (Word -> Ptr a -> IO ()))
-> CodeGen (Word -> Ptr a -> IO ())
-> Exec (Word -> Ptr a -> IO ())
forall a b. (a -> b) -> a -> b
$ \ Value Word
size Value (Ptr a)
ptr ->
Value Word
-> Value (Ptr a)
-> ()
-> (Value (Ptr a) -> () -> CodeGenFunction () ())
-> CodeGenFunction () ()
forall s i a ptrA r.
(Phi s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i,
Storable a, Value (Ptr a) ~ ptrA) =>
Value i
-> ptrA
-> s
-> (ptrA -> s -> CodeGenFunction r s)
-> CodeGenFunction r s
Storable.arrayLoop Value Word
size Value (Ptr a)
ptr () ((Value (Ptr a) -> () -> CodeGenFunction () ())
-> CodeGenFunction () ())
-> (Value (Ptr a) -> () -> CodeGenFunction () ())
-> CodeGenFunction () ()
forall a b. (a -> b) -> a -> b
$ \ Value (Ptr a)
ptri () -> T a -> Value (Ptr a) -> CodeGenFunction () ()
forall r. T a -> Value (Ptr a) -> CodeGenFunction r ()
forall a r. C a => T a -> Value (Ptr a) -> CodeGenFunction r ()
Storable.store value
T a
x Value (Ptr a)
ptri
foreign import ccall safe "dynamic" derefMixPtr ::
Exec.Importer (Word -> Ptr a -> Ptr a -> IO ())
makeMixer ::
(Storable.C a, MultiValue.T a ~ value) =>
(value -> value -> LLVM.CodeGenFunction () value) ->
IO (Word -> Ptr a -> Ptr a -> IO ())
makeMixer :: forall a value.
(C a, T a ~ value) =>
(value -> value -> CodeGenFunction () value)
-> IO (Word -> Ptr a -> Ptr a -> IO ())
makeMixer value -> value -> CodeGenFunction () value
add =
String
-> Exec (Word -> Ptr a -> Ptr a -> IO ())
-> IO (Word -> Ptr a -> Ptr a -> IO ())
forall funcs. String -> Exec funcs -> IO funcs
Exec.compile String
"mixer" (Exec (Word -> Ptr a -> Ptr a -> IO ())
-> IO (Word -> Ptr a -> Ptr a -> IO ()))
-> Exec (Word -> Ptr a -> Ptr a -> IO ())
-> IO (Word -> Ptr a -> Ptr a -> IO ())
forall a b. (a -> b) -> a -> b
$
Importer (Word -> Ptr a -> Ptr a -> IO ())
-> String
-> CodeGen (Word -> Ptr a -> Ptr a -> IO ())
-> Exec (Word -> Ptr a -> Ptr a -> IO ())
forall f.
(ExecutionFunction f, C f) =>
Importer f -> String -> CodeGen f -> Exec f
Exec.createFunction Importer (Word -> Ptr a -> Ptr a -> IO ())
forall a. Importer (Word -> Ptr a -> Ptr a -> IO ())
derefMixPtr String
"mix" (CodeGen (Word -> Ptr a -> Ptr a -> IO ())
-> Exec (Word -> Ptr a -> Ptr a -> IO ()))
-> CodeGen (Word -> Ptr a -> Ptr a -> IO ())
-> Exec (Word -> Ptr a -> Ptr a -> IO ())
forall a b. (a -> b) -> a -> b
$ \ Value Word
size Value (Ptr a)
srcPtr Value (Ptr a)
dstPtr ->
CodeGenFunction () () -> CodeGenFunction () ()
forall (m :: * -> *) a. Monad m => m a -> m ()
void (CodeGenFunction () () -> CodeGenFunction () ())
-> CodeGenFunction () () -> CodeGenFunction () ()
forall a b. (a -> b) -> a -> b
$ Value Word
-> Value (Ptr a)
-> Value (Ptr a)
-> ()
-> (Value (Ptr a) -> Value (Ptr a) -> () -> CodeGenFunction () ())
-> CodeGenFunction () ()
forall s i a ptrA b ptrB r.
(Phi s, Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i,
Storable a, Value (Ptr a) ~ ptrA, Storable b,
Value (Ptr b) ~ ptrB) =>
Value i
-> ptrA
-> ptrB
-> s
-> (ptrA -> ptrB -> s -> CodeGenFunction r s)
-> CodeGenFunction r s
Storable.arrayLoop2 Value Word
size Value (Ptr a)
srcPtr Value (Ptr a)
dstPtr () ((Value (Ptr a) -> Value (Ptr a) -> () -> CodeGenFunction () ())
-> CodeGenFunction () ())
-> (Value (Ptr a) -> Value (Ptr a) -> () -> CodeGenFunction () ())
-> CodeGenFunction () ()
forall a b. (a -> b) -> a -> b
$
\Value (Ptr a)
srcPtri Value (Ptr a)
dstPtri () -> do
T a
y <- Value (Ptr a) -> CodeGenFunction () (T a)
forall a r. C a => Value (Ptr a) -> CodeGenFunction r (T a)
forall r. Value (Ptr a) -> CodeGenFunction r (T a)
Storable.load Value (Ptr a)
srcPtri
(value -> CodeGenFunction () value)
-> Value (Ptr a) -> CodeGenFunction () ()
forall a al r.
(C a, T a ~ al) =>
(al -> CodeGenFunction r al)
-> Value (Ptr a) -> CodeGenFunction r ()
Storable.modify (value -> value -> CodeGenFunction () value
add value
T a
y) Value (Ptr a)
dstPtri
addToBuffer ::
(Storable a) =>
(Word -> Ptr a -> Ptr a -> IO ()) ->
Int -> Ptr a -> Int -> SVL.Vector a -> IO (Int, SVL.Vector a)
addToBuffer :: forall a.
Storable a =>
(Word -> Ptr a -> Ptr a -> IO ())
-> Int -> Ptr a -> Int -> Vector a -> IO (Int, Vector a)
addToBuffer Word -> Ptr a -> Ptr a -> IO ()
addChunkToBuffer Int
len Ptr a
v Int
start Vector a
xs =
let (Vector a
now,Vector a
future) = Int -> Vector a -> (Vector a, Vector a)
forall a. Storable a => Int -> Vector a -> (Vector a, Vector a)
SVL.splitAt (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start) Vector a
xs
go :: Int -> [Vector a] -> IO Int
go Int
i [] = Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
go Int
i (Vector a
c:[Vector a]
cs) =
Vector a -> (Ptr a -> Int -> IO ()) -> IO ()
forall a b.
Storable a =>
Vector a -> (Ptr a -> Int -> IO b) -> IO b
SVB.withStartPtr Vector a
c (\Ptr a
ptr Int
l ->
Word -> Ptr a -> Ptr a -> IO ()
addChunkToBuffer (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) Ptr a
ptr (Ptr a -> Int -> Ptr a
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr a
v Int
i)) IO () -> IO Int -> IO Int
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Int -> [Vector a] -> IO Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector a -> Int
forall a. Vector a -> Int
SV.length Vector a
c) [Vector a]
cs
in (Int -> (Int, Vector a)) -> IO Int -> IO (Int, Vector a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Vector a -> (Int, Vector a))
-> Vector a -> Int -> (Int, Vector a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Vector a
future) (IO Int -> IO (Int, Vector a))
-> (Vector a -> IO Int) -> Vector a -> IO (Int, Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Vector a] -> IO Int
go Int
start ([Vector a] -> IO Int)
-> (Vector a -> [Vector a]) -> Vector a -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [Vector a]
forall a. Vector a -> [Vector a]
SVL.chunks (Vector a -> IO (Int, Vector a)) -> Vector a -> IO (Int, Vector a)
forall a b. (a -> b) -> a -> b
$ Vector a
now
makeArranger ::
(Storable.C a, MultiValue.Additive a) =>
IO (SVL.ChunkSize ->
EventList.T NonNeg.Int (SVL.Vector a) ->
SVL.Vector a)
makeArranger :: forall a.
(C a, Additive a) =>
IO (ChunkSize -> T Int (Vector a) -> Vector a)
makeArranger = do
Word -> Ptr a -> Ptr a -> IO ()
mixer <- (T a -> T a -> CodeGenFunction () (T a))
-> IO (Word -> Ptr a -> Ptr a -> IO ())
forall a value.
(C a, T a ~ value) =>
(value -> value -> CodeGenFunction () value)
-> IO (Word -> Ptr a -> Ptr a -> IO ())
makeMixer T a -> T a -> CodeGenFunction () (T a)
forall a r. Additive a => T a -> T a -> CodeGenFunction r (T a)
forall r. T a -> T a -> CodeGenFunction r (T a)
MultiValue.add
Word -> Ptr a -> IO ()
fill <- T a -> IO (Word -> Ptr a -> IO ())
forall a value.
(C a, T a ~ value) =>
value -> IO (Word -> Ptr a -> IO ())
fillBuffer T a
forall a. C a => T a
MultiValue.zero
(ChunkSize -> T Int (Vector a) -> Vector a)
-> IO (ChunkSize -> T Int (Vector a) -> Vector a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ChunkSize -> T Int (Vector a) -> Vector a)
-> IO (ChunkSize -> T Int (Vector a) -> Vector a))
-> (ChunkSize -> T Int (Vector a) -> Vector a)
-> IO (ChunkSize -> T Int (Vector a) -> Vector a)
forall a b. (a -> b) -> a -> b
$ \ (SVL.ChunkSize Int
sz) ->
let sznn :: Int
sznn = String -> Int -> Int
forall a. (Ord a, C a) => String -> a -> T a
NonNeg.fromNumberMsg String
"arrange" Int
sz
go :: [Vector a] -> T Int (Vector a) -> [Vector a]
go [Vector a]
acc T Int (Vector a)
evs =
let (T Int (Vector a)
now,T Int (Vector a)
future) = Int -> T Int (Vector a) -> (T Int (Vector a), T Int (Vector a))
forall time body.
C time =>
time -> T time body -> (T time body, T time body)
EventListTM.splitAtTime Int
sznn T Int (Vector a)
evs
xs :: [(Int, Vector a)]
xs =
T Int (Vector a) -> [(Int, Vector a)]
forall a b. T a b -> [(a, b)]
AbsEventList.toPairList (T Int (Vector a) -> [(Int, Vector a)])
-> T Int (Vector a) -> [(Int, Vector a)]
forall a b. (a -> b) -> a -> b
$
Int -> T Int (Vector a) -> T Int (Vector a)
forall time body. Num time => time -> T time body -> T time body
EventList.toAbsoluteEventList Int
0 (T Int (Vector a) -> T Int (Vector a))
-> T Int (Vector a) -> T Int (Vector a)
forall a b. (a -> b) -> a -> b
$
(T Int (Vector a) -> Int -> T Int (Vector a))
-> T Int (Vector a) -> T Int (Vector a)
forall time body a. (T time body -> time -> a) -> T time body -> a
EventListTM.switchTimeR T Int (Vector a) -> Int -> T Int (Vector a)
forall a b. a -> b -> a
const T Int (Vector a)
now
(Vector a
chunk,[Vector a]
newAcc) =
IO (Vector a, [Vector a]) -> (Vector a, [Vector a])
forall a. IO a -> a
Unsafe.performIO (IO (Vector a, [Vector a]) -> (Vector a, [Vector a]))
-> IO (Vector a, [Vector a]) -> (Vector a, [Vector a])
forall a b. (a -> b) -> a -> b
$
Int
-> (Ptr a -> IO (Int, Int, [Vector a]))
-> IO (Vector a, [Vector a])
forall a b.
Storable a =>
Int -> (Ptr a -> IO (Int, Int, b)) -> IO (Vector a, b)
SVB.createAndTrim' Int
sz ((Ptr a -> IO (Int, Int, [Vector a])) -> IO (Vector a, [Vector a]))
-> (Ptr a -> IO (Int, Int, [Vector a]))
-> IO (Vector a, [Vector a])
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> do
Word -> Ptr a -> IO ()
fill (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) Ptr a
ptr
[(Int, Vector a)]
newAcc0 <- ((Vector a -> IO (Int, Vector a))
-> [Vector a] -> IO [(Int, Vector a)])
-> [Vector a]
-> (Vector a -> IO (Int, Vector a))
-> IO [(Int, Vector a)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Vector a -> IO (Int, Vector a))
-> [Vector a] -> IO [(Int, Vector a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Vector a]
acc ((Vector a -> IO (Int, Vector a)) -> IO [(Int, Vector a)])
-> (Vector a -> IO (Int, Vector a)) -> IO [(Int, Vector a)]
forall a b. (a -> b) -> a -> b
$ (Word -> Ptr a -> Ptr a -> IO ())
-> Int -> Ptr a -> Int -> Vector a -> IO (Int, Vector a)
forall a.
Storable a =>
(Word -> Ptr a -> Ptr a -> IO ())
-> Int -> Ptr a -> Int -> Vector a -> IO (Int, Vector a)
addToBuffer Word -> Ptr a -> Ptr a -> IO ()
mixer Int
sz Ptr a
ptr Int
0
[(Int, Vector a)]
newAcc1 <- (((Int, Vector a) -> IO (Int, Vector a))
-> [(Int, Vector a)] -> IO [(Int, Vector a)])
-> [(Int, Vector a)]
-> ((Int, Vector a) -> IO (Int, Vector a))
-> IO [(Int, Vector a)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int, Vector a) -> IO (Int, Vector a))
-> [(Int, Vector a)] -> IO [(Int, Vector a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [(Int, Vector a)]
xs (((Int, Vector a) -> IO (Int, Vector a)) -> IO [(Int, Vector a)])
-> ((Int, Vector a) -> IO (Int, Vector a)) -> IO [(Int, Vector a)]
forall a b. (a -> b) -> a -> b
$ \(Int
i,Vector a
s) ->
(Word -> Ptr a -> Ptr a -> IO ())
-> Int -> Ptr a -> Int -> Vector a -> IO (Int, Vector a)
forall a.
Storable a =>
(Word -> Ptr a -> Ptr a -> IO ())
-> Int -> Ptr a -> Int -> Vector a -> IO (Int, Vector a)
addToBuffer Word -> Ptr a -> Ptr a -> IO ()
mixer Int
sz Ptr a
ptr (Int -> Int
forall a. T a -> a
NonNeg.toNumber Int
i) Vector a
s
let ([Int]
ends, [Vector a]
suffixes) = [(Int, Vector a)] -> ([Int], [Vector a])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Int, Vector a)] -> ([Int], [Vector a]))
-> [(Int, Vector a)] -> ([Int], [Vector a])
forall a b. (a -> b) -> a -> b
$ [(Int, Vector a)]
newAcc0[(Int, Vector a)] -> [(Int, Vector a)] -> [(Int, Vector a)]
forall a. [a] -> [a] -> [a]
++[(Int, Vector a)]
newAcc1
len :: Int
len =
if T Int (Vector a) -> Bool
forall time body. T time body -> Bool
EventList.null T Int (Vector a)
future
then (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 [Int]
ends
else Int
sz
(Int, Int, [Vector a]) -> IO (Int, Int, [Vector a])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, Int
len,
(Vector a -> Bool) -> [Vector a] -> [Vector a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Vector a -> Bool) -> Vector a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> Bool
forall a. Storable a => Vector a -> Bool
SVL.null) [Vector a]
suffixes)
in if Vector a -> Bool
forall a. Vector a -> Bool
SV.null Vector a
chunk
then []
else Vector a
chunk Vector a -> [Vector a] -> [Vector a]
forall a. a -> [a] -> [a]
: [Vector a] -> T Int (Vector a) -> [Vector a]
go [Vector a]
newAcc T Int (Vector a)
future
in [Vector a] -> Vector a
forall a. Storable a => [Vector a] -> Vector a
SVL.fromChunks ([Vector a] -> Vector a)
-> (T Int (Vector a) -> [Vector a]) -> T Int (Vector a) -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vector a] -> T Int (Vector a) -> [Vector a]
go []