{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE Rank2Types #-}
module Synthesizer.LLVM.Generator.Signal (
   Sig.T,
   MV,

   constant,
   fromArray,
   Core.iterate,
   takeWhile,
   take,
   tail,
   drop,
   Sig.append,
   cycle,

   amplify,

   osci,
   exponential2,
   exponentialBounded2,
   noise,

   adjacentNodes02,
   adjacentNodes13,
   interpolateConstant,

   rampSlope,
   rampInf,
   ramp,
   parabolaFadeInInf,
   parabolaFadeOutInf,
   parabolaFadeIn,
   parabolaFadeOut,
   parabolaFadeInMap,
   parabolaFadeOutMap,
   ) where

import qualified Synthesizer.LLVM.Causal.Private as Causal
import qualified Synthesizer.LLVM.Generator.Core as Core
import qualified Synthesizer.LLVM.Generator.Private as Sig
import qualified Synthesizer.LLVM.Interpolation as Interpolation
import qualified Synthesizer.LLVM.Frame as Frame
import qualified Synthesizer.LLVM.Random as Rnd
import Synthesizer.LLVM.Generator.Private (arraySize)
import Synthesizer.LLVM.Private (noLocalPtr)

import qualified Synthesizer.Causal.Class as CausalC
import Synthesizer.Causal.Class (apply, ($*), ($<))

import qualified LLVM.DSL.Expression as Expr
import LLVM.DSL.Expression (Exp)

import qualified LLVM.Extra.Multi.Value.Marshal as Marshal
import qualified LLVM.Extra.Multi.Value as MultiValue
import qualified LLVM.Extra.Iterator as Iter
import qualified LLVM.Extra.MaybeContinuation as MaybeCont
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Arithmetic as A
import qualified LLVM.Extra.Tuple as Tuple

import qualified LLVM.Core as LLVM
import LLVM.Core (CodeGenFunction)

import qualified Type.Data.Num.Decimal.Number as TypeNum
import Type.Data.Num.Decimal.Number ((:*:))

import Control.Monad.HT ((<=<))
import Control.Applicative (liftA2)

import Data.Word (Word32, Word)
import Data.Int (Int32)

import NumericPrelude.Numeric
import NumericPrelude.Base hiding
         (map, iterate, takeWhile, take, tail, drop, cycle)



type MV a = Sig.T (MultiValue.T a)

constant :: (Expr.Aggregate ae al, Memory.C al) => ae -> Sig.T al
constant :: forall ae al. (Aggregate ae al, C al) => ae -> T al
constant ae
a = (forall r. al -> CodeGenFunction r al)
-> (forall r. CodeGenFunction r al) -> T al
forall a.
C a =>
(forall r. a -> CodeGenFunction r a)
-> (forall r. CodeGenFunction r a) -> T a
Sig.iterate al -> CodeGenFunction r al
forall a. a -> CodeGenFunction r a
forall r. al -> CodeGenFunction r al
forall (m :: * -> *) a. Monad m => a -> m a
return (ae -> CodeGenFunction r al
forall r. ae -> CodeGenFunction r al
forall exp mv r. Aggregate exp mv => exp -> CodeGenFunction r mv
Expr.bundle ae
a)


fromArray ::
   (TypeNum.Natural n, Marshal.C a) =>
   ((n :*: LLVM.SizeOf (Marshal.Struct a)) ~ arrSize,
    TypeNum.Natural arrSize) =>
   Exp (MultiValue.Array n a) -> MV a
fromArray :: forall n a arrSize.
(Natural n, C a, (n :*: SizeOf (Struct a)) ~ arrSize,
 Natural arrSize) =>
Exp (Array n a) -> MV a
fromArray Exp (Array n a)
arrExp = (forall r c.
 Phi c =>
 Value (Ptr (Array n (Struct a)))
 -> Value (Ptr (Struct ()))
 -> Value Word
 -> T r c (T a, Value Word))
-> (forall r.
    CodeGenFunction r (Value (Ptr (Array n (Struct a))), Value Word))
-> (forall r.
    Value (Ptr (Array n (Struct a))) -> CodeGenFunction r ())
-> T (T a)
forall a global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> state -> T r c (a, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a
Sig.Cons
   (\Value (Ptr (Array n (Struct a)))
arrPtr -> (Value Word -> T r c (T a, Value Word))
-> Value (Ptr (Struct ())) -> Value Word -> T r c (T a, Value Word)
forall f. f -> Value (Ptr (Struct ())) -> f
noLocalPtr ((Value Word -> T r c (T a, Value Word))
 -> Value (Ptr (Struct ()))
 -> Value Word
 -> T r c (T a, Value Word))
-> (Value Word -> T r c (T a, Value Word))
-> Value (Ptr (Struct ()))
-> Value Word
-> T r c (T a, Value Word)
forall a b. (a -> b) -> a -> b
$ \Value Word
i -> do
      Value Bool
inRange <- CodeGenFunction r (Value Bool) -> T r c (Value Bool)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r (Value Bool) -> T r c (Value Bool))
-> CodeGenFunction r (Value Bool) -> T r c (Value Bool)
forall a b. (a -> b) -> a -> b
$
         CmpPredicate
-> Value Word
-> Value Word
-> CodeGenFunction r (CmpValueResult Value Value Word)
forall (value0 :: * -> *) (value1 :: * -> *) a r.
(ValueCons2 value0 value1, CmpRet a) =>
CmpPredicate
-> value0 a
-> value1 a
-> CodeGenFunction r (CmpValueResult value0 value1 a)
LLVM.cmp CmpPredicate
LLVM.CmpLT Value Word
i (Value Word -> CodeGenFunction r (CmpValueResult Value Value Word))
-> Value Word
-> CodeGenFunction r (CmpValueResult Value Value Word)
forall a b. (a -> b) -> a -> b
$ Word -> Value Word
forall a. IsConst a => a -> Value a
LLVM.valueOf (Word -> Value Word) -> Word -> Value Word
forall a b. (a -> b) -> a -> b
$
            Proxy n -> Word
forall n a. (Integer n, Num a) => Proxy n -> a
TypeNum.integralFromProxy (Proxy n -> Word) -> Proxy n -> Word
forall a b. (a -> b) -> a -> b
$ Exp (Array n a) -> Proxy n
forall (value :: * -> *) (array :: * -> * -> *) n a.
value (array n a) -> Proxy n
arraySize Exp (Array n a)
arrExp
      Value Bool -> T r c ()
forall z r. Phi z => Value Bool -> T r z ()
MaybeCont.guard Value Bool
inRange
      CodeGenFunction r (T a, Value Word) -> T r c (T a, Value Word)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r (T a, Value Word) -> T r c (T a, Value Word))
-> CodeGenFunction r (T a, Value Word) -> T r c (T a, Value Word)
forall a b. (a -> b) -> a -> b
$ do
         Value (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))
