module Synthesizer.LLVM.Parameterized.SignalPacked (
SigS.pack, SigS.packRotate,
SigS.packSmall,
SigS.unpack, SigS.unpackRotate,
constant,
exponential2,
exponentialBounded2,
osciCore,
osci,
osciSimple,
parabolaFadeInInf, parabolaFadeOutInf,
rampInf, rampSlope,
noise,
noiseCore, noiseCoreAlt,
) where
import Synthesizer.LLVM.Parameterized.Signal (T, )
import qualified Synthesizer.LLVM.Simple.SignalPacked as SigS
import qualified Synthesizer.LLVM.Parameterized.Signal as Sig
import qualified Synthesizer.LLVM.Parameter as Param
import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
import qualified Synthesizer.LLVM.Random as Rnd
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Vector as Vector
import qualified LLVM.Extra.Arithmetic as A
import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )
import qualified Type.Data.Num.Decimal as TypeNum
import Type.Data.Num.Decimal ((:*:), )
import qualified LLVM.Core as LLVM
import LLVM.Core
(CodeGenFunction, Value,
IsSized, IsConst, IsArithmetic, IsFloating,
IsPrimitive, Vector, SizeOf, )
import Control.Monad.HT ((<=<), )
import Control.Arrow ((^<<), )
import Control.Applicative (liftA2, )
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Algebraic as Algebraic
import qualified Algebra.RealField as RealField
import qualified Algebra.Ring as Ring
import Data.Word (Word32, )
import Data.Int (Int32, )
import Foreign.Storable (Storable, )
import NumericPrelude.Numeric as NP
import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, )
withSize ::
(TypeNum.Positive n) =>
(TypeNum.Singleton n -> T p (Serial.Value n a)) ->
T p (Serial.Value n a)
withSize f = f TypeNum.singleton
withSizeRing ::
(Ring.C b, TypeNum.Positive n) =>
(b -> T p (Serial.Value n a)) ->
T p (Serial.Value n a)
withSizeRing f =
withSize $ f . fromInteger . TypeNum.integerFromSingleton
constant ::
(Storable a, MakeValueTuple a, ValueTuple a ~ (Value a),
IsConst a,
Memory.FirstClass a, Memory.Stored a ~ am,
IsPrimitive a,
IsPrimitive am, IsSized am, SizeOf am ~ amsize,
TypeNum.Positive (n :*: amsize),
TypeNum.Positive n) =>
Param.T p a -> T p (Serial.Value n a)
constant x =
Sig.constant (Serial.replicate ^<< x)
exponential2 ::
(Trans.C a, Storable a, MakeValueTuple a, ValueTuple a ~ (Value a),
IsArithmetic a, IsConst a,
Memory.FirstClass a, Memory.Stored a ~ am,
IsPrimitive a, IsSized a, SizeOf a ~ as,
IsPrimitive am, IsSized am, SizeOf am ~ amsize,
TypeNum.Positive (n :*: as),
TypeNum.Positive (n :*: amsize),
TypeNum.Positive n) =>
Param.T p a -> Param.T p a -> T p (Serial.Value n a)
exponential2 halfLife start = withSizeRing $ \n ->
Sig.exponentialCore
(Serial.replicate ^<< 0.5 ** (n / halfLife))
(liftA2
(\h -> Serial.iteratePlain (0.5 ** recip h *))
halfLife start)
exponentialBounded2 ::
(Trans.C a, Storable a, MakeValueTuple a, ValueTuple a ~ (Value a),
Vector.Real a, IsConst a,
Memory.FirstClass a, Memory.Stored a ~ am,
IsPrimitive a, IsSized a, SizeOf a ~ as,
IsPrimitive am, IsSized am, SizeOf am ~ amsize,
TypeNum.Positive (n :*: as),
TypeNum.Positive (n :*: amsize),
TypeNum.Positive n) =>
Param.T p a -> Param.T p a -> Param.T p a ->
T p (Serial.Value n a)
exponentialBounded2 bound halfLife start = withSizeRing $ \n ->
Sig.exponentialBoundedCore
(fmap (Serial.replicate) bound)
(Serial.replicate ^<< 0.5 ** (n / halfLife))
(liftA2
(\h -> Serial.iteratePlain (0.5 ** recip h *))
halfLife start)
osciCore ::
(Storable t, MakeValueTuple t, ValueTuple t ~ (Value t),
Memory.FirstClass t, Memory.Stored t ~ tm,
IsPrimitive t, IsSized t, SizeOf t ~ tsize,
IsPrimitive tm, IsSized tm, SizeOf tm ~ tmsize,
TypeNum.Positive (n :*: tsize),
TypeNum.Positive (n :*: tmsize),
Vector.Real t, IsFloating t, RealField.C t, IsConst t,
TypeNum.Positive n) =>
Param.T p t -> Param.T p t -> T p (Serial.Value n t)
osciCore phase freq = withSizeRing $ \n ->
Sig.osciCore
(liftA2
(\f -> Serial.iteratePlain (fraction . (f +)))
freq phase)
(fmap
(\f -> Serial.replicate (fraction (n * f)))
freq)
osci ::
(Storable t, MakeValueTuple t, ValueTuple t ~ (Value t),
Storable c, MakeValueTuple c, ValueTuple c ~ cl,
Memory.FirstClass t, Memory.Stored t ~ tm,
IsPrimitive t, IsSized t, SizeOf t ~ tsize,
IsPrimitive tm, IsSized tm, SizeOf tm ~ tmsize,
TypeNum.Positive (n :*: tsize),
TypeNum.Positive (n :*: tmsize),
Memory.C cl,
Vector.Real t, IsFloating t, RealField.C t, IsConst t,
TypeNum.Positive n) =>
(forall r. cl -> Serial.Value n t -> CodeGenFunction r y) ->
Param.T p c ->
Param.T p t -> Param.T p t -> T p y
osci wave waveParam phase freq =
Sig.map wave waveParam $
osciCore phase freq
osciSimple ::
(Storable t, MakeValueTuple t, ValueTuple t ~ (Value t),
Memory.FirstClass t, Memory.Stored t ~ tm,
IsPrimitive t, IsSized t, SizeOf t ~ tsize,
IsPrimitive tm, IsSized tm, SizeOf tm ~ tmsize,
TypeNum.Positive (n :*: tsize),
TypeNum.Positive (n :*: tmsize),
Vector.Real t, IsFloating t, RealField.C t, IsConst t,
TypeNum.Positive n) =>
(forall r. Serial.Value n t -> CodeGenFunction r y) ->
Param.T p t -> Param.T p t -> T p y
osciSimple wave =
osci (const wave) (return ())
rampInf, rampSlope,
parabolaFadeInInf, parabolaFadeOutInf ::
(RealField.C a, Storable a, MakeValueTuple a, ValueTuple a ~ (Value a),
Memory.FirstClass a, Memory.Stored a ~ am,
IsPrimitive a, IsSized a, SizeOf a ~ as,
IsPrimitive am, IsSized am, SizeOf am ~ amsize,
TypeNum.Positive (n :*: as),
TypeNum.Positive (n :*: amsize),
IsArithmetic a, SoV.IntegerConstant a,
TypeNum.Positive n) =>
Param.T p a -> T p (Serial.Value n a)
rampSlope slope = withSizeRing $ \n ->
Sig.rampCore
(fmap (\s -> Serial.replicate (n * s)) slope)
(fmap (\s -> Serial.iteratePlain (s +) 0) slope)
rampInf dur = rampSlope (recip dur)
parabolaFadeInInf dur = withSizeRing $ \n ->
Sig.parabolaCore
(fmap
(\dr ->
let d = n / dr
in Serial.replicate (2*d*d)) dur)
(fmap
(\dr ->
let d = n / dr
in Serial.iteratePlain (subtract $ 2 / dr ^ 2) (d*(2d)))
dur)
(fmap
(\dr ->
Serial.mapPlain (\t -> t*(2t)) $ Serial.iteratePlain (recip dr +) 0)
dur)
parabolaFadeOutInf dur = withSizeRing $ \n ->
Sig.parabolaCore
(fmap
(\dr ->
let d = n / dr
in Serial.replicate (2*d*d)) dur)
(fmap
(\dr ->
let d = n / dr
in Serial.iteratePlain (subtract $ 2 / dr ^ 2) (d*d))
dur)
(fmap
(\dr ->
Serial.mapPlain (\t -> 1t*t) $ Serial.iteratePlain (recip dr +) 0)
dur)
noise ::
(Algebraic.C a, IsFloating a, SoV.IntegerConstant a,
TypeNum.Positive n,
TypeNum.Positive (n :*: TypeNum.D32),
Memory.FirstClass a, Memory.Stored a ~ am,
IsPrimitive a, IsSized a, SizeOf a ~ as,
IsPrimitive am, IsSized am, SizeOf am ~ amsize,
TypeNum.Positive (n :*: as),
TypeNum.Positive (n :*: amsize),
MakeValueTuple a, ValueTuple a ~ (Value a), Storable a) =>
Param.T p Word32 ->
Param.T p a ->
T p (Serial.Value n a)
noise seed rate =
let m2 = div Rnd.modulus 2
in Sig.map
(\r y ->
A.mul r
=<< flip A.sub (A.fromInteger' $ m2+1)
=<< int31tofp y)
(Serial.replicate ^<< sqrt (3 * rate) / return (fromInteger m2)) $
noiseCore seed
int31tofp ::
(IsFloating a, IsPrimitive a,
TypeNum.Positive n, TypeNum.Positive (n :*: TypeNum.D32)) =>
Serial.Value n Word32 -> CodeGenFunction r (Serial.Value n a)
int31tofp =
Serial.mapV $
LLVM.inttofp <=<
(LLVM.bitcast ::
(TypeNum.Positive n, TypeNum.Positive (n :*: TypeNum.D32)) =>
Value (Vector n Word32) ->
CodeGenFunction r (Value (Vector n Int32)))
noiseCore, noiseCoreAlt ::
(TypeNum.Positive n,
TypeNum.Positive (n :*: TypeNum.D32)) =>
Param.T p Word32 ->
T p (Serial.Value n Word32)
noiseCore seed =
fmap Serial.value $
Sig.iterate (const Rnd.nextVector)
(return ())
(Rnd.vectorSeed . (+1) . flip mod (Rnd.modulus1) ^<< seed)
noiseCoreAlt seed =
fmap Serial.value $
Sig.iterate (const Rnd.nextVector64)
(return ())
(Rnd.vectorSeed . (+1) . flip mod (Rnd.modulus1) ^<< seed)