{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PatternSynonyms     #-}
{-# LANGUAGE RoleAnnotations     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}
{-# LANGUAGE ViewPatterns        #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : Data.Array.Accelerate.Type
-- Copyright   : [2008..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
--  Primitive scalar types supported by Accelerate
--
--  Integral types:
--    * Int
--    * Int8
--    * Int16
--    * Int32
--    * Int64
--    * Word
--    * Word8
--    * Word16
--    * Word32
--    * Word64
--
--  Floating types:
--    * Half
--    * Float
--    * Double
--
--  SIMD vector types of the above:
--    * Vec2
--    * Vec3
--    * Vec4
--    * Vec8
--    * Vec16
--
-- Note that 'Int' has the same bit width as in plain Haskell computations.
-- 'Float' and 'Double' represent IEEE single and double precision floating
-- point numbers, respectively.
--

module Data.Array.Accelerate.Type (

  Half(..), Float, Double,
  module Data.Int,
  module Data.Word,
  module Foreign.C.Types,
  module Data.Array.Accelerate.Type,

) where

import Data.Array.Accelerate.Orphans () -- Prim Half
import Data.Primitive.Vec

import Data.Bits
import Data.Int
import Data.Primitive.Types
import Data.Type.Equality
import Data.Word
import Foreign.C.Types
import Foreign.Storable                                             ( Storable )
import Formatting
import Language.Haskell.TH.Extra
import Numeric.Half
import Text.Printf

import GHC.Prim
import GHC.TypeLits


-- Scalar types
-- ------------

-- Reified dictionaries
--
data SingleDict a where
  SingleDict :: ( Eq a, Ord a, Show a, Storable a, Prim a )
             => SingleDict a

data IntegralDict a where
  IntegralDict :: ( Eq a, Ord a, Show a
                  , Bounded a, Bits a, FiniteBits a, Integral a, Num a, Real a, Storable a )
               => IntegralDict a

data FloatingDict a where
  FloatingDict :: ( Eq a, Ord a, Show a
                  , Floating a, Fractional a, Num a, Real a, RealFrac a, RealFloat a, Storable a )
               => FloatingDict a


-- Scalar type representation
--

-- | Integral types supported in array computations.
--
data IntegralType a where
  TypeInt     :: IntegralType Int
  TypeInt8    :: IntegralType Int8
  TypeInt16   :: IntegralType Int16
  TypeInt32   :: IntegralType Int32
  TypeInt64   :: IntegralType Int64
  TypeWord    :: IntegralType Word
  TypeWord8   :: IntegralType Word8
  TypeWord16  :: IntegralType Word16
  TypeWord32  :: IntegralType Word32
  TypeWord64  :: IntegralType Word64

-- | Floating-point types supported in array computations.
--
data FloatingType a where
  TypeHalf    :: FloatingType Half
  TypeFloat   :: FloatingType Float
  TypeDouble  :: FloatingType Double

-- | Numeric element types implement Num & Real
--
data NumType a where
  IntegralNumType :: IntegralType a -> NumType a
  FloatingNumType :: FloatingType a -> NumType a

-- | Bounded element types implement Bounded
--
data BoundedType a where
  IntegralBoundedType :: IntegralType a -> BoundedType a

-- | All scalar element types implement Eq & Ord
--
data ScalarType a where
  SingleScalarType :: SingleType a         -> ScalarType a
  VectorScalarType :: VectorType (Vec n a) -> ScalarType (Vec n a)

data SingleType a where
  NumSingleType :: NumType a -> SingleType a

data VectorType a where
  VectorType :: KnownNat n => {-# UNPACK #-} !Int -> SingleType a -> VectorType (Vec n a)

instance Show (IntegralType a) where
  show :: IntegralType a -> String
show IntegralType a
TypeInt    = String
"Int"
  show IntegralType a
TypeInt8   = String
"Int8"
  show IntegralType a
TypeInt16  = String
"Int16"
  show IntegralType a
TypeInt32  = String
"Int32"
  show IntegralType a
TypeInt64  = String
"Int64"
  show IntegralType a
TypeWord   = String
"Word"
  show IntegralType a
TypeWord8  = String
"Word8"
  show IntegralType a
TypeWord16 = String
"Word16"
  show IntegralType a
TypeWord32 = String
"Word32"
  show IntegralType a
TypeWord64 = String
"Word64"

instance Show (FloatingType a) where
  show :: FloatingType a -> String
show FloatingType a
TypeHalf   = String
"Half"
  show FloatingType a
TypeFloat  = String
"Float"
  show FloatingType a
TypeDouble = String
"Double"

instance Show (NumType a) where
  show :: NumType a -> String
show (IntegralNumType IntegralType a
ty) = IntegralType a -> String
forall a. Show a => a -> String
show IntegralType a
ty
  show (FloatingNumType FloatingType a
ty) = FloatingType a -> String
forall a. Show a => a -> String
show FloatingType a
ty

instance Show (BoundedType a) where
  show :: BoundedType a -> String
show (IntegralBoundedType IntegralType a
ty) = IntegralType a -> String
forall a. Show a => a -> String
show IntegralType a
ty

instance Show (SingleType a) where
  show :: SingleType a -> String
show (NumSingleType NumType a
ty) = NumType a -> String
forall a. Show a => a -> String
show NumType a
ty

instance Show (VectorType a) where
  show :: VectorType a -> String
show (VectorType Int
n SingleType a
ty) = String -> Int -> ShowS
forall r. PrintfType r => String -> r
printf String
"<%d x %s>" Int
n (SingleType a -> String
forall a. Show a => a -> String
show SingleType a
ty)

instance Show (ScalarType a) where
  show :: ScalarType a -> String
show (SingleScalarType SingleType a
ty) = SingleType a -> String
forall a. Show a => a -> String
show SingleType a
ty
  show (VectorScalarType VectorType (Vec n a)
ty) = VectorType (Vec n a) -> String
forall a. Show a => a -> String
show VectorType (Vec n a)
ty

formatIntegralType :: Format r (IntegralType a -> r)
formatIntegralType :: forall r a. Format r (IntegralType a -> r)
formatIntegralType = (IntegralType a -> Builder) -> Format r (IntegralType a -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((IntegralType a -> Builder) -> Format r (IntegralType a -> r))
-> (IntegralType a -> Builder) -> Format r (IntegralType a -> r)
forall a b. (a -> b) -> a -> b
$ \case
  IntegralType a
TypeInt    -> Builder
"Int"
  IntegralType a
TypeInt8   -> Builder
"Int8"
  IntegralType a
TypeInt16  -> Builder
"Int16"
  IntegralType a
TypeInt32  -> Builder
"Int32"
  IntegralType a
TypeInt64  -> Builder
"Int64"
  IntegralType a
TypeWord   -> Builder
"Word"
  IntegralType a
TypeWord8  -> Builder
"Word8"
  IntegralType a
TypeWord16 -> Builder
"Word16"
  IntegralType a
TypeWord32 -> Builder
"Word32"
  IntegralType a
TypeWord64 -> Builder
"Word64"

formatFloatingType :: Format r (FloatingType a -> r)
formatFloatingType :: forall r a. Format r (FloatingType a -> r)
formatFloatingType = (FloatingType a -> Builder) -> Format r (FloatingType a -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((FloatingType a -> Builder) -> Format r (FloatingType a -> r))
-> (FloatingType a -> Builder) -> Format r (FloatingType a -> r)
forall a b. (a -> b) -> a -> b
$ \case
  FloatingType a
TypeHalf   -> Builder
"Half"
  FloatingType a
TypeFloat  -> Builder
"Float"
  FloatingType a
TypeDouble -> Builder
"Double"

formatNumType :: Format r (NumType a -> r)
formatNumType :: forall r a. Format r (NumType a -> r)
formatNumType = (NumType a -> Builder) -> Format r (NumType a -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((NumType a -> Builder) -> Format r (NumType a -> r))
-> (NumType a -> Builder) -> Format r (NumType a -> r)
forall a b. (a -> b) -> a -> b
$ \case
  IntegralNumType IntegralType a
ty -> Format Builder (IntegralType a -> Builder)
-> IntegralType a -> Builder
forall a. Format Builder a -> a
bformat Format Builder (IntegralType a -> Builder)
forall r a. Format r (IntegralType a -> r)
formatIntegralType IntegralType a
ty
  FloatingNumType FloatingType a
ty -> Format Builder (FloatingType a -> Builder)
-> FloatingType a -> Builder
forall a. Format Builder a -> a
bformat Format Builder (FloatingType a -> Builder)
forall r a. Format r (FloatingType a -> r)
formatFloatingType FloatingType a
ty

formatBoundedType :: Format r (BoundedType a -> r)
formatBoundedType :: forall r a. Format r (BoundedType a -> r)
formatBoundedType = (BoundedType a -> Builder) -> Format r (BoundedType a -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((BoundedType a -> Builder) -> Format r (BoundedType a -> r))
-> (BoundedType a -> Builder) -> Format r (BoundedType a -> r)
forall a b. (a -> b) -> a -> b
$ \case
  IntegralBoundedType IntegralType a
ty -> Format Builder (IntegralType a -> Builder)
-> IntegralType a -> Builder
forall a. Format Builder a -> a
bformat Format Builder (IntegralType a -> Builder)
forall r a. Format r (IntegralType a -> r)
formatIntegralType IntegralType a
ty

formatSingleType :: Format r (SingleType a -> r)
formatSingleType :: forall r a. Format r (SingleType a -> r)
formatSingleType = (SingleType a -> Builder) -> Format r (SingleType a -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((SingleType a -> Builder) -> Format r (SingleType a -> r))
-> (SingleType a -> Builder) -> Format r (SingleType a -> r)
forall a b. (a -> b) -> a -> b
$ \case
  NumSingleType NumType a
ty -> Format Builder (NumType a -> Builder) -> NumType a -> Builder
forall a. Format Builder a -> a
bformat Format Builder (NumType a -> Builder)
forall r a. Format r (NumType a -> r)
formatNumType NumType a
ty

formatVectorType :: Format r (VectorType a -> r)
formatVectorType :: forall r a. Format r (VectorType a -> r)
formatVectorType = (VectorType a -> Builder) -> Format r (VectorType a -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((VectorType a -> Builder) -> Format r (VectorType a -> r))
-> (VectorType a -> Builder) -> Format r (VectorType a -> r)
forall a b. (a -> b) -> a -> b
$ \case
  VectorType Int
n SingleType a
ty -> Format Builder (Int -> SingleType a -> Builder)
-> Int -> SingleType a -> Builder
forall a. Format Builder a -> a
bformat (Format Builder (Int -> SingleType a -> Builder)
-> Format Builder (Int -> SingleType a -> Builder)
forall r a. Format r a -> Format r a
angled (Format (SingleType a -> Builder) (Int -> SingleType a -> Builder)
forall a r. Integral a => Format r (a -> r)
int Format (SingleType a -> Builder) (Int -> SingleType a -> Builder)
-> Format Builder (SingleType a -> Builder)
-> Format Builder (Int -> SingleType a -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (SingleType a -> Builder) (SingleType a -> Builder)
" x " Format (SingleType a -> Builder) (SingleType a -> Builder)
-> Format Builder (SingleType a -> Builder)
-> Format Builder (SingleType a -> Builder)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Builder (SingleType a -> Builder)
forall r a. Format r (SingleType a -> r)
formatSingleType)) Int
n SingleType a
ty

formatScalarType :: Format r (ScalarType a -> r)
formatScalarType :: forall r a. Format r (ScalarType a -> r)
formatScalarType = (ScalarType a -> Builder) -> Format r (ScalarType a -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
later ((ScalarType a -> Builder) -> Format r (ScalarType a -> r))
-> (ScalarType a -> Builder) -> Format r (ScalarType a -> r)
forall a b. (a -> b) -> a -> b
$ \case
  SingleScalarType SingleType a
ty -> Format Builder (SingleType a -> Builder) -> SingleType a -> Builder
forall a. Format Builder a -> a
bformat Format Builder (SingleType a -> Builder)
forall r a. Format r (SingleType a -> r)
formatSingleType SingleType a
ty
  VectorScalarType VectorType (Vec n a)
ty -> Format Builder (VectorType (Vec n a) -> Builder)
-> VectorType (Vec n a) -> Builder
forall a. Format Builder a -> a
bformat Format Builder (VectorType (Vec n a) -> Builder)
forall r a. Format r (VectorType a -> r)
formatVectorType VectorType (Vec n a)
ty


-- | Querying Integral types
--
class (IsSingle a, IsNum a, IsBounded a) => IsIntegral a where
  integralType :: IntegralType a

-- | Querying Floating types
--
class (Floating a, IsSingle a, IsNum a) => IsFloating a where
  floatingType :: FloatingType a

-- | Querying Numeric types
--
class (Num a, IsSingle a) => IsNum a where
  numType :: NumType a

-- | Querying Bounded types
--
class IsBounded a where
  boundedType :: BoundedType a

-- | Querying single value types
--
class IsScalar a => IsSingle a where
  singleType :: SingleType a

-- | Querying all scalar types
--
class IsScalar a where
  scalarType :: ScalarType a


integralDict :: IntegralType a -> IntegralDict a
integralDict :: forall a. IntegralType a -> IntegralDict a
integralDict IntegralType a
TypeInt    = IntegralDict a
forall a.
(Eq a, Ord a, Show a, Bounded a, Bits a, FiniteBits a, Integral a,
 Num a, Real a, Storable a) =>
IntegralDict a
IntegralDict
integralDict IntegralType a
TypeInt8   = IntegralDict a
forall a.
(Eq a, Ord a, Show a, Bounded a, Bits a, FiniteBits a, Integral a,
 Num a, Real a, Storable a) =>
IntegralDict a
IntegralDict
integralDict IntegralType a
TypeInt16  = IntegralDict a
forall a.
(Eq a, Ord a, Show a, Bounded a, Bits a, FiniteBits a, Integral a,
 Num a, Real a, Storable a) =>
IntegralDict a
IntegralDict
integralDict IntegralType a
TypeInt32  = IntegralDict a
forall a.
(Eq a, Ord a, Show a, Bounded a, Bits a, FiniteBits a, Integral a,
 Num a, Real a, Storable a) =>
IntegralDict a
IntegralDict
integralDict IntegralType a
TypeInt64  = IntegralDict a
forall a.
(Eq a, Ord a, Show a, Bounded a, Bits a, FiniteBits a, Integral a,
 Num a, Real a, Storable a) =>
IntegralDict a
IntegralDict
integralDict IntegralType a
TypeWord   = IntegralDict a
forall a.
(Eq a, Ord a, Show a, Bounded a, Bits a, FiniteBits a, Integral a,
 Num a, Real a, Storable a) =>
IntegralDict a
IntegralDict
integralDict IntegralType a
TypeWord8  = IntegralDict a
forall a.
(Eq a, Ord a, Show a, Bounded a, Bits a, FiniteBits a, Integral a,
 Num a, Real a, Storable a) =>
IntegralDict a
IntegralDict
integralDict IntegralType a
TypeWord16 = IntegralDict a
forall a.
(Eq a, Ord a, Show a, Bounded a, Bits a, FiniteBits a, Integral a,
 Num a, Real a, Storable a) =>
IntegralDict a
IntegralDict
integralDict IntegralType a
TypeWord32 = IntegralDict a
forall a.
(Eq a, Ord a, Show a, Bounded a, Bits a, FiniteBits a, Integral a,
 Num a, Real a, Storable a) =>
IntegralDict a
IntegralDict
integralDict IntegralType a
TypeWord64 = IntegralDict a
forall a.
(Eq a, Ord a, Show a, Bounded a, Bits a, FiniteBits a, Integral a,
 Num a, Real a, Storable a) =>
IntegralDict a
IntegralDict

floatingDict :: FloatingType a -> FloatingDict a
floatingDict :: forall a. FloatingType a -> FloatingDict a
floatingDict FloatingType a
TypeHalf   = FloatingDict a
forall a.
(Eq a, Ord a, Show a, Floating a, Fractional a, Num a, Real a,
 RealFrac a, RealFloat a, Storable a) =>
FloatingDict a
FloatingDict
floatingDict FloatingType a
TypeFloat  = FloatingDict a
forall a.
(Eq a, Ord a, Show a, Floating a, Fractional a, Num a, Real a,
 RealFrac a, RealFloat a, Storable a) =>
FloatingDict a
FloatingDict
floatingDict FloatingType a
TypeDouble = FloatingDict a
forall a.
(Eq a, Ord a, Show a, Floating a, Fractional a, Num a, Real a,
 RealFrac a, RealFloat a, Storable a) =>
FloatingDict a
FloatingDict

singleDict :: SingleType a -> SingleDict a
singleDict :: forall a. SingleType a -> SingleDict a
singleDict = SingleType a -> SingleDict a
forall a. SingleType a -> SingleDict a
single
  where
    single :: SingleType a -> SingleDict a
    single :: forall a. SingleType a -> SingleDict a
single (NumSingleType NumType a
t) = NumType a -> SingleDict a
forall a. NumType a -> SingleDict a
num NumType a
t

    num :: NumType a -> SingleDict a
    num :: forall a. NumType a -> SingleDict a
num (IntegralNumType IntegralType a
t) = IntegralType a -> SingleDict a
forall a. IntegralType a -> SingleDict a
integral IntegralType a
t
    num (FloatingNumType FloatingType a
t) = FloatingType a -> SingleDict a
forall a. FloatingType a -> SingleDict a
floating FloatingType a
t

    integral :: IntegralType a -> SingleDict a
    integral :: forall a. IntegralType a -> SingleDict a
integral IntegralType a
TypeInt    = SingleDict a
forall a. (Eq a, Ord a, Show a, Storable a, Prim a) => SingleDict a
SingleDict
    integral IntegralType a
TypeInt8   = SingleDict a
forall a. (Eq a, Ord a, Show a, Storable a, Prim a) => SingleDict a
SingleDict
    integral IntegralType a
TypeInt16  = SingleDict a
forall a. (Eq a, Ord a, Show a, Storable a, Prim a) => SingleDict a
SingleDict
    integral IntegralType a
TypeInt32  = SingleDict a
forall a. (Eq a, Ord a, Show a, Storable a, Prim a) => SingleDict a
SingleDict
    integral IntegralType a
TypeInt64  = SingleDict a
forall a. (Eq a, Ord a, Show a, Storable a, Prim a) => SingleDict a
SingleDict
    integral IntegralType a
TypeWord   = SingleDict a
forall a. (Eq a, Ord a, Show a, Storable a, Prim a) => SingleDict a
SingleDict
    integral IntegralType a
TypeWord8  = SingleDict a
forall a. (Eq a, Ord a, Show a, Storable a, Prim a) => SingleDict a
SingleDict
    integral IntegralType a
TypeWord16 = SingleDict a
forall a. (Eq a, Ord a, Show a, Storable a, Prim a) => SingleDict a
SingleDict
    integral IntegralType a
TypeWord32 = SingleDict a
forall a. (Eq a, Ord a, Show a, Storable a, Prim a) => SingleDict a
SingleDict
    integral IntegralType a
TypeWord64 = SingleDict a
forall a. (Eq a, Ord a, Show a, Storable a, Prim a) => SingleDict a
SingleDict

    floating :: FloatingType a -> SingleDict a
    floating :: forall a. FloatingType a -> SingleDict a
floating FloatingType a
TypeHalf   = SingleDict a
forall a. (Eq a, Ord a, Show a, Storable a, Prim a) => SingleDict a
SingleDict
    floating FloatingType a
TypeFloat  = SingleDict a
forall a. (Eq a, Ord a, Show a, Storable a, Prim a) => SingleDict a
SingleDict
    floating FloatingType a
TypeDouble = SingleDict a
forall a. (Eq a, Ord a, Show a, Storable a, Prim a) => SingleDict a
SingleDict


scalarTypeInt :: ScalarType Int
scalarTypeInt :: ScalarType Int
scalarTypeInt = SingleType Int -> ScalarType Int
forall a. SingleType a -> ScalarType a
SingleScalarType (SingleType Int -> ScalarType Int)
-> SingleType Int -> ScalarType Int
forall a b. (a -> b) -> a -> b
$ NumType Int -> SingleType Int
forall a. NumType a -> SingleType a
NumSingleType (NumType Int -> SingleType Int) -> NumType Int -> SingleType Int
forall a b. (a -> b) -> a -> b
$ IntegralType Int -> NumType Int
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType Int
TypeInt

scalarTypeWord :: ScalarType Word
scalarTypeWord :: ScalarType Word
scalarTypeWord = SingleType Word -> ScalarType Word
forall a. SingleType a -> ScalarType a
SingleScalarType (SingleType Word -> ScalarType Word)
-> SingleType Word -> ScalarType Word
forall a b. (a -> b) -> a -> b
$ NumType Word -> SingleType Word
forall a. NumType a -> SingleType a
NumSingleType (NumType Word -> SingleType Word)
-> NumType Word -> SingleType Word
forall a b. (a -> b) -> a -> b
$ IntegralType Word -> NumType Word
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType Word
TypeWord

scalarTypeInt32 :: ScalarType Int32
scalarTypeInt32 :: ScalarType Int32
scalarTypeInt32 = SingleType Int32 -> ScalarType Int32
forall a. SingleType a -> ScalarType a
SingleScalarType (SingleType Int32 -> ScalarType Int32)
-> SingleType Int32 -> ScalarType Int32
forall a b. (a -> b) -> a -> b
$ NumType Int32 -> SingleType Int32
forall a. NumType a -> SingleType a
NumSingleType (NumType Int32 -> SingleType Int32)
-> NumType Int32 -> SingleType Int32
forall a b. (a -> b) -> a -> b
$ IntegralType Int32 -> NumType Int32
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType Int32
TypeInt32

scalarTypeWord8 :: ScalarType Word8
scalarTypeWord8 :: ScalarType Word8
scalarTypeWord8 = SingleType Word8 -> ScalarType Word8
forall a. SingleType a -> ScalarType a
SingleScalarType (SingleType Word8 -> ScalarType Word8)
-> SingleType Word8 -> ScalarType Word8
forall a b. (a -> b) -> a -> b
$ NumType Word8 -> SingleType Word8
forall a. NumType a -> SingleType a
NumSingleType (NumType Word8 -> SingleType Word8)
-> NumType Word8 -> SingleType Word8
forall a b. (a -> b) -> a -> b
$ IntegralType Word8 -> NumType Word8
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType Word8
TypeWord8

scalarTypeWord32 :: ScalarType Word32
scalarTypeWord32 :: ScalarType Word32
scalarTypeWord32 = SingleType Word32 -> ScalarType Word32
forall a. SingleType a -> ScalarType a
SingleScalarType (SingleType Word32 -> ScalarType Word32)
-> SingleType Word32 -> ScalarType Word32
forall a b. (a -> b) -> a -> b
$ NumType Word32 -> SingleType Word32
forall a. NumType a -> SingleType a
NumSingleType (NumType Word32 -> SingleType Word32)
-> NumType Word32 -> SingleType Word32
forall a b. (a -> b) -> a -> b
$ IntegralType Word32 -> NumType Word32
forall a. IntegralType a -> NumType a
IntegralNumType IntegralType Word32
TypeWord32

rnfScalarType :: ScalarType t -> ()
rnfScalarType :: forall t. ScalarType t -> ()
rnfScalarType (SingleScalarType SingleType t
t) = SingleType t -> ()
forall t. SingleType t -> ()
rnfSingleType SingleType t
t
rnfScalarType (VectorScalarType VectorType (Vec n a)
t) = VectorType (Vec n a) -> ()
forall t. VectorType t -> ()
rnfVectorType VectorType (Vec n a)
t

rnfSingleType :: SingleType t -> ()
rnfSingleType :: forall t. SingleType t -> ()
rnfSingleType (NumSingleType NumType t
t) = NumType t -> ()
forall t. NumType t -> ()
rnfNumType NumType t
t

rnfVectorType :: VectorType t -> ()
rnfVectorType :: forall t. VectorType t -> ()
rnfVectorType (VectorType !Int
_ SingleType a
t) = SingleType a -> ()
forall t. SingleType t -> ()
rnfSingleType SingleType a
t

rnfBoundedType :: BoundedType t -> ()
rnfBoundedType :: forall t. BoundedType t -> ()
rnfBoundedType (IntegralBoundedType IntegralType t
t) = IntegralType t -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType t
t

rnfNumType :: NumType t -> ()
rnfNumType :: forall t. NumType t -> ()
rnfNumType (IntegralNumType IntegralType t
t) = IntegralType t -> ()
forall t. IntegralType t -> ()
rnfIntegralType IntegralType t
t
rnfNumType (FloatingNumType FloatingType t
t) = FloatingType t -> ()
forall t. FloatingType t -> ()
rnfFloatingType FloatingType t
t

rnfIntegralType :: IntegralType t -> ()
rnfIntegralType :: forall t. IntegralType t -> ()
rnfIntegralType IntegralType t
TypeInt    = ()
rnfIntegralType IntegralType t
TypeInt8   = ()
rnfIntegralType IntegralType t
TypeInt16  = ()
rnfIntegralType IntegralType t
TypeInt32  = ()
rnfIntegralType IntegralType t
TypeInt64  = ()
rnfIntegralType IntegralType t
TypeWord   = ()
rnfIntegralType IntegralType t
TypeWord8  = ()
rnfIntegralType IntegralType t
TypeWord16 = ()
rnfIntegralType IntegralType t
TypeWord32 = ()
rnfIntegralType IntegralType t
TypeWord64 = ()

rnfFloatingType :: FloatingType t -> ()
rnfFloatingType :: forall t. FloatingType t -> ()
rnfFloatingType FloatingType t
TypeHalf   = ()
rnfFloatingType FloatingType t
TypeFloat  = ()
rnfFloatingType FloatingType t
TypeDouble = ()


liftScalar :: ScalarType t -> t -> CodeQ t
liftScalar :: forall t. ScalarType t -> t -> CodeQ t
liftScalar (SingleScalarType SingleType t
t) = SingleType t -> t -> CodeQ t
forall t. SingleType t -> t -> CodeQ t
liftSingle SingleType t
t
liftScalar (VectorScalarType VectorType (Vec n a)
t) = VectorType t -> t -> CodeQ t
forall t. VectorType t -> t -> CodeQ t
liftVector VectorType t
VectorType (Vec n a)
t

liftSingle :: SingleType t -> t -> CodeQ t
liftSingle :: forall t. SingleType t -> t -> CodeQ t
liftSingle (NumSingleType NumType t
t) = NumType t -> t -> CodeQ t
forall t. NumType t -> t -> CodeQ t
liftNum NumType t
t

liftVector :: VectorType t -> t -> CodeQ t
liftVector :: forall t. VectorType t -> t -> CodeQ t
liftVector VectorType{} = t -> Code Q t
Vec n a -> CodeQ (Vec n a)
forall (n :: Nat) a. Vec n a -> CodeQ (Vec n a)
liftVec

liftNum :: NumType t -> t -> CodeQ t
liftNum :: forall t. NumType t -> t -> CodeQ t
liftNum (IntegralNumType IntegralType t
t) = IntegralType t -> t -> CodeQ t
forall t. IntegralType t -> t -> CodeQ t
liftIntegral IntegralType t
t
liftNum (FloatingNumType FloatingType t
t) = FloatingType t -> t -> CodeQ t
forall t. FloatingType t -> t -> CodeQ t
liftFloating FloatingType t
t

liftIntegral :: IntegralType t -> t -> CodeQ t
liftIntegral :: forall t. IntegralType t -> t -> CodeQ t
liftIntegral IntegralType t
TypeInt    t
x = [|| t
x ||]
liftIntegral IntegralType t
TypeInt8   t
x = [|| t
x ||]
liftIntegral IntegralType t
TypeInt16  t
x = [|| t
x ||]
liftIntegral IntegralType t
TypeInt32  t
x = [|| t
x ||]
liftIntegral IntegralType t
TypeInt64  t
x = [|| t
x ||]
liftIntegral IntegralType t
TypeWord   t
x = [|| t
x ||]
liftIntegral IntegralType t
TypeWord8  t
x = [|| t
x ||]
liftIntegral IntegralType t
TypeWord16 t
x = [|| t
x ||]
liftIntegral IntegralType t
TypeWord32 t
x = [|| t
x ||]
liftIntegral IntegralType t
TypeWord64 t
x = [|| t
x ||]

liftFloating :: FloatingType t -> t -> CodeQ t
liftFloating :: forall t. FloatingType t -> t -> CodeQ t
liftFloating FloatingType t
TypeHalf   t
x = [|| t
x ||]
liftFloating FloatingType t
TypeFloat  t
x = [|| t
x ||]
liftFloating FloatingType t
TypeDouble t
x = [|| t
x ||]


liftScalarType :: ScalarType t -> CodeQ (ScalarType t)
liftScalarType :: forall t. ScalarType t -> CodeQ (ScalarType t)
liftScalarType (SingleScalarType SingleType t
t) = [|| SingleType a -> ScalarType a
forall a. SingleType a -> ScalarType a
SingleScalarType $$(SingleType t -> CodeQ (SingleType t)
forall t. SingleType t -> CodeQ (SingleType t)
liftSingleType SingleType t
t) ||]
liftScalarType (VectorScalarType VectorType (Vec n a)
t) = [|| VectorType (Vec n a) -> ScalarType (Vec n a)
forall (n :: Nat) a. VectorType (Vec n a) -> ScalarType (Vec n a)
VectorScalarType $$(VectorType (Vec n a) -> CodeQ (VectorType (Vec n a))
forall t. VectorType t -> CodeQ (VectorType t)
liftVectorType VectorType (Vec n a)
t) ||]

liftSingleType :: SingleType t -> CodeQ (SingleType t)
liftSingleType :: forall t. SingleType t -> CodeQ (SingleType t)
liftSingleType (NumSingleType NumType t
t) = [|| NumType a -> SingleType a
forall a. NumType a -> SingleType a
NumSingleType $$(NumType t -> CodeQ (NumType t)
forall t. NumType t -> CodeQ (NumType t)
liftNumType NumType t
t) ||]

liftVectorType :: VectorType t -> CodeQ (VectorType t)
liftVectorType :: forall t. VectorType t -> CodeQ (VectorType t)
liftVectorType (VectorType Int
n SingleType a
t) = [|| Int -> SingleType a -> VectorType (Vec n a)
forall (n :: Nat) a.
KnownNat n =>
Int -> SingleType a -> VectorType (Vec n a)
VectorType Int
n $$(SingleType a -> CodeQ (SingleType a)
forall t. SingleType t -> CodeQ (SingleType t)
liftSingleType SingleType a
t) ||]

liftNumType :: NumType t -> CodeQ (NumType t)
liftNumType :: forall t. NumType t -> CodeQ (NumType t)
liftNumType (IntegralNumType IntegralType t
t) = [|| IntegralType a -> NumType a
forall a. IntegralType a -> NumType a
IntegralNumType $$(IntegralType t -> CodeQ (IntegralType t)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType t
t) ||]
liftNumType (FloatingNumType FloatingType t
t) = [|| FloatingType a -> NumType a
forall a. FloatingType a -> NumType a
FloatingNumType $$(FloatingType t -> CodeQ (FloatingType t)
forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType t
t) ||]

liftBoundedType :: BoundedType t -> CodeQ (BoundedType t)
liftBoundedType :: forall t. BoundedType t -> CodeQ (BoundedType t)
liftBoundedType (IntegralBoundedType IntegralType t
t) = [|| IntegralType a -> BoundedType a
forall a. IntegralType a -> BoundedType a
IntegralBoundedType $$(IntegralType t -> CodeQ (IntegralType t)
forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType t
t) ||]

liftIntegralType :: IntegralType t -> CodeQ (IntegralType t)
liftIntegralType :: forall t. IntegralType t -> CodeQ (IntegralType t)
liftIntegralType IntegralType t
TypeInt    = [|| IntegralType Int
TypeInt ||]
liftIntegralType IntegralType t
TypeInt8   = [|| IntegralType Int8
TypeInt8 ||]
liftIntegralType IntegralType t
TypeInt16  = [|| IntegralType Int16
TypeInt16 ||]
liftIntegralType IntegralType t
TypeInt32  = [|| IntegralType Int32
TypeInt32 ||]
liftIntegralType IntegralType t
TypeInt64  = [|| IntegralType Int64
TypeInt64 ||]
liftIntegralType IntegralType t
TypeWord   = [|| IntegralType Word
TypeWord ||]
liftIntegralType IntegralType t
TypeWord8  = [|| IntegralType Word8
TypeWord8 ||]
liftIntegralType IntegralType t
TypeWord16 = [|| IntegralType Word16
TypeWord16 ||]
liftIntegralType IntegralType t
TypeWord32 = [|| IntegralType Word32
TypeWord32 ||]
liftIntegralType IntegralType t
TypeWord64 = [|| IntegralType Word64
TypeWord64 ||]

liftFloatingType :: FloatingType t -> CodeQ (FloatingType t)
liftFloatingType :: forall t. FloatingType t -> CodeQ (FloatingType t)
liftFloatingType FloatingType t
TypeHalf   = [|| FloatingType Half
TypeHalf ||]
liftFloatingType FloatingType t
TypeFloat  = [|| FloatingType Float
TypeFloat ||]
liftFloatingType FloatingType t
TypeDouble = [|| FloatingType Double
TypeDouble ||]


-- Type-level bit sizes
-- --------------------

-- | Constraint that values of these two types have the same bit width
--
type BitSizeEq a b = (BitSize a == BitSize b) ~ 'True
type family BitSize a :: Nat


-- Instances
-- ---------
--
-- Generate instances for the IsX classes. It would be preferable to do this
-- automatically based on the members of the IntegralType (etc.) representations
-- (see for example FromIntegral.hs) but TH phase restrictions would require us
-- to split this into a separate module.
--

runQ $ do
  let
      bits :: FiniteBits b => b -> Integer
      bits = toInteger . finiteBitSize

      integralTypes :: [(Name, Integer)]
      integralTypes =
        [ (''Int,    bits (undefined::Int))
        , (''Int8,   8)
        , (''Int16,  16)
        , (''Int32,  32)
        , (''Int64,  64)
        , (''Word,   bits (undefined::Word))
        , (''Word8,  8)
        , (''Word16, 16)
        , (''Word32, 32)
        , (''Word64, 64)
        ]

      floatingTypes :: [(Name, Integer)]
      floatingTypes =
        [ (''Half,   16)
        , (''Float,  32)
        , (''Double, 64)
        ]

      vectorTypes :: [(Name, Integer)]
      vectorTypes = integralTypes ++ floatingTypes

      mkIntegral :: Name -> Integer -> Q [Dec]
      mkIntegral t n =
        [d| instance IsIntegral $(conT t) where
              integralType = $(conE (mkName ("Type" ++ nameBase t)))

            instance IsNum $(conT t) where
              numType = IntegralNumType integralType

            instance IsBounded $(conT t) where
              boundedType = IntegralBoundedType integralType

            instance IsSingle $(conT t) where
              singleType = NumSingleType numType

            instance IsScalar $(conT t) where
              scalarType = SingleScalarType singleType

            type instance BitSize $(conT t) = $(litT (numTyLit n))
          |]

      mkFloating :: Name -> Integer -> Q [Dec]
      mkFloating t n =
        [d| instance IsFloating $(conT t) where
              floatingType = $(conE (mkName ("Type" ++ nameBase t)))

            instance IsNum $(conT t) where
              numType = FloatingNumType floatingType

            instance IsSingle $(conT t) where
              singleType = NumSingleType numType

            instance IsScalar $(conT t) where
              scalarType = SingleScalarType singleType

            type instance BitSize $(conT t) = $(litT (numTyLit n))
          |]

      mkVector :: Name -> Integer -> Q [Dec]
      mkVector t n =
        [d| instance KnownNat n => IsScalar (Vec n $(conT t)) where
              scalarType = VectorScalarType (VectorType (fromIntegral (natVal' (proxy# :: Proxy# n))) singleType)

            type instance BitSize (Vec w $(conT t)) = w GHC.TypeLits.* $(litT (numTyLit n))
          |]
      --
  is <- mapM (uncurry mkIntegral) integralTypes
  fs <- mapM (uncurry mkFloating) floatingTypes
  vs <- mapM (uncurry mkVector)   vectorTypes
  --
  return (concat is ++ concat fs ++ concat vs)