{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : LLVM.AST.Type.Instruction.RMW
-- Copyright   : [2016..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.Instruction.RMW
  where

import Data.Array.Accelerate.Error

import LLVM.AST.Type.Downcast
import LLVM.AST.Type.Representation

import qualified LLVM.AST.RMWOperation                              as LLVM


-- | Operations for the 'AtomicRMW' instruction.
--
-- <http://llvm.org/docs/LangRef.html#atomicrmw-instruction>
--
data RMWOperation
    = Exchange
    | Add
    | Sub
    | And
    | Nand
    | Or
    | Xor
    | Min
    | Max


-- | Convert to llvm-hs
--
instance Downcast (NumType a, RMWOperation) LLVM.RMWOperation where
  downcast :: (NumType a, RMWOperation) -> RMWOperation
downcast (IntegralNumType IntegralType a
t, RMWOperation
rmw) = (IntegralType a, RMWOperation) -> RMWOperation
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast (IntegralType a
t,RMWOperation
rmw)
  downcast (FloatingNumType FloatingType a
t, RMWOperation
rmw) = (FloatingType a, RMWOperation) -> RMWOperation
forall typed untyped.
(Downcast typed untyped, HasCallStack) =>
typed -> untyped
downcast (FloatingType a
t,RMWOperation
rmw)

instance Downcast (IntegralType a, RMWOperation) LLVM.RMWOperation where
  downcast :: (IntegralType a, RMWOperation) -> RMWOperation
downcast (IntegralType a
t, RMWOperation
rmw) =
    case RMWOperation
rmw of
      RMWOperation
Exchange        -> RMWOperation
LLVM.Xchg
      RMWOperation
Add             -> RMWOperation
LLVM.Add
      RMWOperation
Sub             -> RMWOperation
LLVM.Sub
      RMWOperation
And             -> RMWOperation
LLVM.And
      RMWOperation
Or              -> RMWOperation
LLVM.Or
      RMWOperation
Xor             -> RMWOperation
LLVM.Xor
      RMWOperation
Nand            -> RMWOperation
LLVM.Nand
      RMWOperation
Min | IntegralType a -> Bool
forall (dict :: * -> *) a. IsSigned dict => dict a -> Bool
signed IntegralType a
t  -> RMWOperation
LLVM.Min
          | Bool
otherwise -> RMWOperation
LLVM.UMin
      RMWOperation
Max | IntegralType a -> Bool
forall (dict :: * -> *) a. IsSigned dict => dict a -> Bool
signed IntegralType a
t  -> RMWOperation
LLVM.Max
          | Bool
otherwise -> RMWOperation
LLVM.UMax

instance Downcast (FloatingType a, RMWOperation) LLVM.RMWOperation where
  downcast :: (FloatingType a, RMWOperation) -> RMWOperation
downcast (FloatingType a
_, RMWOperation
rmw) =
    case RMWOperation
rmw of
      RMWOperation
Exchange        -> RMWOperation
LLVM.Xchg
#if MIN_VERSION_llvm_hs_pure(10,0,0)
      Add             -> LLVM.FAdd
      Sub             -> LLVM.FSub
#endif
      RMWOperation
_               -> String -> RMWOperation
forall a. HasCallStack => String -> a
internalError String
"unsupported operand type to RMWOperation"