ptr <- Value (Ptr (Array n (Struct a)))
-> (Value Word, ())
-> CodeGenFunction
     r
     (Value
        (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ()))))
forall o i r.
GetElementPtr o i =>
Value (Ptr o)
-> i -> CodeGenFunction r (Value (Ptr (ElementPtrType o i)))
LLVM.getElementPtr0 Value (Ptr (Array n (Struct a)))
arrPtr (Value Word
i, ())
         (T a -> Value Word -> (T a, Value Word))
-> CodeGenFunction r (T a)
-> CodeGenFunction r (Value Word)
-> CodeGenFunction r (T a, Value Word)
forall a b c.
(a -> b -> c)
-> CodeGenFunction r a
-> CodeGenFunction r b
-> CodeGenFunction r c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Value (Ptr (Struct (T a))) -> CodeGenFunction r (T a)
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r. Value (Ptr (Struct (T a))) -> CodeGenFunction r (T a)
Memory.load Value (Ptr (Struct (T a)))
Value (Ptr (ElementPtrType (Array n (Struct a)) (Value Word, ())))
ptr) (Value Word -> CodeGenFunction r (Value Word)
forall a r.
(IsArithmetic a, IsConst a, Num a) =>
Value a -> CodeGenFunction r (Value a)
A.inc Value Word
i))
   (do
      Value (Ptr (Array n (Struct a)))
arrPtr <- CodeGenFunction r (Value (Ptr (Array n (Struct a))))
forall a r. IsSized a => CodeGenFunction r (Value (Ptr a))
LLVM.malloc
      (T (Array n a)
 -> Value (Ptr (Array n (Struct a))) -> CodeGenFunction r ())
-> Value (Ptr (Array n (Struct a)))
-> T (Array n a)
-> CodeGenFunction r ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip T (Array n a)
-> Value (Ptr (Struct (T (Array n a)))) -> CodeGenFunction r ()
T (Array n a)
-> Value (Ptr (Array n (Struct a))) -> CodeGenFunction r ()
forall r.
T (Array n a)
-> Value (Ptr (Struct (T (Array n a)))) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store Value (Ptr (Array n (Struct a)))
arrPtr (T (Array n a) -> CodeGenFunction r ())
-> CodeGenFunction r (T (Array n a)) -> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Exp (Array n a) -> forall r. CodeGenFunction r (T (Array n a))
forall a. Exp a -> forall r. CodeGenFunction r (T a)
Expr.unExp Exp (Array n a)
arrExp
      (Value (Ptr (Array n (Struct a))), Value Word)
-> CodeGenFunction r (Value (Ptr (Array n (Struct a))), Value Word)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (Ptr (Array n (Struct a)))
arrPtr, Value Word
forall a. Additive a => a
A.zero :: LLVM.Value Word))
   Value (Ptr (Array n (Struct a))) -> CodeGenFunction r ()
forall r. Value (Ptr (Array n (Struct a))) -> CodeGenFunction r ()
forall a r. IsType a => Value (Ptr a) -> CodeGenFunction r ()
LLVM.free


takeWhile :: (Expr.Aggregate ae a) => (ae -> Exp Bool) -> Sig.T a -> Sig.T a
takeWhile :: forall ae a. Aggregate ae a => (ae -> Exp Bool) -> T a -> T a
takeWhile ae -> Exp Bool
p =
   (forall r. a -> CodeGenFunction r (Value Bool)) -> T a -> T a
