{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
module Synthesizer.LLVM.Simple.Vanilla where

import qualified Synthesizer.LLVM.Simple.Signal as Sig
import qualified LLVM.Extra.Representation as Rep
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 ::
   (IsFirstClass a, IsSized a size) =>
   (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.decons (f (Value.constantValue y))))
      (Value.decons initial)

iterate ::
   (Value.Flatten a reg, Rep.Memory reg packed, IsSized packed size) =>
   (a -> a) ->
   (a -> Sig.T a)
iterate f initial =
   Sig.simple
      (\y ->
         Maybe.lift $
         fmap (\y1 -> (Value.unfold y, y1))
              (Value.flatten (f (Value.unfold y))))
      (Value.flatten initial)



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


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

osciVal ::
   (RealRing.C (Value.T t),
    IsFirstClass t, IsSized t size,
    SoV.Fraction t, IsConst t) =>
   Wave.T (Value.T t) y ->
   Value.T t -> Value.T 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 a -> Value.T a -> Value.T a
incPhaseVal = Value.binop SoV.incPhase

osci ::
   (RealRing.C t,
    Value.Flatten t reg,
    Rep.Memory reg struct, IsSized struct size,
    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