Vanilla.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
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 qualified Data.StorableVector.Lazy as SVL
import qualified Data.StorableVector as SV
import qualified Data.StorableVector.Base as SVB
-}

-- import qualified Synthesizer.LLVM.Frame.Stereo as Stereo

import LLVM.Core

-- import Control.Monad (liftM2, liftM3, )

-- import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealRing as RealRing
-- import qualified Algebra.Field as Field
-- import qualified Algebra.Ring as Ring
-- import qualified Algebra.Additive as Additive

-- import NumericPrelude.Numeric
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 (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 (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