{-# LANGUAGE Safe #-}

{-# LANGUAGE TypeFamilies #-}

-- | Combinators to deal with streams carrying arrays.
module Copilot.Language.Operators.Array
  ( (.!!)
  ) where

import Copilot.Core             ( Typed
                                , Op2 (Index)
                                , typeOf
                                , Array
                                , InnerType
                                , Flatten)
import Copilot.Language.Stream  (Stream (..))

import Data.Word                (Word32)
import GHC.TypeLits             (KnownNat)

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

-- | Create a stream that carries an element of an array in another stream.
--
-- This function implements a projection of the element of an array at a given
-- position, over time. For example, if @s@ is a stream of type @Stream (Array
-- '5 Word8)@, then @s .!! 3@ has type @Stream Word8@ and contains the 3rd
-- element (starting from zero) of the arrays in @s@ at any point in time.
(.!!) :: ( KnownNat n
         , t' ~ InnerType t
         , Flatten t t'
         , Typed t
         , Typed t'
         ) => Stream (Array n t) -> Stream Word32 -> Stream t
Stream (Array n t)
arr .!! :: Stream (Array n t) -> Stream Word32 -> Stream t
.!! Stream Word32
n = Op2 (Array n t) Word32 t
-> Stream (Array n t) -> Stream Word32 -> Stream t
forall a b c.
(Typed a, Typed b, Typed c) =>
Op2 a b c -> Stream a -> Stream b -> Stream c
Op2 (Type (Array n t) -> Op2 (Array n t) Word32 t
forall (n :: Nat) c. Type (Array n c) -> Op2 (Array n c) Word32 c
Index Type (Array n t)
forall a. Typed a => Type a
typeOf) Stream (Array n t)
arr Stream Word32
n

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