{-# OPTIONS_GHC -fenable-rewrite-rules #-}
module Synthesizer.Storable.Signal (
T,
Vector.hPut,
ChunkSize, Vector.chunkSize, defaultChunkSize,
scanL,
Vector.map,
Vector.iterate,
Vector.zipWith,
Vector.append,
Vector.concat,
Vector.span,
Vector.splitAt,
Vector.viewL,
Vector.viewR,
Vector.switchL,
Vector.unfoldr,
Vector.reverse,
Vector.crochetL,
Vector.writeFile,
mix, mixSndPattern, mixSize,
splitAtPad,
Vector.null,
Vector.fromChunks,
Vector.foldr,
delay,
delayLoop,
delayLoopOverlap,
Vector.empty,
Vector.cons,
Vector.replicate,
Vector.repeat,
Vector.drop,
Vector.take,
takeCrochet,
fromList,
zipWithRest,
zipWithAppend,
Vector.switchR,
toList,
Vector.chunks,
genericLength,
) where
import qualified Data.List as List
import qualified Data.StorableVector.Lazy.Pointer as Pointer
import qualified Data.StorableVector.Lazy as Vector
import qualified Data.StorableVector as V
import Data.StorableVector.Lazy (ChunkSize(..))
import Foreign.Storable (Storable, )
import Foreign.Storable.Tuple ()
import qualified Synthesizer.Frame.Stereo as Stereo
import qualified Data.List.HT as ListHT
import Data.Maybe.HT (toMaybe, )
import Data.Tuple.HT (mapFst, mapSnd, mapPair, forcePair, )
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import qualified Algebra.ToInteger as ToInteger
import qualified Number.NonNegativeChunky as Chunky
import qualified Number.NonNegative as NonNeg
import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()
type T = Vector.Vector
defaultChunkSize :: ChunkSize
defaultChunkSize :: ChunkSize
defaultChunkSize = Int -> ChunkSize
ChunkSize Int
1024
{-# INLINE fromList #-}
fromList :: (Storable a) => ChunkSize -> [a] -> T a
fromList :: forall a. Storable a => ChunkSize -> [a] -> T a
fromList = forall a. Storable a => ChunkSize -> [a] -> T a
Vector.pack
{-# INLINE toList #-}
toList :: (Storable a) => T a -> [a]
toList :: forall a. Storable a => T a -> [a]
toList = forall a. Storable a => T a -> [a]
Vector.unpack
{-# INLINE scanL #-}
scanL :: (Storable a, Storable b) =>
(a -> b -> a) -> a -> T b -> T a
scanL :: forall a b.
(Storable a, Storable b) =>
(a -> b -> a) -> a -> T b -> T a
scanL = forall a b.
(Storable a, Storable b) =>
(a -> b -> a) -> a -> T b -> T a
Vector.scanl
{-# SPECIALISE mix :: T Double -> T Double -> T Double #-}
{-# SPECIALISE mix :: T Float -> T Float -> T Float #-}
{-# SPECIALISE mix :: T (Double,Double) -> T (Double,Double) -> T (Double,Double) #-}
{-# SPECIALISE mix :: T (Float,Float) -> T (Float,Float) -> T (Float,Float) #-}
{-# SPECIALISE mix :: T (Stereo.T Double) -> T (Stereo.T Double) -> T (Stereo.T Double) #-}
{-# SPECIALISE mix :: T (Stereo.T Float) -> T (Stereo.T Float) -> T (Stereo.T Float) #-}
{-# INLINE mix #-}
mix :: (Additive.C x, Storable x) =>
T x ->
T x ->
T x
mix :: forall x. (C x, Storable x) => T x -> T x -> T x
mix = forall x. Storable x => (x -> x -> x) -> T x -> T x -> T x
zipWithAppend forall a. C a => a -> a -> a
(+)
{-# INLINE mixSndPattern #-}
mixSndPattern :: (Additive.C x, Storable x) =>
T x ->
T x ->
T x
mixSndPattern :: forall x. (C x, Storable x) => T x -> T x -> T x
mixSndPattern T x
xs0 T x
ys0 =
let recourse :: Vector a -> [Vector a] -> [Vector a]
recourse Vector a
xs (Vector a
y:[Vector a]
ys) =
forall a b. (a, b) -> b
snd (forall a b acc.
(Storable a, Storable b) =>
(acc -> a -> (acc, b)) -> acc -> Vector a -> (acc, Vector b)
V.mapAccumL
(\Pointer a
p0 a
yi ->
forall a b.
Storable a =>
b -> (a -> Pointer a -> b) -> Pointer a -> b
Pointer.switchL (Pointer a
p0,a
yi)
(\a
xi Pointer a
p1 -> (Pointer a
p1,a
xiforall a. C a => a -> a -> a
+a
yi)) Pointer a
p0)
(forall a. Storable a => Vector a -> Pointer a
Pointer.cons Vector a
xs) Vector a
y)
forall a. a -> [a] -> [a]
:
Vector a -> [Vector a] -> [Vector a]
recourse (forall a. Storable a => Int -> Vector a -> Vector a
Vector.drop (forall a. Vector a -> Int
V.length Vector a
y) Vector a
xs) [Vector a]
ys
recourse Vector a
xs [] = forall a. Vector a -> [Vector a]
Vector.chunks Vector a
xs
in forall a. Storable a => [Vector a] -> Vector a
Vector.fromChunks forall a b. (a -> b) -> a -> b
$
forall {a}.
(Storable a, C a) =>
Vector a -> [Vector a] -> [Vector a]
recourse T x
xs0 (forall a. Vector a -> [Vector a]
Vector.chunks T x
ys0)
{-# INLINE zipWithAppend #-}
zipWithAppend ::
(Storable x) =>
(x -> x -> x) ->
T x -> T x -> T x
zipWithAppend :: forall x. Storable x => (x -> x -> x) -> T x -> T x -> T x
zipWithAppend x -> x -> x
f T x
xs0 T x
ys0 =
let recourse :: [Vector x] -> [Vector x] -> [Vector x]
recourse xt :: [Vector x]
xt@(Vector x
x:[Vector x]
_) yt :: [Vector x]
yt@(Vector x
y:[Vector x]
_) =
let z :: Vector x
z = forall a b c.
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith x -> x -> x
f Vector x
x Vector x
y
n :: Int
n = forall a. Vector a -> Int
V.length Vector x
z
in Vector x
z forall a. a -> [a] -> [a]
: [Vector x] -> [Vector x] -> [Vector x]
recourse
(forall a. Vector a -> [Vector a]
Vector.chunks forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Int -> Vector a -> Vector a
Vector.drop Int
n forall a b. (a -> b) -> a -> b
$ forall a. Storable a => [Vector a] -> Vector a
Vector.fromChunks [Vector x]
xt)
(forall a. Vector a -> [Vector a]
Vector.chunks forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Int -> Vector a -> Vector a
Vector.drop Int
n forall a b. (a -> b) -> a -> b
$ forall a. Storable a => [Vector a] -> Vector a
Vector.fromChunks [Vector x]
yt)
recourse [Vector x]
xs [] = [Vector x]
xs
recourse [] [Vector x]
ys = [Vector x]
ys
in forall a. Storable a => [Vector a] -> Vector a
Vector.fromChunks forall a b. (a -> b) -> a -> b
$
[Vector x] -> [Vector x] -> [Vector x]
recourse (forall a. Vector a -> [Vector a]
Vector.chunks T x
xs0) (forall a. Vector a -> [Vector a]
Vector.chunks T x
ys0)
{-# INLINE _zipWithAppendRest #-}
_zipWithAppendRest ::
(Storable x) =>
(x -> x -> x) ->
T x -> T x -> T x
_zipWithAppendRest :: forall x. Storable x => (x -> x -> x) -> T x -> T x -> T x
_zipWithAppendRest x -> x -> x
f T x
xs T x
ys =
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Storable a => Vector a -> Vector a -> Vector a
Vector.append forall a b. (a -> b) -> a -> b
$ forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall c x.
(Storable c, Storable x) =>
(x -> x -> c) -> T x -> T x -> (Vector c, (Bool, T x))
zipWithRest x -> x -> x
f T x
xs T x
ys
{-# INLINE zipWithRest #-}
zipWithRest ::
(Storable c, Storable x) =>
(x -> x -> c) ->
T x ->
T x ->
(Vector.Vector c, (Bool, T x))
zipWithRest :: forall c x.
(Storable c, Storable x) =>
(x -> x -> c) -> T x -> T x -> (Vector c, (Bool, T x))
zipWithRest x -> x -> c
f T x
xs T x
ys =
let len :: T Int
len = forall a. Ord a => a -> a -> a
min (forall i x. C i => T x -> i
lazyLength T x
xs) (forall i x. C i => T x -> i
lazyLength T x
ys) :: Chunky.T NonNeg.Int
(T x
prefixX,T x
suffixX) = forall i x. (C i, Ord i, C i, Storable x) => i -> T x -> (T x, T x)
genericSplitAt T Int
len T x
xs
(T x
prefixY,T x
suffixY) = forall i x. (C i, Ord i, C i, Storable x) => i -> T x -> (T x, T x)
genericSplitAt T Int
len T x
ys
second :: Bool
second = forall a. Storable a => Vector a -> Bool
Vector.null T x
suffixX
in (forall a b c.
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
Vector.zipWithLastPattern x -> x -> c
f T x
prefixX T x
prefixY,
(Bool
second, if Bool
second then T x
suffixY else T x
suffixX))
genericSplitAt ::
(Additive.C i, Ord i, ToInteger.C i, Storable x) =>
i -> T x -> (T x, T x)
genericSplitAt :: forall i x. (C i, Ord i, C i, Storable x) => i -> T x -> (T x, T x)
genericSplitAt i
n0 =
let recourse :: a -> [Vector a] -> ([Vector a], [Vector a])
recourse a
n [Vector a]
xs0 =
forall a b. (a, b) -> (a, b)
forcePair forall a b. (a -> b) -> a -> b
$
forall b a. b -> (a -> [a] -> b) -> [a] -> b
ListHT.switchL
([], [])
(\Vector a
x [Vector a]
xs ->
if forall a. C a => a -> Bool
isZero a
n
then ([], [Vector a]
xs0)
else
let m :: a
m = forall a b. (C a, C b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> Int
V.length Vector a
x
in if a
mforall a. Ord a => a -> a -> Bool
<=a
n
then forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (Vector a
xforall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ a -> [Vector a] -> ([Vector a], [Vector a])
recourse (a
nforall a. C a => a -> a -> a
-a
m) [Vector a]
xs
else forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ((forall a. a -> [a] -> [a]
:[]), (forall a. a -> [a] -> [a]
:[Vector a]
xs)) forall a b. (a -> b) -> a -> b
$
forall a. Storable a => Int -> Vector a -> (Vector a, Vector a)
V.splitAt (forall a. C a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ forall a. C a => a -> Integer
toInteger a
n) Vector a
x)
[Vector a]
xs0
in forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall a. Storable a => [Vector a] -> Vector a
Vector.fromChunks, forall a. Storable a => [Vector a] -> Vector a
Vector.fromChunks) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {a} {a}.
(Storable a, C a) =>
a -> [Vector a] -> ([Vector a], [Vector a])
recourse i
n0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [Vector a]
Vector.chunks
lazyLength :: (Ring.C i) =>
T x -> i
lazyLength :: forall i x. C i => T x -> i
lazyLength =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr forall a. C a => a -> a -> a
(+) forall a. C a => a
zero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map (forall a b. (C a, C b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> Int
V.length) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [Vector a]
Vector.chunks
genericLength :: (Ring.C i) =>
T x -> i
genericLength :: forall i x. C i => T x -> i
genericLength =
forall a. C a => [a] -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map (forall a b. (C a, C b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> Int
V.length) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [Vector a]
Vector.chunks
splitAtPad ::
(Additive.C x, Storable x) =>
ChunkSize -> Int -> T x -> (T x, T x)
splitAtPad :: forall x.
(C x, Storable x) =>
ChunkSize -> Int -> T x -> (T x, T x)
splitAtPad ChunkSize
size Int
n =
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (forall a.
Storable a =>
ChunkSize -> a -> Int -> Vector a -> Vector a
Vector.pad ChunkSize
size forall a. C a => a
Additive.zero Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => Int -> Vector a -> (Vector a, Vector a)
Vector.splitAt Int
n
{-# INLINE mixSize #-}
mixSize :: (Additive.C x, Storable x) =>
ChunkSize
-> T x
-> T x
-> T x
mixSize :: forall x. (C x, Storable x) => ChunkSize -> T x -> T x -> T x
mixSize ChunkSize
size T x
xs T x
ys =
forall b a.
Storable b =>
ChunkSize -> (a -> Maybe (b, a)) -> a -> Vector b
Vector.unfoldr ChunkSize
size forall x.
(C x, Storable x) =>
(Pointer x, Pointer x) -> Maybe (x, (Pointer x, Pointer x))
mixStep
(forall a. Storable a => Vector a -> Pointer a
Pointer.cons T x
xs, forall a. Storable a => Vector a -> Pointer a
Pointer.cons T x
ys)
{-# INLINE mixStep #-}
mixStep :: (Additive.C x, Storable x) =>
(Pointer.Pointer x, Pointer.Pointer x) ->
Maybe (x, (Pointer.Pointer x, Pointer.Pointer x))
mixStep :: forall x.
(C x, Storable x) =>
(Pointer x, Pointer x) -> Maybe (x, (Pointer x, Pointer x))
mixStep (Pointer x
xt,Pointer x
yt) =
case (forall a. Storable a => Pointer a -> Maybe (a, Pointer a)
Pointer.viewL Pointer x
xt, forall a. Storable a => Pointer a -> Maybe (a, Pointer a)
Pointer.viewL Pointer x
yt) of
(Just (x
x,Pointer x
xs), Just (x
y,Pointer x
ys)) -> forall a. a -> Maybe a
Just (x
xforall a. C a => a -> a -> a
+x
y, (Pointer x
xs,Pointer x
ys))
(Maybe (x, Pointer x)
Nothing, Just (x
y,Pointer x
ys)) -> forall a. a -> Maybe a
Just (x
y, (Pointer x
xt,Pointer x
ys))
(Just (x
x,Pointer x
xs), Maybe (x, Pointer x)
Nothing) -> forall a. a -> Maybe a
Just (x
x, (Pointer x
xs,Pointer x
yt))
(Maybe (x, Pointer x)
Nothing, Maybe (x, Pointer x)
Nothing) -> forall a. Maybe a
Nothing
{-# INLINE delay #-}
delay :: (Storable y) =>
ChunkSize -> y -> Int -> T y -> T y
delay :: forall a.
Storable a =>
ChunkSize -> a -> Int -> Vector a -> Vector a
delay ChunkSize
size y
z Int
n = forall a. Storable a => Vector a -> Vector a -> Vector a
Vector.append (forall a. Storable a => ChunkSize -> Int -> a -> Vector a
Vector.replicate ChunkSize
size Int
n y
z)
{-# INLINE delayLoop #-}
delayLoop ::
(Storable y) =>
(T y -> T y)
-> T y
-> T y
delayLoop :: forall y. Storable y => (T y -> T y) -> T y -> T y
delayLoop T y -> T y
proc T y
prefix =
let ys :: T y
ys = forall a. Storable a => Vector a -> Vector a -> Vector a
Vector.append T y
prefix (T y -> T y
proc T y
ys)
in T y
ys
{-# INLINE delayLoopOverlap #-}
delayLoopOverlap ::
(Additive.C y, Storable y) =>
Int
-> (T y -> T y)
-> T y
-> T y
delayLoopOverlap :: forall y. (C y, Storable y) => Int -> (T y -> T y) -> T y -> T y
delayLoopOverlap Int
time T y -> T y
proc T y
xs =
let ys :: T y
ys = forall a b c.
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
Vector.zipWith forall a. C a => a -> a -> a
(Additive.+) T y
xs
(forall a.
Storable a =>
ChunkSize -> a -> Int -> Vector a -> Vector a
delay (Int -> ChunkSize
Vector.chunkSize Int
time) forall a. C a => a
Additive.zero Int
time (T y -> T y
proc T y
ys))
in T y
ys
{-# INLINE takeCrochet #-}
takeCrochet :: Storable a => Int -> T a -> T a
takeCrochet :: forall a. Storable a => Int -> Vector a -> Vector a
takeCrochet = forall x y acc.
(Storable x, Storable y) =>
(x -> acc -> Maybe (y, acc)) -> acc -> Vector x -> Vector y
Vector.crochetL (\a
x Int
n -> forall a. Bool -> a -> Maybe a
toMaybe (Int
nforall a. Ord a => a -> a -> Bool
>Int
0) (a
x, forall a. Enum a => a -> a
pred Int
n))