{-# LANGUAGE TypeFamilies #-}
{- |
A special vector type that represents a time-sequence of samples.
This way we can distinguish safely between LLVM vectors
used for parallel signals and pipelines and
those used for chunky processing of scalar signals.
For the chunky processing this data type allows us
to derive the factor from the type
that time constants have to be multiplied with.
-}
module Synthesizer.LLVM.Frame.SerialVector.Plain (
   T(Cons),
   fromList,
   replicate,
   iterate,
   ) where

import qualified Synthesizer.LLVM.Frame.SerialVector.Code as Code
import Synthesizer.LLVM.Frame.SerialVector.Code (T)

import qualified LLVM.Core as LLVM

import qualified Type.Data.Num.Decimal as TypeNum

import qualified Data.NonEmpty.Class as NonEmptyC
import qualified Data.NonEmpty as NonEmpty

import Prelude as P hiding (zip, unzip, last, reverse, iterate, replicate)


fromList :: (TypeNum.Positive n) => NonEmpty.T [] a -> T n a
fromList :: forall n a. Positive n => T [] a -> T n a
fromList = Vector n a -> T n a
forall n a. Vector n a -> T n a
Code.Cons (Vector n a -> T n a) -> (T [] a -> Vector n a) -> T [] a -> T n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T [] a -> Vector n a
forall n a. Positive n => T [] a -> Vector n a
LLVM.cyclicVector

replicate :: (TypeNum.Positive n) => a -> T n a
replicate :: forall n a. Positive n => a -> T n a
replicate = Vector n a -> T n a
forall n a. Vector n a -> T n a
Code.Cons (Vector n a -> T n a) -> (a -> Vector n a) -> a -> T n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Vector n a
forall a. a -> Vector n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

iterate :: (TypeNum.Positive n) => (a -> a) -> a -> T n a
iterate :: forall n a. Positive n => (a -> a) -> a -> T n a
iterate a -> a
f a
x = T [] a -> T n a
forall n a. Positive n => T [] a -> T n a
fromList (T [] a -> T n a) -> T [] a -> T n a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> T [] a
forall a. (a -> a) -> a -> T [] a
forall (f :: * -> *) a. Iterate f => (a -> a) -> a -> f a
NonEmptyC.iterate a -> a
f a
x