{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : LLVM.AST.Type.Metadata
-- 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.Metadata
  where

import LLVM.AST.Type.Downcast

import qualified LLVM.AST.Constant                        as LLVM
import qualified LLVM.AST.Operand                         as LLVM

import Data.ByteString.Short                              ( ShortByteString )


-- | Metadata does not have a type, and is not a value.
--
-- <http://llvm.org/docs/LangRef.html#metadata>
--
data MetadataNode
  = MetadataNode ![Maybe Metadata]
  | MetadataNodeReference {-# UNPACK #-} !LLVM.MetadataNodeID

data Metadata
  = MetadataStringOperand {-# UNPACK #-} !ShortByteString
  | MetadataConstantOperand !LLVM.Constant
  | MetadataNodeOperand !MetadataNode


-- | Convert to llvm-hs
--
instance Downcast Metadata LLVM.Metadata where
  downcast :: Metadata -> Metadata
downcast (MetadataStringOperand ShortByteString
s)   = ShortByteString -> Metadata
LLVM.MDString ShortByteString
s
  downcast (MetadataConstantOperand Constant
o) = Operand -> Metadata
LLVM.MDValue (Constant -> Operand
LLVM.ConstantOperand Constant
o)
  downcast (MetadataNodeOperand MetadataNode
n)     = MDRef MDNode -> Metadata
LLVM.MDNode (MetadataNode -> MDRef MDNode
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast MetadataNode
n)

#if MIN_VERSION_llvm_hs_pure(6,1,0)
instance Downcast MetadataNode (LLVM.MDRef LLVM.MDNode) where
  downcast :: MetadataNode -> MDRef MDNode
downcast (MetadataNode [Maybe Metadata]
n)            = MDNode -> MDRef MDNode
forall a. a -> MDRef a
LLVM.MDInline ([Maybe Metadata] -> MDNode
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast [Maybe Metadata]
n)
  downcast (MetadataNodeReference MetadataNodeID
r)   = MetadataNodeID -> MDRef MDNode
forall a. MetadataNodeID -> MDRef a
LLVM.MDRef MetadataNodeID
r

instance Downcast [Maybe Metadata] LLVM.MDNode where
  downcast :: [Maybe Metadata] -> MDNode
downcast = [Maybe Metadata] -> MDNode
LLVM.MDTuple ([Maybe Metadata] -> MDNode)
-> ([Maybe Metadata] -> [Maybe Metadata])
-> [Maybe Metadata]
-> MDNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Metadata -> Maybe Metadata)
-> [Maybe Metadata] -> [Maybe Metadata]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Metadata -> Maybe Metadata
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast
#else
instance Downcast MetadataNode LLVM.MetadataNode where
  downcast (MetadataNode n)            = LLVM.MetadataNode (downcast n)
  downcast (MetadataNodeReference r)   = LLVM.MetadataNodeReference r
#endif