Vanilla.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
module Synthesizer.LLVM.Simple.Vanilla where

import qualified Synthesizer.LLVM.Simple.Signal as Sig
import qualified Synthesizer.LLVM.Simple.Value as Value

import qualified Synthesizer.Basic.Phase as Phase
import qualified Synthesizer.Basic.Wave  as Wave

import qualified LLVM.Extra.MaybeContinuation as Maybe
import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Memory as Memory
import LLVM.Core (IsArithmetic, IsConst, IsFirstClass, IsSized, Value)

import qualified Algebra.RealRing as RealRing

import NumericPrelude.Base hiding (and, iterate, map, zipWith)


iterateVal ::
   (Memory.C a) =>
   (Value.T a -> Value.T a) ->
   Value.T a -> Sig.T (Value.T a)
iterateVal f initial =
   Sig.simple
      (\y ->
         Maybe.lift $
         fmap (\y1 -> (Value.constantValue y, y1))
              (Value.unlift1 f y))
      (Value.decons initial)

iterate ::
   (Value.Flatten a, Value.Registers a ~ reg, Memory.C reg) =>
   (a -> a) ->
   (a -> Sig.T a)
iterate f initial =
   Sig.simple
      (\y ->
         Maybe.lift $
         fmap (\y1 -> (Value.unfold y, y1))
              (Value.flattenFunction f y))
      (Value.flatten initial)



map ::
   (a -> b) ->
   Sig.T a -> Sig.T b
map f = Sig.map (return . f)


osciReg ::
   (RealRing.C tv, tv ~ Value.T (Value t),
    SoV.Fraction t, IsConst t, IsSized t,
    IsFirstClass y) =>
   Wave.T (Value.T (Value t)) (Value.T (Value y)) ->
   Value t -> Value t -> Sig.T (Value y)
osciReg wave phase freq =
   Sig.map
      (Value.unlift1 $ Wave.apply wave . Phase.fromRepresentative) $
   Sig.iterate (SoV.incPhase freq) phase

osciVal ::
   (RealRing.C tv, tv ~ Value.T (Value t),
    SoV.Fraction t, IsConst t, IsSized t) =>
   Wave.T (Value.T (Value t)) y ->
   Value.T (Value t) -> Value.T (Value t) -> Sig.T y
osciVal wave phase freq =
   map (Wave.apply wave . Phase.fromRepresentative) $
   iterateVal (incPhaseVal freq) phase

incPhaseVal ::
   (SoV.Fraction a, IsArithmetic a) =>
   Value.T (Value a) -> Value.T (Value a) -> Value.T (Value a)
incPhaseVal = Value.lift2 SoV.incPhase

osci ::
   (RealRing.C t,
    Value.Flatten t, Value.Registers t ~ reg, Memory.C reg,
    SoV.Fraction t, IsConst t) =>
   Wave.T t y ->
   Phase.T t -> t -> Sig.T y
osci wave phase freq =
   map (Wave.apply wave) $
   iterate (Phase.increment freq) phase