{-# LANGUAGE
  TemplateHaskell,
  MultiParamTypeClasses,
  OverloadedStrings
  #-}
module LLVM.Internal.Global where

import LLVM.Prelude

import Control.Monad.State
import Control.Monad.AnyCont
import Foreign.Ptr
import qualified Data.Map as Map

import qualified LLVM.Internal.FFI.PtrHierarchy as FFI
import qualified LLVM.Internal.FFI.LLVMCTypes as FFI
import qualified LLVM.Internal.FFI.GlobalValue as FFI

import LLVM.Internal.Coding
import LLVM.Internal.DecodeAST
import LLVM.Internal.EncodeAST

import qualified LLVM.AST.Linkage as A.L
import qualified LLVM.AST.Visibility as A.V
import qualified LLVM.AST.COMDAT as A.COMDAT
import qualified LLVM.AST.DLL as A.DLL
import qualified LLVM.AST.ThreadLocalStorage as A.TLS
import qualified LLVM.AST.Global as A.G

genCodingInstance [t| A.L.Linkage |] ''FFI.Linkage [
  (FFI.linkageExternal, A.L.External),
  (FFI.linkageAvailableExternally, A.L.AvailableExternally),
  (FFI.linkageLinkOnceAny, A.L.LinkOnce),
  (FFI.linkageLinkOnceODR, A.L.LinkOnceODR),
  (FFI.linkageWeakAny, A.L.Weak),
  (FFI.linkageWeakODR, A.L.WeakODR),
  (FFI.linkageAppending, A.L.Appending),
  (FFI.linkageInternal, A.L.Internal),
  (FFI.linkagePrivate, A.L.Private),
  (FFI.linkageExternalWeak, A.L.ExternWeak),
  (FFI.linkageCommon, A.L.Common)
 ]

getLinkage :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST A.L.Linkage
getLinkage g = liftIO $ decodeM =<< FFI.getLinkage (FFI.upCast g)

setLinkage :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> A.L.Linkage -> EncodeAST ()
setLinkage g l = liftIO . FFI.setLinkage (FFI.upCast g) =<< encodeM l
                                                                       
genCodingInstance [t| A.V.Visibility |] ''FFI.Visibility [
  (FFI.visibilityDefault, A.V.Default),
  (FFI.visibilityHidden, A.V.Hidden),
  (FFI.visibilityProtected, A.V.Protected)
 ]

getVisibility :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST A.V.Visibility
getVisibility g = liftIO $ decodeM =<< FFI.getVisibility (FFI.upCast g)

setVisibility :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> A.V.Visibility -> EncodeAST ()
setVisibility g v = liftIO . FFI.setVisibility (FFI.upCast g) =<< encodeM v

genCodingInstance [t| Maybe A.DLL.StorageClass |] ''FFI.DLLStorageClass [
  (FFI.dllStorageClassDefault, Nothing),
  (FFI.dllStorageClassDLLImport, Just A.DLL.Import),
  (FFI.dllStorageClassDLLExport, Just A.DLL.Export)
 ]

getDLLStorageClass :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST (Maybe A.DLL.StorageClass)
getDLLStorageClass g = liftIO $ decodeM =<< FFI.getDLLStorageClass (FFI.upCast g)

setDLLStorageClass :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> Maybe A.DLL.StorageClass -> EncodeAST ()
setDLLStorageClass g sc = liftIO . FFI.setDLLStorageClass (FFI.upCast g) =<< encodeM sc

getSection :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST (Maybe ShortByteString)
getSection g = do
  sectionLengthPtr <- alloca
  sectionNamePtr <- liftIO $ FFI.getSection (FFI.upCast g) sectionLengthPtr
  if sectionNamePtr == nullPtr then
    return Nothing
    else
      do sectionLength <- peek sectionLengthPtr
         sectionName <- decodeM (sectionNamePtr, sectionLength)
         return (Just sectionName)

setSection :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> Maybe ShortByteString -> EncodeAST ()
setSection g s = scopeAnyCont $ do
  s <- encodeM (fromMaybe "" s)
  liftIO $ FFI.setSection (FFI.upCast g) s

genCodingInstance [t| A.COMDAT.SelectionKind |] ''FFI.COMDATSelectionKind [
  (FFI.comdatSelectionKindAny, A.COMDAT.Any),
  (FFI.comdatSelectionKindExactMatch, A.COMDAT.ExactMatch),
  (FFI.comdatSelectionKindLargest, A.COMDAT.Largest),
  (FFI.comdatSelectionKindNoDuplicates, A.COMDAT.NoDuplicates),
  (FFI.comdatSelectionKindSameSize, A.COMDAT.SameSize)
 ]

instance DecodeM DecodeAST (ShortByteString, A.COMDAT.SelectionKind) (Ptr FFI.COMDAT) where
  decodeM c =
    (,)
      <$> decodeM (FFI.getCOMDATName c)
      <*> (decodeM =<< liftIO (FFI.getCOMDATSelectionKind c))

getCOMDATName :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST (Maybe ShortByteString)
getCOMDATName g = do
  c <- liftIO $ FFI.getCOMDAT (FFI.upCast g)
  if c == nullPtr
   then return Nothing
   else do
     cds <- gets comdats
     liftM Just $ case Map.lookup c cds of
       Just (name, _) -> return name
       Nothing -> do
          cd@(name, _) <- decodeM c
          modify $ \s -> s { comdats = Map.insert c cd cds }
          return name

setCOMDAT :: FFI.DescendentOf FFI.GlobalObject v => Ptr v -> Maybe ShortByteString -> EncodeAST ()
setCOMDAT _ Nothing = return ()
setCOMDAT g (Just name) = do
  cd <- referCOMDAT name
  liftIO $ FFI.setCOMDAT (FFI.upCast g) cd

setAlignment :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> Word32 -> EncodeAST ()
setAlignment g i = liftIO $ FFI.setAlignment (FFI.upCast g) (fromIntegral i)

getAlignment :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST Word32
getAlignment g = liftIO $ fromIntegral <$> FFI.getAlignment (FFI.upCast g)

genCodingInstance [t| Maybe A.TLS.Model |] ''FFI.ThreadLocalMode [
  (FFI.threadLocalModeNotThreadLocal, Nothing),
  (FFI.threadLocalModeGeneralDynamicTLSModel, Just A.TLS.GeneralDynamic),
  (FFI.threadLocalModeLocalDynamicTLSModel, Just A.TLS.LocalDynamic),
  (FFI.threadLocalModeInitialExecTLSModel, Just A.TLS.InitialExec),
  (FFI.threadLocalModeLocalExecTLSModel, Just A.TLS.LocalExec)
 ]

getThreadLocalMode :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST (Maybe A.TLS.Model)
getThreadLocalMode g = liftIO $ decodeM =<< FFI.getThreadLocalMode (FFI.upCast g)

setThreadLocalMode :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> Maybe A.TLS.Model -> EncodeAST ()
setThreadLocalMode g m = liftIO . FFI.setThreadLocalMode (FFI.upCast g) =<< encodeM m

genCodingInstance [t| Maybe A.G.UnnamedAddr |] ''FFI.UnnamedAddr [
  (FFI.unnamedAddrNo, Nothing),
  (FFI.unnamedAddrLocal, Just A.G.LocalAddr),
  (FFI.unnamedAddrGlobal, Just A.G.GlobalAddr)
 ]