{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE TypeFamilies        #-}
{-# OPTIONS_HADDOCK hide #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module      : Data.Array.Accelerate.Sugar.Vec
-- Copyright   : [2008..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.Sugar.Vec
  where

import Data.Array.Accelerate.Sugar.Elt
import Data.Array.Accelerate.Representation.Tag
import Data.Array.Accelerate.Representation.Type
import Data.Array.Accelerate.Type
import Data.Primitive.Types
import Data.Primitive.Vec

import GHC.TypeLits
import GHC.Prim


type VecElt a = (Elt a, Prim a, IsSingle a, EltR a ~ a)

instance (KnownNat n, VecElt a) => Elt (Vec n a) where
  type EltR (Vec n a) = Vec n a
  eltR :: TypeR (EltR (Vec n a))
eltR    = ScalarType (Vec n a) -> TupR ScalarType (Vec n a)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (VectorType (Vec n a) -> ScalarType (Vec n a)
forall (n :: Nat) a. VectorType (Vec n a) -> ScalarType (Vec n a)
VectorScalarType (Int -> SingleType a -> VectorType (Vec n a)
forall (n :: Nat) a.
KnownNat n =>
Int -> SingleType a -> VectorType (Vec n a)
VectorType (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy# n -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# n
forall k (a :: k). Proxy# a
proxy# :: Proxy# n))) SingleType a
forall a. IsSingle a => SingleType a
singleType))
  tagsR :: [TagR (EltR (Vec n a))]
tagsR   = [ScalarType (Vec n a) -> TagR (Vec n a)
forall a. ScalarType a -> TagR a
TagRsingle (VectorType (Vec n a) -> ScalarType (Vec n a)
forall (n :: Nat) a. VectorType (Vec n a) -> ScalarType (Vec n a)
VectorScalarType (Int -> SingleType a -> VectorType (Vec n a)
forall (n :: Nat) a.
KnownNat n =>
Int -> SingleType a -> VectorType (Vec n a)
VectorType (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy# n -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# n
forall k (a :: k). Proxy# a
proxy# :: Proxy# n))) SingleType a
forall a. IsSingle a => SingleType a
singleType))]
  toElt :: EltR (Vec n a) -> Vec n a
toElt   = EltR (Vec n a) -> Vec n a
forall a. a -> a
id
  fromElt :: Vec n a -> EltR (Vec n a)
fromElt = Vec n a -> EltR (Vec n a)
forall a. a -> a
id