module Synthesizer.LLVM.Wave where
import qualified Synthesizer.LLVM.Simple.Value as Value
import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Extra.Monad as M
import qualified LLVM.Core as LLVM
import LLVM.Core
(Value, CodeGenFunction,
IsFloating, IsArithmetic, IsConst, )
import Control.Monad.HT ((<=<), )
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import NumericPrelude.Numeric
import NumericPrelude.Base hiding (replicate, )
saw ::
(Ring.C a, IsConst a, SoV.Replicate a v, IsArithmetic v) =>
Value v -> CodeGenFunction r (Value v)
saw =
A.sub (SoV.replicateOf 1) <=<
A.mul (SoV.replicateOf 2)
square ::
(Ring.C a, IsConst a,
SoV.Replicate a v, SoV.Fraction v, SoV.Real v) =>
Value v -> CodeGenFunction r (Value v)
square =
A.sub (SoV.replicateOf 1) <=<
A.mul (SoV.replicateOf 2) <=<
SoV.truncate <=<
A.mul (SoV.replicateOf 2)
triangle ::
(Field.C a, IsConst a,
SoV.Replicate a v, SoV.Fraction v, SoV.Real v) =>
Value v -> CodeGenFunction r (Value v)
triangle =
flip A.sub (SoV.replicateOf 1) <=<
SoV.abs <=<
flip A.sub (SoV.replicateOf 2) <=<
A.mul (SoV.replicateOf 4) <=<
SoV.incPhase (SoV.replicateOf 0.75)
approxSine2 ::
(Ring.C a, IsConst a, SoV.Replicate a v, SoV.Real v) =>
Value v -> CodeGenFunction r (Value v)
approxSine2 t = do
x <- saw t
A.mul (SoV.replicateOf 4) =<<
A.mul x =<<
A.sub (SoV.replicateOf 1) =<<
SoV.abs x
approxSine3 ::
(Field.C a, IsConst a,
SoV.Replicate a v, SoV.Fraction v, SoV.Real v) =>
Value v -> CodeGenFunction r (Value v)
approxSine3 t = do
x <- triangle t
A.mul (SoV.replicateOf 0.5) =<<
A.mul x =<<
A.sub (SoV.replicateOf 3) =<<
A.mul x x
approxSine4 ::
(Field.C a, IsConst a, SoV.Replicate a v, SoV.Real v) =>
Value v -> CodeGenFunction r (Value v)
approxSine4 t = do
x <- saw t
ax <- SoV.abs x
sax <- A.sub (SoV.replicateOf 1) ax
A.mul (SoV.replicateOf (16/5)) =<<
A.mul x =<<
A.mul sax =<<
A.add (SoV.replicateOf 1) =<<
A.mul sax ax
rationalApproxCosine1, rationalApproxSine1 ::
(Field.C a, IsConst a, SoV.Replicate a v, SoV.Real v, IsFloating v) =>
Value v -> Value v -> CodeGenFunction r (Value v)
rationalApproxCosine1 k t = do
num2 <-
A.square =<<
A.mul k =<<
A.add (SoV.replicateOf (1)) =<<
A.mul (SoV.replicateOf 2) t
den2 <-
A.square =<<
A.mul t =<<
A.sub (SoV.replicateOf 1) t
M.liftR2 A.fdiv
(A.sub num2 den2)
(A.add num2 den2)
rationalApproxSine1 k t = do
num <-
A.mul k =<<
A.add (SoV.replicateOf (1)) =<<
A.mul (SoV.replicateOf 2) t
den <-
A.mul t =<<
A.sub (SoV.replicateOf 1) t
M.liftR2 A.fdiv
(A.mul (SoV.replicateOf (2)) =<< A.mul num den)
(M.liftR2 A.add (A.square num) (A.square den))
trapezoidSkew ::
(Field.C a, IsConst a,
SoV.Replicate a v, SoV.Fraction v, SoV.Real v) =>
Value v -> Value v -> CodeGenFunction r (Value v)
trapezoidSkew p =
SoV.max (SoV.replicateOf (1)) <=<
SoV.min (SoV.replicateOf 1) <=<
flip A.fdiv p <=<
A.sub (SoV.replicateOf 1) <=<
A.mul (SoV.replicateOf 2)
sine ::
(Trans.C a, IsFloating a, IsConst a) =>
Value a -> CodeGenFunction r (Value a)
sine t =
A.sin =<< A.mul t =<< Value.decons Value.twoPi
replicate ::
(Field.C a, IsConst a,
SoV.Replicate a v, SoV.Fraction v, SoV.Real v) =>
Value v -> Value v -> CodeGenFunction r (Value v)
replicate k =
SoV.fraction <=<
A.mul k <=<
flip A.sub (SoV.replicateOf 0.5) <=<
SoV.incPhase (SoV.replicateOf 0.5)
halfEnvelope ::
(Field.C a, IsConst a,
SoV.Replicate a v, SoV.Fraction v, SoV.Real v) =>
Value v -> CodeGenFunction r (Value v)
halfEnvelope =
A.mul (SoV.replicateOf 0.5) <=<
SoV.incPhase (SoV.replicateOf 0.5)
partial ::
(LLVM.IsPrimitive i, LLVM.IsPrimitive a,
LLVM.IsInteger i, IsFloating a,
SoV.Replicate a v, SoV.Fraction v) =>
(Value v -> CodeGenFunction r (Value v)) ->
Value i ->
(Value v -> CodeGenFunction r (Value v))
partial w n t =
w =<<
SoV.signedFraction =<<
A.mul t =<<
SoV.replicate =<<
LLVM.sitofp n