--------------------------------------------------------------------------------
-- Copyright © 2011 National Institute of Aerospace / Galois, Inc.
--------------------------------------------------------------------------------


{-# LANGUAGE Safe #-}

-- | Temporal stream transformations.
module Copilot.Language.Operators.Temporal
  ( (++)
  , drop
  ) where

import Copilot.Core (Typed)
import Copilot.Language.Prelude
import Copilot.Language.Stream
import Prelude ()

--------------------------------------------------------------------------------

infixr 1 ++

-- | Prepend a fixed number of samples to a stream.
--
-- The elements to be appended at the beginning of the stream must be limited,
-- that is, the list must have finite length.
--
-- Prepending elements to a stream may increase the memory requirements of the
-- generated programs (which now must hold the same number of elements in
-- memory for future processing).
(++) :: Typed a => [a] -> Stream a -> Stream a
++ :: [a] -> Stream a -> Stream a
(++) = ([a] -> Maybe (Stream Bool) -> Stream a -> Stream a
forall a.
Typed a =>
[a] -> Maybe (Stream Bool) -> Stream a -> Stream a
`Append` Maybe (Stream Bool)
forall a. Maybe a
Nothing)

-- | Drop a number of samples from a stream.
--
-- The elements must be realizable at the present time to be able to drop
-- elements. For most kinds of streams, you cannot drop elements without
-- prepending an equal or greater number of elements to them first, as it
-- could result in undefined samples.
drop :: Typed a => Int -> Stream a -> Stream a
drop :: Int -> Stream a -> Stream a
drop Int
0 Stream a
s             = Stream a
s
drop Int
_ ( Const a
j )   = a -> Stream a
forall a. Typed a => a -> Stream a
Const a
j
drop Int
i ( Drop  Int
j Stream a
s ) = Int -> Stream a -> Stream a
forall a. Typed a => Int -> Stream a -> Stream a
Drop (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j) Stream a
s
drop Int
i Stream a
s             = Int -> Stream a -> Stream a
forall a. Typed a => Int -> Stream a -> Stream a
Drop (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)     Stream a
s