{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators         #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : LLVM.AST.Type.Function
-- 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.Function
  where

import LLVM.AST.Type.Downcast
import LLVM.AST.Type.Name
import LLVM.AST.Type.Operand
import LLVM.AST.Type.Representation

import qualified LLVM.AST.Attribute                                 as LLVM
import qualified LLVM.AST.Global                                    as LLVM
import qualified LLVM.AST.Instruction                               as LLVM


-- | Attributes for the function call instruction
--
data FunctionAttribute
  = NoReturn
  | NoUnwind
  | ReadOnly
  | ReadNone
  | AlwaysInline
  | NoDuplicate
  | Convergent

-- | Tail call kind for function call instruction
--
data TailCall
  = Tail
  | NoTail
  | MustTail

-- | Parameters for functions
--
data Parameter a where
  Parameter :: PrimType a -> Name a -> Parameter a

-- | Attribute groups are groups of attributes that are referenced by
-- objects within the IR. To use an attribute group, an object must
-- reference its GroupID.
--
data GroupID = GroupID !Word


-- | Functions are arguments to the 'call' instruction; either global
-- functions or inline assembly.
--
data Function kind args t where
  Body :: Type r -> Maybe TailCall -> kind                -> Function kind '[]         r
  Lam  :: PrimType a -> Operand a -> Function kind args t -> Function kind (a ': args) t

data HList (l :: [*]) where
  HNil  ::                 HList '[]
  HCons :: e -> HList l -> HList (e ': l)


instance Downcast FunctionAttribute LLVM.FunctionAttribute where
  downcast :: FunctionAttribute -> FunctionAttribute
downcast FunctionAttribute
NoReturn     = FunctionAttribute
LLVM.NoReturn
  downcast FunctionAttribute
NoUnwind     = FunctionAttribute
LLVM.NoUnwind
  downcast FunctionAttribute
ReadOnly     = FunctionAttribute
LLVM.ReadOnly
  downcast FunctionAttribute
ReadNone     = FunctionAttribute
LLVM.ReadNone
  downcast FunctionAttribute
AlwaysInline = FunctionAttribute
LLVM.AlwaysInline
  downcast FunctionAttribute
NoDuplicate  = FunctionAttribute
LLVM.NoDuplicate
  downcast FunctionAttribute
Convergent   = FunctionAttribute
LLVM.Convergent

instance Downcast (Parameter a) LLVM.Parameter where
  downcast :: Parameter a -> Parameter
downcast (Parameter PrimType a
t Name a
n) = Type -> Name -> [ParameterAttribute] -> Parameter
LLVM.Parameter (PrimType a -> Type
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast PrimType a
t) (Name a -> Name
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast Name a
n) [ParameterAttribute]
attrs
    where
      attrs :: [ParameterAttribute]
attrs | PtrPrimType{} <- PrimType a
t = [ParameterAttribute
LLVM.NoAlias, ParameterAttribute
LLVM.NoCapture] -- XXX: alignment
            | Bool
otherwise          = []

instance Downcast TailCall LLVM.TailCallKind where
  downcast :: TailCall -> TailCallKind
downcast TailCall
Tail     = TailCallKind
LLVM.Tail
  downcast TailCall
NoTail   = TailCallKind
LLVM.NoTail
  downcast TailCall
MustTail = TailCallKind
LLVM.MustTail

instance Downcast GroupID LLVM.GroupID where
  downcast :: GroupID -> GroupID
downcast (GroupID Word
n) = Word -> GroupID
LLVM.GroupID Word
n