Vanilla.hs

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

import qualified Synthesizer.LLVM.Simple.Signal as Sig
import qualified LLVM.Extra.Memory as Memory
import qualified Synthesizer.LLVM.Simple.Value as Value
import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.MaybeContinuation as Maybe

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

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),
    Memory.FirstClass t, Memory.Stored t ~ tm, IsSized t, IsSized tm,
    SoV.Fraction t, IsConst 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),
    Memory.FirstClass t, Memory.Stored t ~ tm, IsSized t, IsSized tm,
    SoV.Fraction t, IsConst 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