forall a.
(forall r. a -> CodeGenFunction r (Value Bool)) -> T a -> T a
Sig.takeWhile ((T Bool -> Value Bool)
-> CodeGenFunction r (T Bool) -> CodeGenFunction r (Value Bool)
forall a b. (a -> b) -> CodeGenFunction r a -> CodeGenFunction r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(MultiValue.Cons Repr Bool
cont) -> Repr Bool
Value Bool
cont) (CodeGenFunction r (T Bool) -> CodeGenFunction r (Value Bool))
-> (a -> CodeGenFunction r (T Bool))
-> a
-> CodeGenFunction r (Value Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ae -> Exp Bool) -> a -> CodeGenFunction r (T Bool)
forall ae am be bm r.
(Aggregate ae am, Aggregate be bm) =>
(ae -> be) -> am -> CodeGenFunction r bm
Expr.unliftM1 ae -> Exp Bool
p)

take :: Exp Word -> Sig.T a -> Sig.T a
take :: forall a. Exp Word -> T a -> T a
take Exp Word
len =
   (T Word -> a -> a) -> T (T Word) -> T a -> T a
forall a b c. (a -> b -> c) -> T a -> T b -> T c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((a -> T Word -> a) -> T Word -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> T Word -> a
forall a b. a -> b -> a
const) (T (T Word) -> T a -> T a) -> T (T Word) -> T a -> T a
forall a b. (a -> b) -> a -> b
$ (Exp Word -> Exp Bool) -> T (T Word) -> T (T Word)
forall ae a. Aggregate ae a => (ae -> Exp Bool) -> T a -> T a
takeWhile (Exp Word
0 Exp Word -> Exp Word -> Exp Bool
forall a. Comparison a => Exp a -> Exp a -> Exp Bool
Expr.<*) ((Exp Word -> Exp Word) -> Exp Word -> T (T Word)
forall a. C a => (Exp a -> Exp a) -> Exp a -> MV a
Core.iterate (Exp Word -> Exp Word -> Exp Word
forall a. C a => a -> a -> a
subtract Exp Word
1) Exp Word
len)

