{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : LLVM.AST.Type.Downcast
-- Copyright   : [2015..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module LLVM.AST.Type.Downcast (

  Downcast(..),

) where

import Data.Array.Accelerate.Type
import qualified LLVM.AST.Type                                      as LLVM

import Data.Bits

import GHC.Stack


-- | Convert a value from our representation of the LLVM AST which uses
-- Haskell-level types, into the llvm-hs representation where types are
-- represented only at the value level.
--
-- The type-level information to generate the appropriate value-level types.
--
class Downcast typed untyped where
  downcast :: HasCallStack => typed -> untyped

instance Downcast a a' => Downcast [a] [a'] where
  downcast :: [a] -> [a']
downcast = (a -> a') -> [a] -> [a']
forall a b. (a -> b) -> [a] -> [b]
map a -> a'
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast

instance Downcast a a' => Downcast (Maybe a) (Maybe a') where
  downcast :: Maybe a -> Maybe a'
downcast Maybe a
Nothing  = Maybe a'
forall a. Maybe a
Nothing
  downcast (Just a
x) = a' -> Maybe a'
forall a. a -> Maybe a
Just (a -> a'
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast a
x)

instance (Downcast a a', Downcast b b') => Downcast (a,b) (a',b') where
  downcast :: (a, b) -> (a', b')
downcast (a
a,b
b) = (a -> a'
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast a
a, b -> b'
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast b
b)

instance (Downcast a a', Downcast b b') =>  Downcast (Either a b) (Either a' b') where
  downcast :: Either a b -> Either a' b'
downcast (Left a
a)  = a' -> Either a' b'
forall a b. a -> Either a b
Left (a -> a'
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast a
a)
  downcast (Right b
b) = b' -> Either a' b'
forall a b. b -> Either a b
Right (b -> b'
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast b
b)


instance Downcast (ScalarType a) LLVM.Type where
  downcast :: ScalarType a -> Type
downcast (SingleScalarType SingleType a
t) = SingleType a -> Type
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast SingleType a
t
  downcast (VectorScalarType VectorType (Vec n a1)
t) = VectorType (Vec n a1) -> Type
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast VectorType (Vec n a1)
t

instance Downcast (SingleType a) LLVM.Type where
  downcast :: SingleType a -> Type
downcast (NumSingleType NumType a
t) = NumType a -> Type
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast NumType a
t

instance Downcast (VectorType a) LLVM.Type where
  downcast :: VectorType a -> Type
downcast (VectorType Int
n SingleType a1
t) = Word32 -> Type -> Type
LLVM.VectorType (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (SingleType a1 -> Type
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast SingleType a1
t)

instance Downcast (BoundedType t) LLVM.Type where
  downcast :: BoundedType t -> Type
downcast (IntegralBoundedType IntegralType t
t) = IntegralType t -> Type
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast IntegralType t
t

instance Downcast (NumType a) LLVM.Type where
  downcast :: NumType a -> Type
downcast (IntegralNumType IntegralType a
t) = IntegralType a -> Type
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast IntegralType a
t
  downcast (FloatingNumType FloatingType a
t) = FloatingType a -> Type
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast FloatingType a
t

instance Downcast (IntegralType a) LLVM.Type where
  downcast :: IntegralType a -> Type
downcast IntegralType a
TypeInt     = Word32 -> Type
LLVM.IntegerType $( [| fromIntegral (finiteBitSize (undefined :: Int)) |] )
  downcast IntegralType a
TypeInt8    = Word32 -> Type
LLVM.IntegerType Word32
8
  downcast IntegralType a
TypeInt16   = Word32 -> Type
LLVM.IntegerType Word32
16
  downcast IntegralType a
TypeInt32   = Word32 -> Type
LLVM.IntegerType Word32
32
  downcast IntegralType a
TypeInt64   = Word32 -> Type
LLVM.IntegerType Word32
64
  downcast IntegralType a
TypeWord    = Word32 -> Type
LLVM.IntegerType $( [| fromIntegral (finiteBitSize (undefined :: Word)) |] )
  downcast IntegralType a
TypeWord8   = Word32 -> Type
LLVM.IntegerType Word32
8
  downcast IntegralType a
TypeWord16  = Word32 -> Type
LLVM.IntegerType Word32
16
  downcast IntegralType a
TypeWord32  = Word32 -> Type
LLVM.IntegerType Word32
32
  downcast IntegralType a
TypeWord64  = Word32 -> Type
LLVM.IntegerType Word32
64

instance Downcast (FloatingType a) LLVM.Type where
  downcast :: FloatingType a -> Type
downcast FloatingType a
TypeHalf    = FloatingPointType -> Type
LLVM.FloatingPointType FloatingPointType
LLVM.HalfFP
  downcast FloatingType a
TypeFloat   = FloatingPointType -> Type
LLVM.FloatingPointType FloatingPointType
LLVM.FloatFP
  downcast FloatingType a
TypeDouble  = FloatingPointType -> Type
LLVM.FloatingPointType FloatingPointType
LLVM.DoubleFP