{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {- | Signal generators that generate the signal in chunks that can be processed natively by the processor. Some of the functions for plain signals can be re-used without modification. E.g. rendering a signal and reading from and to signals work because the vector type as element type warrents correct alignment. We can convert between atomic and chunked signals. The article explains the difference between Vector and SIMD computing. According to that the SSE extensions in Intel processors must be called Vector computing. But since we use the term Vector already in the mathematical sense, I like to use the term "packed" that is used in Intel mnemonics like mulps. -} 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.Frame.SerialVector as Serial import qualified Synthesizer.LLVM.Random as Rnd import qualified LLVM.DSL.Parameter as Param import qualified LLVM.Extra.Marshal as Marshal 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 qualified LLVM.Extra.Tuple as Tuple import qualified Type.Data.Num.Decimal as TypeNum import Type.Data.Num.Decimal ((:*:)) import qualified LLVM.Core as LLVM import LLVM.Core (CodeGenFunction, Value, IsConst, IsArithmetic, IsFloating, IsPrimitive, Vector, SizeOf) import Control.Monad.HT ((<=<)) -- we can also use <$> for parameters 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 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) => (TypeNum.Singleton n -> b -> T p (Serial.Value n a)) -> T p (Serial.Value n a) withSizeRing f = withSize $ \n -> f n $ fromInteger $ TypeNum.integerFromSingleton n constant :: (Marshal.Vector n a, Tuple.ValueOf a ~ Value a, IsConst a, Tuple.VectorValueOf n a ~ Value (Vector n a), IsPrimitive a, SizeOf a ~ asize, TypeNum.Positive (n :*: asize), TypeNum.Positive n) => Param.T p a -> T p (Serial.Value n a) constant x = withSize $ \n -> Sig.constant (Serial.replicate_ n ^<< x) exponential2 :: (Trans.C a, Marshal.Vector n a, Tuple.ValueOf a ~ Value a, Tuple.VectorValueOf n a ~ Value (Vector n a), IsArithmetic a, IsConst a, IsPrimitive a, SizeOf a ~ asize, TypeNum.Positive (n :*: asize), TypeNum.Positive n) => Param.T p a -> Param.T p a -> T p (Serial.Value n a) exponential2 halfLife start = withSizeRing $ \sn n -> Sig.exponentialCore (Serial.replicate_ sn ^<< 0.5 ** (n / halfLife)) (liftA2 (\h -> Serial.iteratePlain (0.5 ** recip h *)) halfLife start) exponentialBounded2 :: (Trans.C a, Marshal.Vector n a, Tuple.ValueOf a ~ Value a, Tuple.VectorValueOf n a ~ Value (Vector n a), Vector.Real a, IsConst a, IsPrimitive a, SizeOf a ~ as, TypeNum.Positive (n :*: as), 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 $ \sn n -> Sig.exponentialBoundedCore (fmap (Serial.replicate_ sn) bound) (Serial.replicate_ sn ^<< 0.5 ** (n / halfLife)) (liftA2 (\h -> Serial.iteratePlain (0.5 ** recip h *)) halfLife start) osciCore :: (Marshal.Vector n t, Tuple.ValueOf t ~ Value t, Tuple.VectorValueOf n t ~ Value (Vector n t), IsPrimitive t, SizeOf t ~ tsize, TypeNum.Positive (n :*: tsize), 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 $ \sn n -> Sig.osciCore (liftA2 (\f -> Serial.iteratePlain (fraction . (f +))) freq phase) (fmap (\f -> Serial.replicate_ sn (fraction (n * f))) freq) osci :: (Marshal.Vector n t, Tuple.ValueOf t ~ Value t, Marshal.C c, Tuple.ValueOf c ~ cl, Tuple.VectorValueOf n t ~ Value (Vector n t), IsPrimitive t, SizeOf t ~ tsize, TypeNum.Positive (n :*: tsize), 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 :: (Marshal.Vector n t, Tuple.ValueOf t ~ Value t, Tuple.VectorValueOf n t ~ Value (Vector n t), IsPrimitive t, SizeOf t ~ tsize, TypeNum.Positive (n :*: tsize), 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, Marshal.Vector n a, Tuple.ValueOf a ~ Value a, Tuple.VectorValueOf n a ~ Value (Vector n a), IsPrimitive a, SizeOf a ~ as, TypeNum.Positive (n :*: as), IsArithmetic a, SoV.IntegerConstant a, TypeNum.Positive n) => Param.T p a -> T p (Serial.Value n a) rampSlope slope = withSizeRing $ \sn n -> Sig.rampCore (fmap (\s -> Serial.replicate_ sn (n * s)) slope) (fmap (\s -> Serial.iteratePlain (s +) 0) slope) rampInf dur = rampSlope (recip dur) parabolaFadeInInf dur = withSizeRing $ \sn n -> Sig.parabolaCore (fmap (\dr -> let d = n / dr in Serial.replicate_ sn (-2*d*d)) dur) (fmap (\dr -> let d = n / dr in Serial.iteratePlain (subtract $ 2 / dr ^ 2) (d*(2-d))) dur) (fmap (\dr -> Serial.mapPlain (\t -> t*(2-t)) $ Serial.iteratePlain (recip dr +) 0) dur) parabolaFadeOutInf dur = withSizeRing $ \sn n -> Sig.parabolaCore (fmap (\dr -> let d = n / dr in Serial.replicate_ sn (-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 -> 1-t*t) $ Serial.iteratePlain (recip dr +) 0) dur) {- | For the mysterious rate parameter see 'Sig.noise'. -} noise :: (Algebraic.C a, IsFloating a, SoV.IntegerConstant a, TypeNum.Positive n, TypeNum.Positive (n :*: TypeNum.D32), IsPrimitive a, SizeOf a ~ as, TypeNum.Positive (n :*: as), Marshal.Vector n a, Tuple.VectorValueOf n a ~ Value (Vector n a), Tuple.ValueOf a ~ Value a) => Param.T p Word32 -> Param.T p a -> T p (Serial.Value n a) noise seed rate = withSize $ \n -> 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_ n ^<< sqrt (3 * rate) / return (fromInteger m2)) $ noiseCore seed {- sitofp is a single instruction on x86 and thus we use it, since the arguments are below 2^31. -} 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.modulus-1) ^<< seed) noiseCoreAlt seed = fmap Serial.value $ Sig.iterate (const Rnd.nextVector64) (return ()) (Rnd.vectorSeed . (+1) . flip mod (Rnd.modulus-1) ^<< seed)