{-# LANGUAGE GADTs #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : Data.Array.Accelerate.LLVM.CodeGen.Ptr
-- Copyright   : [2016..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.LLVM.CodeGen.Ptr
  where

import LLVM.AST.Type.AddrSpace
import LLVM.AST.Type.Constant
import LLVM.AST.Type.Name
import LLVM.AST.Type.Operand
import LLVM.AST.Type.Representation

import Data.Array.Accelerate.Error


-- Treat an operand as a Ptr type. This is a hack because we can't unpack IR
-- terms of pointer type.
--
asPtr :: HasCallStack => AddrSpace -> Operand t -> Operand (Ptr t)
asPtr :: AddrSpace -> Operand t -> Operand (Ptr t)
asPtr AddrSpace
as Operand t
x =
  let
      retype :: Type a -> Type (Ptr a)
      retype :: Type a -> Type (Ptr a)
retype Type a
VoidType     = String -> Type (Ptr a)
forall a. HasCallStack => String -> a
internalError String
"unexpected void type"
      retype (PrimType PrimType a
t) = PrimType (Ptr a) -> Type (Ptr a)
forall a. PrimType a -> Type a
PrimType (PrimType a -> AddrSpace -> PrimType (Ptr a)
forall a. PrimType a -> AddrSpace -> PrimType (Ptr a)
PtrPrimType PrimType a
t AddrSpace
as)
      --
      rename :: Name a -> Name (Ptr a)
      rename :: Name a -> Name (Ptr a)
rename (Name ShortByteString
n)   = ShortByteString -> Name (Ptr a)
forall a. ShortByteString -> Name a
Name ShortByteString
n
      rename (UnName Word
n) = Word -> Name (Ptr a)
forall a. Word -> Name a
UnName Word
n
  in
  case Operand t
x of
    LocalReference Type t
t Name t
n                    -> Type (Ptr t) -> Name (Ptr t) -> Operand (Ptr t)
forall a. Type a -> Name a -> Operand a
LocalReference (Type t -> Type (Ptr t)
forall a. Type a -> Type (Ptr a)
retype Type t
t) (Name t -> Name (Ptr t)
forall a. Name a -> Name (Ptr a)
rename Name t
n)
    ConstantOperand (GlobalReference Type t
t Name t
n) -> Constant (Ptr t) -> Operand (Ptr t)
forall a. Constant a -> Operand a
ConstantOperand (Type (Ptr t) -> Name (Ptr t) -> Constant (Ptr t)
forall a. Type a -> Name a -> Constant a
GlobalReference (Type t -> Type (Ptr t)
forall a. Type a -> Type (Ptr a)
retype Type t
t) (Name t -> Name (Ptr t)
forall a. Name a -> Name (Ptr a)
rename Name t
n))
    ConstantOperand (UndefConstant Type t
t)     -> Constant (Ptr t) -> Operand (Ptr t)
forall a. Constant a -> Operand a
ConstantOperand (Type (Ptr t) -> Constant (Ptr t)
forall a. Type a -> Constant a
UndefConstant (Type t -> Type (Ptr t)
forall a. Type a -> Type (Ptr a)
retype Type t
t))
    ConstantOperand Constant t
_                     -> String -> Operand (Ptr t)
forall a. HasCallStack => String -> a
internalError String
"unexpected constant operand"

-- Treat a pointer operand as a scalar. This is a hack because we can't unpack
-- IR terms of pointer types.
--
unPtr :: HasCallStack => Operand (Ptr t) -> Operand t
unPtr :: Operand (Ptr t) -> Operand t
unPtr Operand (Ptr t)
x =
  let
      retype :: Type (Ptr a) -> Type a
      retype :: Type (Ptr a) -> Type a
retype (PrimType (PtrPrimType PrimType a
t AddrSpace
_)) = PrimType a -> Type a
forall a. PrimType a -> Type a
PrimType PrimType a
t
      retype Type (Ptr a)
_                            = String -> Type a
forall a. HasCallStack => String -> a
internalError String
"expected pointer type"
      --
      rename :: Name (Ptr a) -> Name a
      rename :: Name (Ptr a) -> Name a
rename (Name ShortByteString
n)   = ShortByteString -> Name a
forall a. ShortByteString -> Name a
Name ShortByteString
n
      rename (UnName Word
n) = Word -> Name a
forall a. Word -> Name a
UnName Word
n
  in
  case Operand (Ptr t)
x of
    LocalReference Type (Ptr t)
t Name (Ptr t)
n                    -> Type t -> Name t -> Operand t
forall a. Type a -> Name a -> Operand a
LocalReference (Type (Ptr t) -> Type t
forall a. Type (Ptr a) -> Type a
retype Type (Ptr t)
t) (Name (Ptr t) -> Name t
forall a. Name (Ptr a) -> Name a
rename Name (Ptr t)
n)
    ConstantOperand (GlobalReference Type (Ptr t)
t Name (Ptr t)
n) -> Constant t -> Operand t
forall a. Constant a -> Operand a
ConstantOperand (Type t -> Name t -> Constant t
forall a. Type a -> Name a -> Constant a
GlobalReference (Type (Ptr t) -> Type t
forall a. Type (Ptr a) -> Type a
retype Type (Ptr t)
t) (Name (Ptr t) -> Name t
forall a. Name (Ptr a) -> Name a
rename Name (Ptr t)
n))
    ConstantOperand (UndefConstant Type (Ptr t)
t)     -> Constant t -> Operand t
forall a. Constant a -> Operand a
ConstantOperand (Type t -> Constant t
forall a. Type a -> Constant a
UndefConstant (Type (Ptr t) -> Type t
forall a. Type (Ptr a) -> Type a
retype Type (Ptr t)
t))
    ConstantOperand ScalarConstant{}      -> String -> Operand t
forall a. HasCallStack => String -> a
internalError String
"unexpected scalar constant"