{- |
@tail empty@ generates the empty signal.
-}
tail :: Sig.T a -> Sig.T a
tail :: forall a. T a -> T a
tail (Sig.Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (a, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) = (forall r c.
 Phi c =>
 global -> Value (Ptr local) -> state -> T r c (a, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a
forall a global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> state -> T r c (a, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a
Sig.Cons
   global -> Value (Ptr local) -> state -> T r c (a, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (a, state)
next
   (do
      Value (Ptr local)
local <- CodeGenFunction r (Value (Ptr local))
forall a r. IsSized a => CodeGenFunction r (Value (Ptr a))
LLVM.alloca
      (global
global,state
s0) <- CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start
      T r (global, state) (a, state)
-> CodeGenFunction r (global, state)
-> ((a, state) -> CodeGenFunction r (global, state))
-> CodeGenFunction r (global, state)
forall r z a.
T r z a
-> CodeGenFunction r z
-> (a -> CodeGenFunction r z)
-> CodeGenFunction r z
MaybeCont.resolve (global
-> Value (Ptr local) -> state -> T r (global, state) (a, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (a, state)
next global
global Value (Ptr local)
local state
s0)
         ((global, state) -> CodeGenFunction r (global, state)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (global
global,state
s0))
         (\(a
_a,state
s1) -> (global, state) -> CodeGenFunction r (global, state)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (global
global,state
s1)))
   global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop

drop :: Exp Word -> Sig.T a -> Sig.T a
drop :: forall a. Exp Word -> T a -> T a
drop Exp Word
n (Sig.Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (a, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) = (forall r c.
 Phi c =>
 global -> Value (Ptr local) -> state -> T r c (a, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a
forall a global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> state -> T r c (a, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a
Sig.Cons
   global -> Value (Ptr local) -> state -> T r c (a, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (a, state)
next
   (do
      Value (Ptr local)
local <- CodeGenFunction r (Value (Ptr local))
forall a r. IsSized a => CodeGenFunction r (Value (Ptr a))
LLVM.alloca
      (global
global,state
state0) <- CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start
      ~(MultiValue.Cons Repr Word
nv) <- Exp Word -> forall r. CodeGenFunction r (T Word)
forall a. Exp a -> forall r. CodeGenFunction r (T a)
Expr.unExp Exp Word
n
      state
state1 <-
         (Value Word -> state -> CodeGenFunction r (Value Bool, state))
-> T r (Value Word) -> state -> CodeGenFunction r state
forall t a r.
Phi t =>
(a -> t -> CodeGenFunction r (Value Bool, t))
-> T r a -> t -> CodeGenFunction r t
Iter.mapWhileState_
            (\Value Word
_ state
s0 ->
               T r (Value Bool, state) (a, state)
-> CodeGenFunction r (Value Bool, state)
-> ((a, state) -> CodeGenFunction r (Value Bool, state))
-> CodeGenFunction r (Value Bool, state)
forall r z a.
T r z a
-> CodeGenFunction r z
-> (a -> CodeGenFunction r z)
-> CodeGenFunction r z
MaybeCont.resolve (global
-> Value (Ptr local) -> state -> T r (Value Bool, state) (a, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (a, state)
next global
global Value (Ptr local)
local state
s0)
                  ((Value Bool, state) -> CodeGenFunction r (Value Bool, state)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Value Bool
forall a. IsConst a => a -> Value a
LLVM.valueOf Bool
False, state
s0))
                  (\(a
_a,state
s1) -> (Value Bool, state) -> CodeGenFunction r (Value Bool, state)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Value Bool
forall a. IsConst a => a -> Value a
LLVM.valueOf Bool
True, state
s1)))
            (Value Word -> T r (Value Word)
forall i r.
(Num i, IsConst i, IsInteger i, CmpRet i, IsPrimitive i) =>
Value i -> T r (Value i)
Iter.countDown Repr Word
Value Word
nv) state
state0
      (global, state) -> CodeGenFunction r (global, state)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (global
global,state
state1))
   global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop


{- |
> cycle empty == empty
-}
cycle :: (Tuple.Phi a, Tuple.Undefined a) => Sig.T a -> Sig.T a
cycle :: forall a. (Phi a, Undefined a) => T a -> T a
cycle (Sig.Cons forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (a, state)
next forall r. CodeGenFunction r (global, state)
start forall r. global -> CodeGenFunction r ()
stop) =
   (forall r c.
 Phi c =>
 Value (Ptr (Struct global))
 -> Value (Ptr local) -> state -> T r c (a, state))
-> (forall r.
    CodeGenFunction r (Value (Ptr (Struct global)), state))
-> (forall r. Value (Ptr (Struct global)) -> CodeGenFunction r ())
-> T a
forall a global local state.
(C global, IsSized local, C state) =>
(forall r c.
 Phi c =>
 global -> Value (Ptr local) -> state -> T r c (a, state))
-> (forall r. CodeGenFunction r (global, state))
-> (forall r. global -> CodeGenFunction r ())
-> T a
Sig.Cons
      (\Value (Ptr (Struct global))
globalPtr Value (Ptr local)
local state
s0 ->
         T r (T (a, state)) (a, state)
-> T r (T (a, state)) (a, state) -> T r c (a, state)
forall z a r.
(Phi z, Undefined a) =>
T r (T a) a -> T r (T a) a -> T r z a
MaybeCont.alternative
            (do
               global
c0 <- CodeGenFunction r global -> T r (T (a, state)) global
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r global -> T r (T (a, state)) global)
-> CodeGenFunction r global -> T r (T (a, state)) global
forall a b. (a -> b) -> a -> b
$ Value (Ptr (Struct global)) -> CodeGenFunction r global
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r. Value (Ptr (Struct global)) -> CodeGenFunction r global
Memory.load Value (Ptr (Struct global))
globalPtr
               global
-> Value (Ptr local) -> state -> T r (T (a, state)) (a, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (a, state)
next global
c0 Value (Ptr local)
local state
s0)
            (do
               (global
c1,state
s1) <- CodeGenFunction r (global, state)
-> T r (T (a, state)) (global, state)
forall r a z. CodeGenFunction r a -> T r z a
MaybeCont.lift (CodeGenFunction r (global, state)
 -> T r (T (a, state)) (global, state))
-> CodeGenFunction r (global, state)
-> T r (T (a, state)) (global, state)
forall a b. (a -> b) -> a -> b
$ do
                  global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop (global -> CodeGenFunction r ())
-> CodeGenFunction r global -> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Ptr (Struct global)) -> CodeGenFunction r global
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r. Value (Ptr (Struct global)) -> CodeGenFunction r global
Memory.load Value (Ptr (Struct global))
globalPtr
                  (global, state)
cs1 <- CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start
                  global -> Value (Ptr (Struct global)) -> CodeGenFunction r ()
forall r.
global -> Value (Ptr (Struct global)) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store ((global, state) -> global
forall a b. (a, b) -> a
fst (global, state)
cs1) Value (Ptr (Struct global))
globalPtr
                  (global, state) -> CodeGenFunction r (global, state)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (global, state)
cs1
               global
-> Value (Ptr local) -> state -> T r (T (a, state)) (a, state)
forall r c.
Phi c =>
global -> Value (Ptr local) -> state -> T r c (a, state)
next global
c1 Value (Ptr local)
local state
s1))
      (do
         Value (Ptr (Struct global))
globalPtr <- CodeGenFunction r (Value (Ptr (Struct global)))
forall a r. IsSized a => CodeGenFunction r (Value (Ptr a))
LLVM.malloc
         (global
global,state
state) <- CodeGenFunction r (global, state)
forall r. CodeGenFunction r (global, state)
start
         global -> Value (Ptr (Struct global)) -> CodeGenFunction r ()
forall r.
global -> Value (Ptr (Struct global)) -> CodeGenFunction r ()
forall llvmValue r.
C llvmValue =>
llvmValue -> Value (Ptr (Struct llvmValue)) -> CodeGenFunction r ()
Memory.store global
global Value (Ptr (Struct global))
globalPtr
         (Value (Ptr (Struct global)), state)
-> CodeGenFunction r (Value (Ptr (Struct global)), state)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value (Ptr (Struct global))
globalPtr, state
state))
      (\Value (Ptr (Struct global))
globalPtr -> do
         global -> CodeGenFunction r ()
forall r. global -> CodeGenFunction r ()
stop (global -> CodeGenFunction r ())
-> CodeGenFunction r global -> CodeGenFunction r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value (Ptr (Struct global)) -> CodeGenFunction r global
forall llvmValue r.
C llvmValue =>
Value (Ptr (Struct llvmValue)) -> CodeGenFunction r llvmValue
forall r. Value (Ptr (Struct global)) -> CodeGenFunction r global
Memory.load Value (Ptr (Struct global))
globalPtr
         Value (Ptr (Struct global)) -> CodeGenFunction r ()
forall a r. IsType a => Value (Ptr a) -> CodeGenFunction r ()
LLVM.free Value (Ptr (Struct global))
globalPtr)


amplify ::
   (Expr.Aggregate ea a, Memory.C a, A.PseudoRing a) =>
   ea -> Sig.T a -> Sig.T a
amplify :: forall ea a.
(Aggregate ea a, C a, PseudoRing a) =>
ea -> T a -> T a
amplify ea
x = T a a -> SignalOf T a -> SignalOf T a
forall (process :: * -> * -> *) a b.
C process =>
process a b -> SignalOf process a -> SignalOf process b
apply ((forall r. a -> a -> CodeGenFunction r a) -> T (a, a) a
forall a b c.
(forall r. a -> b -> CodeGenFunction r c) -> T (a, b) c
Causal.zipWith a -> a -> CodeGenFunction r a
forall r. a -> a -> CodeGenFunction r a
forall a r. PseudoRing a => a -> a -> CodeGenFunction r a
Frame.amplifyMono T (a, a) a -> SignalOf T a -> T a a
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process a -> process b c
$< ea -> T a
forall ae al. (Aggregate ae al, C al) => ae -> T al
constant ea
x)


rampInf, rampSlope,
 parabolaFadeInInf, parabolaFadeOutInf ::
   (Marshal.C a, MultiValue.Field a, MultiValue.IntegerConstant a) =>
   Exp a -> MV a
rampSlope :: forall a. (C a, Field a, IntegerConstant a) => Exp a -> MV a
rampSlope Exp a
slope  =  Exp a -> Exp a -> MV a
forall a. (C a, Additive a) => Exp a -> Exp a -> MV a
Core.ramp Exp a
slope Exp a
forall a. C a => Exp a
Expr.zero
rampInf :: forall a. (C a, Field a, IntegerConstant a) => Exp a -> MV a
rampInf Exp a
dur  =  Exp a -> MV a
forall a. (C a, Field a, IntegerConstant a) => Exp a -> MV a
rampSlope (Exp a -> Exp a
forall a. (Field a, IntegerConstant a) => Exp a -> Exp a
Expr.recip Exp a
dur)

{-
t*(2-t) = 1 - (t-1)^2

(t+d)*(2-t-d) - t*(2-t)
   = d*(2-t) - d*t - d^2
   = 2*d*(1-t) - d^2
   = d*(2*(1-t) - d)

2*d*(1-t-d) + d^2  -  (2*d*(1-t) + d^2)
   = -2*d^2
-}
parabolaFadeInInf :: forall a. (C a, Field a, IntegerConstant a) => Exp a -> MV a
parabolaFadeInInf Exp a
dur =
   Exp a -> Exp a -> Exp a -> MV a
forall a. (C a, Additive a) => Exp a -> Exp a -> Exp a -> MV a
Core.parabola
      ((\Exp a
d -> -Exp a
2Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
*Exp a
dExp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
*Exp a
d)  (Exp a -> Exp a) -> Exp a -> Exp a
forall a b. (a -> b) -> a -> b
$ Exp a -> Exp a
forall a. (Field a, IntegerConstant a) => Exp a -> Exp a
Expr.recip Exp a
dur)
      ((\Exp a
d -> Exp a
dExp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
*(Exp a
2Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
-Exp a
d)) (Exp a -> Exp a) -> Exp a -> Exp a
forall a b. (a -> b) -> a -> b
$ Exp a -> Exp a
forall a. (Field a, IntegerConstant a) => Exp a -> Exp a
Expr.recip Exp a
dur)
      Exp a
forall a. C a => Exp a
Expr.zero

{-
1-t^2
-}
parabolaFadeOutInf :: forall a. (C a, Field a, IntegerConstant a) => Exp a -> MV a
parabolaFadeOutInf Exp a
dur =
   Exp a -> Exp a -> Exp a -> MV a
forall a. (C a, Additive a) => Exp a -> Exp a -> Exp a -> MV a
Core.parabola
      ((\Exp a
d -> -Exp a
2Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
*Exp a
dExp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
*Exp a
d) (Exp a -> Exp a) -> Exp a -> Exp a
forall a b. (a -> b) -> a -> b
$ Exp a -> Exp a
forall a. (Field a, IntegerConstant a) => Exp a -> Exp a
Expr.recip Exp a
dur)
      ((\Exp a
d ->   -Exp a
dExp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
*Exp a
d) (Exp a -> Exp a) -> Exp a -> Exp a
forall a b. (a -> b) -> a -> b
$ Exp a -> Exp a
forall a. (Field a, IntegerConstant a) => Exp a -> Exp a
Expr.recip Exp a
dur)
      Exp a
forall a. IntegerConstant a => Exp a
Expr.one

ramp,
 parabolaFadeIn, parabolaFadeOut,
 parabolaFadeInMap, parabolaFadeOutMap ::
   (Marshal.C a, MultiValue.Field a, MultiValue.IntegerConstant a,
    MultiValue.NativeFloating a ar) =>
   Exp Word -> MV a

ramp :: forall a ar.
(C a, Field a, IntegerConstant a, NativeFloating a ar) =>
Exp Word -> MV a
ramp Exp Word
dur =
   Exp Word -> T (T a) -> T (T a)
forall a. Exp Word -> T a -> T a
take Exp Word
dur (T (T a) -> T (T a)) -> T (T a) -> T (T a)
forall a b. (a -> b) -> a -> b
$ Exp a -> T (T a)
forall a. (C a, Field a, IntegerConstant a) => Exp a -> MV a
rampInf (Exp Word -> Exp a
forall i ir a ar.
(NativeInteger i ir, NativeFloating a ar) =>
Exp i -> Exp a
Expr.fromIntegral Exp Word
dur)

parabolaFadeIn :: forall a ar.
(C a, Field a, IntegerConstant a, NativeFloating a ar) =>
Exp Word -> MV a
parabolaFadeIn Exp Word
dur =
   Exp Word -> T (T a) -> T (T a)
forall a. Exp Word -> T a -> T a
take Exp Word
dur (T (T a) -> T (T a)) -> T (T a) -> T (T a)
forall a b. (a -> b) -> a -> b
$ Exp a -> T (T a)
forall a. (C a, Field a, IntegerConstant a) => Exp a -> MV a
parabolaFadeInInf (Exp Word -> Exp a
forall i ir a ar.
(NativeInteger i ir, NativeFloating a ar) =>
Exp i -> Exp a
Expr.fromIntegral Exp Word
dur)

parabolaFadeOut :: forall a ar.
(C a, Field a, IntegerConstant a, NativeFloating a ar) =>
Exp Word -> MV a
parabolaFadeOut Exp Word
dur =
   Exp Word -> T (T a) -> T (T a)
forall a. Exp Word -> T a -> T a
take Exp Word
dur (T (T a) -> T (T a)) -> T (T a) -> T (T a)
forall a b. (a -> b) -> a -> b
$ Exp a -> T (T a)
forall a. (C a, Field a, IntegerConstant a) => Exp a -> MV a
parabolaFadeOutInf (Exp Word -> Exp a
forall i ir a ar.
(NativeInteger i ir, NativeFloating a ar) =>
Exp i -> Exp a
Expr.fromIntegral Exp Word
dur)

parabolaFadeInMap :: forall a ar.
(C a, Field a, IntegerConstant a, NativeFloating a ar) =>
Exp Word -> MV a
parabolaFadeInMap Exp Word
dur =
   (forall r. T a -> CodeGenFunction r (T a)) -> T (T a) (T a)
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
Causal.map ((Exp a -> Exp a) -> T a -> CodeGenFunction r (T a)
forall ae am be bm r.
(Aggregate ae am, Aggregate be bm) =>
(ae -> be) -> am -> CodeGenFunction r bm
Expr.unliftM1 (\Exp a
t -> Exp a
tExp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
*(Exp a
2Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
-Exp a
t))) T (T a) (T a) -> SignalOf T (T a) -> SignalOf T (T a)
forall (process :: * -> * -> *) a b.
C process =>
process a b -> SignalOf process a -> SignalOf process b
$* Exp Word -> T (T a)
forall a ar.
(C a, Field a, IntegerConstant a, NativeFloating a ar) =>
Exp Word -> MV a
ramp Exp Word
dur

parabolaFadeOutMap :: forall a ar.
(C a, Field a, IntegerConstant a, NativeFloating a ar) =>
Exp Word -> MV a
parabolaFadeOutMap Exp Word
dur =
   (forall r. T a -> CodeGenFunction r (T a)) -> T (T a) (T a)
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
Causal.map ((Exp a -> Exp a) -> T a -> CodeGenFunction r (T a)
forall ae am be bm r.
(Aggregate ae am, Aggregate be bm) =>
(ae -> be) -> am -> CodeGenFunction r bm
Expr.unliftM1 (\Exp a
t -> Exp a
1Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
-Exp a
tExp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
*Exp a
t)) T (T a) (T a) -> SignalOf T (T a) -> SignalOf T (T a)
forall (process :: * -> * -> *) a b.
C process =>
process a b -> SignalOf process a -> SignalOf process b
$* Exp Word -> T (T a)
forall a ar.
(C a, Field a, IntegerConstant a, NativeFloating a ar) =>
Exp Word -> MV a
ramp Exp Word
dur


osci ::
   (MultiValue.Fraction t, Marshal.C t) =>
   (forall r. MultiValue.T t -> CodeGenFunction r y) ->
   Exp t -> Exp t -> Sig.T y
osci :: forall t y.
(Fraction t, C t) =>
(forall r. T t -> CodeGenFunction r y) -> Exp t -> Exp t -> T y
osci forall r. T t -> CodeGenFunction r y
wave Exp t
phase Exp t
freq  =  (forall r. T t -> CodeGenFunction r y) -> T (T t) y
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
Causal.map T t -> CodeGenFunction r y
forall r. T t -> CodeGenFunction r y
wave T (T t) y -> SignalOf T (T t) -> SignalOf T y
forall (process :: * -> * -> *) a b.
C process =>
process a b -> SignalOf process a -> SignalOf process b
$* Exp t -> Exp t -> MV t
forall t. (Fraction t, C t) => Exp t -> Exp t -> MV t
Core.osci Exp t
phase Exp t
freq


exponential2 ::
   (Marshal.C a) =>
   (MultiValue.Real a) =>
   (MultiValue.RationalConstant a) =>
   (MultiValue.Transcendental a) =>
   Exp a -> Exp a -> MV a
exponential2 :: forall a.
(C a, Real a, RationalConstant a, Transcendental a) =>
Exp a -> Exp a -> MV a
exponential2 Exp a
halfLife  =  Exp a -> Exp a -> MV a
forall a. (C a, PseudoRing a) => Exp a -> Exp a -> MV a
Core.exponential (Exp a
1 Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
/ Exp a
2 Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
** Exp a -> Exp a
forall a. C a => a -> a
recip Exp a
halfLife)

exponentialBounded2 ::
   (Marshal.C a) =>
   (MultiValue.Real a) =>
   (MultiValue.RationalConstant a) =>
   (MultiValue.Transcendental a) =>
   Exp a -> Exp a -> Exp a -> MV a
exponentialBounded2 :: forall a.
(C a, Real a, RationalConstant a, Transcendental a) =>
Exp a -> Exp a -> Exp a -> MV a
exponentialBounded2 Exp a
bound Exp a
halfLife =
   Exp a -> Exp a -> Exp a -> MV a
forall a.
(C a, PseudoRing a, Real a, IntegerConstant a) =>
Exp a -> Exp a -> Exp a -> MV a
Core.exponentialBounded Exp a
bound (Exp a
1 Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
/ Exp a
2 Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
** Exp a -> Exp a
forall a. C a => a -> a
recip Exp a
halfLife)


{- |
@noise seed rate@

The @rate@ parameter is for adjusting the amplitude
such that it is uniform across different sample rates
and after frequency filters.
The @rate@ is the ratio of the current sample rate to the default sample rate,
where the variance of the samples would be one.
If you want that at sample rate 22050 the variance is 1,
then in order to get a consistent volume at sample rate 44100
you have to set @rate = 2@.

I use the variance as quantity and not the amplitude,
because the amplitude makes only sense for uniformly distributed samples.
However, frequency filters transform the probabilistic density of the samples
towards the normal distribution according to the central limit theorem.
-}
noise ::
   (Marshal.C a, MultiValue.Transcendental a, MultiValue.RationalConstant a,
    MultiValue.NativeFloating a ar) =>
   Exp Word32 -> Exp a -> MV a
noise :: forall a ar.
(C a, Transcendental a, RationalConstant a, NativeFloating a ar) =>
Exp Word32 -> Exp a -> MV a
noise Exp Word32
seed Exp a
rate =
   let m2 :: Exp a
m2 = Integer -> Exp a
forall a. IntegerConstant a => Integer -> Exp a
Expr.fromInteger' (Integer -> Exp a) -> Integer -> Exp a
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. C a => a -> a -> a
div Integer
forall a. Integral a => a
Rnd.modulus Integer
2
       r :: Exp a
r = Exp a -> Exp a
forall a. C a => a -> a
sqrt (Exp a
3 Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
* Exp a
rate) Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
/ Exp a
m2
   in  (forall r. T Word32 -> CodeGenFunction r (T a))
-> T (T Word32) (T a)
forall a b. (forall r. a -> CodeGenFunction r b) -> T a b
Causal.map ((Exp Word32 -> Exp a) -> T Word32 -> CodeGenFunction r (T a)
forall ae am be bm r.
(Aggregate ae am, Aggregate be bm) =>
(ae -> be) -> am -> CodeGenFunction r bm
Expr.unliftM1 (\Exp Word32
y -> Exp a
r Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
* (Exp Word32 -> Exp a
forall a ar. NativeFloating a ar => Exp Word32 -> Exp a
int31tofp Exp Word32
y Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
- (Exp a
m2Exp a -> Exp a -> Exp a
forall a. C a => a -> a -> a
+Exp a
1)))) T (T Word32) (T a) -> SignalOf T (T Word32) -> SignalOf T (T a)
forall (process :: * -> * -> *) a b.
C process =>
process a b -> SignalOf process a -> SignalOf process b
$*
       Exp Word32 -> MV Word32
Core.noise Exp Word32
seed

{-
sitofp is a single instruction on x86
and thus we use it, since the arguments are below 2^31.
-}
int31tofp ::
   (MultiValue.NativeFloating a ar) =>
   Exp Word32 -> Exp a
int31tofp :: forall a ar. NativeFloating a ar => Exp Word32 -> Exp a
int31tofp =
   (forall r. T Word32 -> CodeGenFunction r (T a))
-> Exp Word32 -> Exp a
forall ae am b.
Aggregate ae am =>
(forall r. am -> CodeGenFunction r (T b)) -> ae -> Exp b
Expr.liftM
      (T Int32 -> CodeGenFunction r (T a)
forall i ir a ar r.
(NativeInteger i ir, NativeFloating a ar) =>
T i -> CodeGenFunction r (T a)
MultiValue.fromIntegral (T Int32 -> CodeGenFunction r (T a))
-> (T Word32 -> CodeGenFunction r (T Int32))
-> T Word32
-> CodeGenFunction r (T a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=<
       ((Repr Word32 -> CodeGenFunction r (Repr Int32))
-> T Word32 -> CodeGenFunction r (T Int32)
forall (m :: * -> *) a b.
Monad m =>
(Repr a -> m (Repr b)) -> T a -> m (T b)
MultiValue.liftM Repr Word32 -> CodeGenFunction r (Repr Int32)
Value Word32 -> CodeGenFunction r (Value Int32)
forall (value :: * -> *) a b r.
(ValueCons value, IsSized a, IsSized b, SizeOf a ~ SizeOf b) =>
value a -> CodeGenFunction r (value b)
LLVM.bitcast ::
         MultiValue.T Word32 -> CodeGenFunction r (MultiValue.T Int32)))


adjacentNodes02 ::
   (Memory.C a) =>
   Sig.T a -> Sig.T (Interpolation.Nodes02 a)
adjacentNodes02 :: forall a. C a => T a -> T (Nodes02 a)
adjacentNodes02 =
   T (Nodes02 a) -> T (Nodes02 a)
forall a. T a -> T a
tail
   (T (Nodes02 a) -> T (Nodes02 a))
-> (T a -> T (Nodes02 a)) -> T a -> T (Nodes02 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T a (Nodes02 a) -> SignalOf T a -> SignalOf T (Nodes02 a)
forall (process :: * -> * -> *) a b.
C process =>
process a b -> SignalOf process a -> SignalOf process b
apply
      ((forall r. a -> a -> CodeGenFunction r (Nodes02 a, a))
-> (forall r. CodeGenFunction r a) -> T a (Nodes02 a)
forall state a b.
C state =>
(forall r. a -> state -> CodeGenFunction r (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
Causal.mapAccum
         (\a
new a
old -> (Nodes02 a, a) -> CodeGenFunction r (Nodes02 a, a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a -> Nodes02 a
forall a. a -> a -> Nodes02 a
Interpolation.Nodes02 a
old a
new, a
new))
         (a -> CodeGenFunction r a
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Undefined a => a
Tuple.undef))

adjacentNodes13 ::
   (Marshal.C a, MultiValue.T a ~ al) =>
   Exp a -> Sig.T al -> Sig.T (Interpolation.Nodes13 al)
adjacentNodes13 :: forall a al. (C a, T a ~ al) => Exp a -> T al -> T (Nodes13 al)
adjacentNodes13 Exp a
yp0 =
   T (Nodes13 al) -> T (Nodes13 al)
forall a. T a -> T a
tail (T (Nodes13 al) -> T (Nodes13 al))
-> (T al -> T (Nodes13 al)) -> T al -> T (Nodes13 al)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T (Nodes13 al) -> T (Nodes13 al)
forall a. T a -> T a
tail (T (Nodes13 al) -> T (Nodes13 al))
-> (T al -> T (Nodes13 al)) -> T al -> T (Nodes13 al)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T (T a) (Nodes13 (T a))
-> SignalOf T (T a) -> SignalOf T (Nodes13 (T a))
forall (process :: * -> * -> *) a b.
C process =>
process a b -> SignalOf process a -> SignalOf process b
apply
      ((forall r.
 T a
 -> (T a, T a, T a)
 -> CodeGenFunction r (Nodes13 (T a), (T a, T a, T a)))
-> (forall r. CodeGenFunction r (T a, T a, T a))
-> T (T a) (Nodes13 (T a))
forall state a b.
C state =>
(forall r. a -> state -> CodeGenFunction r (b, state))
-> (forall r. CodeGenFunction r state) -> T a b
Causal.mapAccum
         (\T a
new (T a
x0, T a
x1, T a
x2) ->
            (Nodes13 (T a), (T a, T a, T a))
-> CodeGenFunction r (Nodes13 (T a), (T a, T a, T a))
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (T a -> T a -> T a -> T a -> Nodes13 (T a)
forall a. a -> a -> a -> a -> Nodes13 a
Interpolation.Nodes13 T a
x0 T a
x1 T a
x2 T a
new, (T a
x1, T a
x2, T a
new)))
         (do
            T a
y0 <- Exp a -> forall r. CodeGenFunction r (T a)
forall a. Exp a -> forall r. CodeGenFunction r (T a)
Expr.unExp Exp a
yp0
            (T a, T a, T a) -> CodeGenFunction r (T a, T a, T a)
forall a. a -> CodeGenFunction r a
forall (m :: * -> *) a. Monad m => a -> m a
return (T a
forall a. C a => T a
MultiValue.undef, T a
forall a. C a => T a
MultiValue.undef, T a
y0)))


{- |
Stretch signal in time by a certain factor.

This can be used for doing expensive computations
of filter parameters at a lower rate.
Alternatively, we could provide an adaptive @map@
that recomputes output values only if the input value changes,
or if the input value differs from the last processed one by a certain amount.
-}
interpolateConstant ::
   (Memory.C a, Marshal.C b, MultiValue.IntegerConstant b,
    MultiValue.Additive b, MultiValue.Comparison b) =>
   Exp b -> Sig.T a -> Sig.T a
interpolateConstant :: forall a b.
(C a, C b, IntegerConstant b, Additive b, Comparison b) =>
Exp b -> T a -> T a
interpolateConstant Exp b
k T a
sig =
   T () a -> SignalOf T a
forall a. T () a -> SignalOf T a
forall (process :: * -> * -> *) a.
C process =>
process () a -> SignalOf process a
CausalC.toSignal (T () a -> T (T b, ()) a
forall b c a.
(C b, C c, IntegerConstant c, Additive c, Comparison c) =>
T a b -> T (T c, a) b
Causal.quantizeLift (SignalOf T a -> T () a
forall b a. SignalOf T b -> T a b
forall (process :: * -> * -> *) b a.
C process =>
SignalOf process b -> process a b
CausalC.fromSignal SignalOf T a
T a
sig) T (T b, ()) a -> SignalOf T (T b) -> T () a
forall (process :: * -> * -> *) a b c.
C process =>
process (a, b) c -> SignalOf process a -> process b c
$< Exp b -> T (T b)
forall ae al. (Aggregate ae al, C al) => ae -> T al
constant Exp b
k)