{-# LANGUAGE NoImplicitPrelude #-}
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

{- |
For the distortion factor @recip pi@ you get the closest approximation
to an undistorted cosine or sine.
We have chosen this scaling in order to stay with field operations.
-}
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 -> TValue r a
   Value a -> CodeGenFunction r (Value a)
sine t =
   A.sin =<< A.mul t =<< Value.decons Value.twoPi



{- |
This can be used for preprocessing the phase
in order to generate locally faster oscillating waves.
For example

> triangle <=< replicate (valueOf 2.5)

shrinks a triangle wave such that 2.5 periods fit into one.
-}
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)

{- |
Preprocess the phase such that the first half of a wave
is expanded to one period and shifted by 90 degree.
E.g.

> sine <=< halfEnvelope

generates a sequence of sine bows that starts and ends with the maximum.
Such a signal can be used to envelope an oscillation
generated using 'replicate'.
-}
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.inttofp n