{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE GADTs               #-}
{-# 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 Language.Haskell.TH
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

-- | 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 :: 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 :: 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 :: SingleType a -> SingleDict a
singleDict = SingleType a -> SingleDict a
forall a. SingleType a -> SingleDict a
single
  where
    single :: SingleType a -> SingleDict a
    single :: 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 :: 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 :: 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 :: 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 :: 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 :: SingleType t -> ()
rnfSingleType (NumSingleType NumType t
t) = NumType t -> ()
forall t. NumType t -> ()
rnfNumType NumType t
t

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

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

rnfNumType :: NumType t -> ()
rnfNumType :: 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 :: 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 :: FloatingType t -> ()
rnfFloatingType FloatingType t
TypeHalf   = ()
rnfFloatingType FloatingType t
TypeFloat  = ()
rnfFloatingType FloatingType t
TypeDouble = ()


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

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

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

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

liftIntegral :: IntegralType t -> t -> Q (TExp t)
liftIntegral :: IntegralType t -> t -> Q (TExp t)
liftIntegral IntegralType t
TypeInt    t
x = [|| x ||]
liftIntegral IntegralType t
TypeInt8   t
x = [|| x ||]
liftIntegral IntegralType t
TypeInt16  t
x = [|| x ||]
liftIntegral IntegralType t
TypeInt32  t
x = [|| x ||]
liftIntegral IntegralType t
TypeInt64  t
x = [|| x ||]
liftIntegral IntegralType t
TypeWord   t
x = [|| x ||]
liftIntegral IntegralType t
TypeWord8  t
x = [|| x ||]
liftIntegral IntegralType t
TypeWord16 t
x = [|| x ||]
liftIntegral IntegralType t
TypeWord32 t
x = [|| x ||]
liftIntegral IntegralType t
TypeWord64 t
x = [|| x ||]

liftFloating :: FloatingType t -> t -> Q (TExp t)
liftFloating :: FloatingType t -> t -> Q (TExp t)
liftFloating FloatingType t
TypeHalf   t
x = [|| x ||]
liftFloating FloatingType t
TypeFloat  t
x = [|| x ||]
liftFloating FloatingType t
TypeDouble t
x = [|| x ||]


liftScalarType :: ScalarType t -> Q (TExp (ScalarType t))
liftScalarType :: ScalarType t -> Q (TExp (ScalarType t))
liftScalarType (SingleScalarType SingleType t
t) = [|| SingleScalarType $$(liftSingleType t) ||]
liftScalarType (VectorScalarType VectorType (Vec n a)
t) = [|| VectorScalarType $$(liftVectorType t) ||]

liftSingleType :: SingleType t -> Q (TExp (SingleType t))
liftSingleType :: SingleType t -> Q (TExp (SingleType t))
liftSingleType (NumSingleType NumType t
t) = [|| NumSingleType $$(liftNumType t) ||]

liftVectorType :: VectorType t -> Q (TExp (VectorType t))
liftVectorType :: VectorType t -> Q (TExp (VectorType t))
liftVectorType (VectorType Int
n SingleType a
t) = [|| VectorType n $$(liftSingleType t) ||]

liftNumType :: NumType t -> Q (TExp (NumType t))
liftNumType :: NumType t -> Q (TExp (NumType t))
liftNumType (IntegralNumType IntegralType t
t) = [|| IntegralNumType $$(liftIntegralType t) ||]
liftNumType (FloatingNumType FloatingType t
t) = [|| FloatingNumType $$(liftFloatingType t) ||]

liftBoundedType :: BoundedType t -> Q (TExp (BoundedType t))
liftBoundedType :: BoundedType t -> Q (TExp (BoundedType t))
liftBoundedType (IntegralBoundedType IntegralType t
t) = [|| IntegralBoundedType $$(liftIntegralType t) ||]

liftIntegralType :: IntegralType t -> Q (TExp (IntegralType t))
liftIntegralType :: IntegralType t -> Q (TExp (IntegralType t))
liftIntegralType IntegralType t
TypeInt    = [|| TypeInt ||]
liftIntegralType IntegralType t
TypeInt8   = [|| TypeInt8 ||]
liftIntegralType IntegralType t
TypeInt16  = [|| TypeInt16 ||]
liftIntegralType IntegralType t
TypeInt32  = [|| TypeInt32 ||]
liftIntegralType IntegralType t
TypeInt64  = [|| TypeInt64 ||]
liftIntegralType IntegralType t
TypeWord   = [|| TypeWord ||]
liftIntegralType IntegralType t
TypeWord8  = [|| TypeWord8 ||]
liftIntegralType IntegralType t
TypeWord16 = [|| TypeWord16 ||]
liftIntegralType IntegralType t
TypeWord32 = [|| TypeWord32 ||]
liftIntegralType IntegralType t
TypeWord64 = [|| TypeWord64 ||]

liftFloatingType :: FloatingType t -> Q (TExp (FloatingType t))
liftFloatingType :: FloatingType t -> Q (TExp (FloatingType t))
liftFloatingType FloatingType t
TypeHalf   = [|| TypeHalf ||]
liftFloatingType FloatingType t
TypeFloat  = [|| TypeFloat ||]
liftFloatingType FloatingType t
TypeDouble = [|| 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)
 )