{-# 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 :: Ptr v -> DecodeAST Linkage getLinkage g :: Ptr v g = IO Linkage -> DecodeAST Linkage forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO Linkage -> DecodeAST Linkage) -> IO Linkage -> DecodeAST Linkage forall a b. (a -> b) -> a -> b $ Linkage -> IO Linkage forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (Linkage -> IO Linkage) -> IO Linkage -> IO Linkage forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Ptr GlobalValue -> IO Linkage FFI.getLinkage (Ptr v -> Ptr GlobalValue forall a b. DescendentOf a b => Ptr b -> Ptr a FFI.upCast Ptr v g) setLinkage :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> A.L.Linkage -> EncodeAST () setLinkage :: Ptr v -> Linkage -> EncodeAST () setLinkage g :: Ptr v g l :: Linkage l = IO () -> EncodeAST () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> EncodeAST ()) -> (Linkage -> IO ()) -> Linkage -> EncodeAST () forall b c a. (b -> c) -> (a -> b) -> a -> c . Ptr GlobalValue -> Linkage -> IO () FFI.setLinkage (Ptr v -> Ptr GlobalValue forall a b. DescendentOf a b => Ptr b -> Ptr a FFI.upCast Ptr v g) (Linkage -> EncodeAST ()) -> EncodeAST Linkage -> EncodeAST () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Linkage -> EncodeAST Linkage forall (e :: * -> *) h c. EncodeM e h c => h -> e c encodeM Linkage 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 :: Ptr v -> DecodeAST Visibility getVisibility g :: Ptr v g = IO Visibility -> DecodeAST Visibility forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO Visibility -> DecodeAST Visibility) -> IO Visibility -> DecodeAST Visibility forall a b. (a -> b) -> a -> b $ Visibility -> IO Visibility forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (Visibility -> IO Visibility) -> IO Visibility -> IO Visibility forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Ptr GlobalValue -> IO Visibility FFI.getVisibility (Ptr v -> Ptr GlobalValue forall a b. DescendentOf a b => Ptr b -> Ptr a FFI.upCast Ptr v g) setVisibility :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> A.V.Visibility -> EncodeAST () setVisibility :: Ptr v -> Visibility -> EncodeAST () setVisibility g :: Ptr v g v :: Visibility v = IO () -> EncodeAST () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> EncodeAST ()) -> (Visibility -> IO ()) -> Visibility -> EncodeAST () forall b c a. (b -> c) -> (a -> b) -> a -> c . Ptr GlobalValue -> Visibility -> IO () FFI.setVisibility (Ptr v -> Ptr GlobalValue forall a b. DescendentOf a b => Ptr b -> Ptr a FFI.upCast Ptr v g) (Visibility -> EncodeAST ()) -> EncodeAST Visibility -> EncodeAST () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Visibility -> EncodeAST Visibility forall (e :: * -> *) h c. EncodeM e h c => h -> e c encodeM Visibility 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 :: Ptr v -> DecodeAST (Maybe StorageClass) getDLLStorageClass g :: Ptr v g = IO (Maybe StorageClass) -> DecodeAST (Maybe StorageClass) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Maybe StorageClass) -> DecodeAST (Maybe StorageClass)) -> IO (Maybe StorageClass) -> DecodeAST (Maybe StorageClass) forall a b. (a -> b) -> a -> b $ DLLStorageClass -> IO (Maybe StorageClass) forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (DLLStorageClass -> IO (Maybe StorageClass)) -> IO DLLStorageClass -> IO (Maybe StorageClass) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Ptr GlobalValue -> IO DLLStorageClass FFI.getDLLStorageClass (Ptr v -> Ptr GlobalValue forall a b. DescendentOf a b => Ptr b -> Ptr a FFI.upCast Ptr v g) setDLLStorageClass :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> Maybe A.DLL.StorageClass -> EncodeAST () setDLLStorageClass :: Ptr v -> Maybe StorageClass -> EncodeAST () setDLLStorageClass g :: Ptr v g sc :: Maybe StorageClass sc = IO () -> EncodeAST () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> EncodeAST ()) -> (DLLStorageClass -> IO ()) -> DLLStorageClass -> EncodeAST () forall b c a. (b -> c) -> (a -> b) -> a -> c . Ptr GlobalValue -> DLLStorageClass -> IO () FFI.setDLLStorageClass (Ptr v -> Ptr GlobalValue forall a b. DescendentOf a b => Ptr b -> Ptr a FFI.upCast Ptr v g) (DLLStorageClass -> EncodeAST ()) -> EncodeAST DLLStorageClass -> EncodeAST () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Maybe StorageClass -> EncodeAST DLLStorageClass forall (e :: * -> *) h c. EncodeM e h c => h -> e c encodeM Maybe StorageClass sc getSection :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST (Maybe ShortByteString) getSection :: Ptr v -> DecodeAST (Maybe ShortByteString) getSection g :: Ptr v g = do Ptr CSize sectionLengthPtr <- DecodeAST (Ptr CSize) forall a (m :: * -> *). (Storable a, MonadAnyCont IO m) => m (Ptr a) alloca CString sectionNamePtr <- IO CString -> DecodeAST CString forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO CString -> DecodeAST CString) -> IO CString -> DecodeAST CString forall a b. (a -> b) -> a -> b $ Ptr GlobalValue -> Ptr CSize -> IO CString FFI.getSection (Ptr v -> Ptr GlobalValue forall a b. DescendentOf a b => Ptr b -> Ptr a FFI.upCast Ptr v g) Ptr CSize sectionLengthPtr if CString sectionNamePtr CString -> CString -> Bool forall a. Eq a => a -> a -> Bool == CString forall a. Ptr a nullPtr then Maybe ShortByteString -> DecodeAST (Maybe ShortByteString) forall (m :: * -> *) a. Monad m => a -> m a return Maybe ShortByteString forall a. Maybe a Nothing else do CSize sectionLength <- Ptr CSize -> DecodeAST CSize forall a (m :: * -> *). (Storable a, MonadIO m) => Ptr a -> m a peek Ptr CSize sectionLengthPtr ShortByteString sectionName <- (CString, CSize) -> DecodeAST ShortByteString forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (CString sectionNamePtr, CSize sectionLength) Maybe ShortByteString -> DecodeAST (Maybe ShortByteString) forall (m :: * -> *) a. Monad m => a -> m a return (ShortByteString -> Maybe ShortByteString forall a. a -> Maybe a Just ShortByteString sectionName) setSection :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> Maybe ShortByteString -> EncodeAST () setSection :: Ptr v -> Maybe ShortByteString -> EncodeAST () setSection g :: Ptr v g s :: Maybe ShortByteString s = EncodeAST () -> EncodeAST () forall (m :: * -> *) a. ScopeAnyCont m => m a -> m a scopeAnyCont (EncodeAST () -> EncodeAST ()) -> EncodeAST () -> EncodeAST () forall a b. (a -> b) -> a -> b $ do CString s <- ShortByteString -> EncodeAST CString forall (e :: * -> *) h c. EncodeM e h c => h -> e c encodeM (ShortByteString -> Maybe ShortByteString -> ShortByteString forall a. a -> Maybe a -> a fromMaybe "" Maybe ShortByteString s) IO () -> EncodeAST () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST () forall a b. (a -> b) -> a -> b $ Ptr GlobalValue -> CString -> IO () FFI.setSection (Ptr v -> Ptr GlobalValue forall a b. DescendentOf a b => Ptr b -> Ptr a FFI.upCast Ptr v g) CString 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 :: Ptr COMDAT -> DecodeAST (ShortByteString, SelectionKind) decodeM c :: Ptr COMDAT c = (,) (ShortByteString -> SelectionKind -> (ShortByteString, SelectionKind)) -> DecodeAST ShortByteString -> DecodeAST (SelectionKind -> (ShortByteString, SelectionKind)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Ptr CSize -> IO CString) -> DecodeAST ShortByteString forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (Ptr COMDAT -> Ptr CSize -> IO CString FFI.getCOMDATName Ptr COMDAT c) DecodeAST (SelectionKind -> (ShortByteString, SelectionKind)) -> DecodeAST SelectionKind -> DecodeAST (ShortByteString, SelectionKind) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (COMDATSelectionKind -> DecodeAST SelectionKind forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (COMDATSelectionKind -> DecodeAST SelectionKind) -> DecodeAST COMDATSelectionKind -> DecodeAST SelectionKind forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO COMDATSelectionKind -> DecodeAST COMDATSelectionKind forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (Ptr COMDAT -> IO COMDATSelectionKind FFI.getCOMDATSelectionKind Ptr COMDAT c)) getCOMDATName :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST (Maybe ShortByteString) getCOMDATName :: Ptr v -> DecodeAST (Maybe ShortByteString) getCOMDATName g :: Ptr v g = do Ptr COMDAT c <- IO (Ptr COMDAT) -> DecodeAST (Ptr COMDAT) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Ptr COMDAT) -> DecodeAST (Ptr COMDAT)) -> IO (Ptr COMDAT) -> DecodeAST (Ptr COMDAT) forall a b. (a -> b) -> a -> b $ Ptr GlobalValue -> IO (Ptr COMDAT) FFI.getCOMDAT (Ptr v -> Ptr GlobalValue forall a b. DescendentOf a b => Ptr b -> Ptr a FFI.upCast Ptr v g) if Ptr COMDAT c Ptr COMDAT -> Ptr COMDAT -> Bool forall a. Eq a => a -> a -> Bool == Ptr COMDAT forall a. Ptr a nullPtr then Maybe ShortByteString -> DecodeAST (Maybe ShortByteString) forall (m :: * -> *) a. Monad m => a -> m a return Maybe ShortByteString forall a. Maybe a Nothing else do Map (Ptr COMDAT) (ShortByteString, SelectionKind) cds <- (DecodeState -> Map (Ptr COMDAT) (ShortByteString, SelectionKind)) -> DecodeAST (Map (Ptr COMDAT) (ShortByteString, SelectionKind)) forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a gets DecodeState -> Map (Ptr COMDAT) (ShortByteString, SelectionKind) comdats (ShortByteString -> Maybe ShortByteString) -> DecodeAST ShortByteString -> DecodeAST (Maybe ShortByteString) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r liftM ShortByteString -> Maybe ShortByteString forall a. a -> Maybe a Just (DecodeAST ShortByteString -> DecodeAST (Maybe ShortByteString)) -> DecodeAST ShortByteString -> DecodeAST (Maybe ShortByteString) forall a b. (a -> b) -> a -> b $ case Ptr COMDAT -> Map (Ptr COMDAT) (ShortByteString, SelectionKind) -> Maybe (ShortByteString, SelectionKind) forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup Ptr COMDAT c Map (Ptr COMDAT) (ShortByteString, SelectionKind) cds of Just (name :: ShortByteString name, _) -> ShortByteString -> DecodeAST ShortByteString forall (m :: * -> *) a. Monad m => a -> m a return ShortByteString name Nothing -> do cd :: (ShortByteString, SelectionKind) cd@(name :: ShortByteString name, _) <- Ptr COMDAT -> DecodeAST (ShortByteString, SelectionKind) forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM Ptr COMDAT c (DecodeState -> DecodeState) -> DecodeAST () forall s (m :: * -> *). MonadState s m => (s -> s) -> m () modify ((DecodeState -> DecodeState) -> DecodeAST ()) -> (DecodeState -> DecodeState) -> DecodeAST () forall a b. (a -> b) -> a -> b $ \s :: DecodeState s -> DecodeState s { comdats :: Map (Ptr COMDAT) (ShortByteString, SelectionKind) comdats = Ptr COMDAT -> (ShortByteString, SelectionKind) -> Map (Ptr COMDAT) (ShortByteString, SelectionKind) -> Map (Ptr COMDAT) (ShortByteString, SelectionKind) forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert Ptr COMDAT c (ShortByteString, SelectionKind) cd Map (Ptr COMDAT) (ShortByteString, SelectionKind) cds } ShortByteString -> DecodeAST ShortByteString forall (m :: * -> *) a. Monad m => a -> m a return ShortByteString name setCOMDAT :: FFI.DescendentOf FFI.GlobalObject v => Ptr v -> Maybe ShortByteString -> EncodeAST () setCOMDAT :: Ptr v -> Maybe ShortByteString -> EncodeAST () setCOMDAT _ Nothing = () -> EncodeAST () forall (m :: * -> *) a. Monad m => a -> m a return () setCOMDAT g :: Ptr v g (Just name :: ShortByteString name) = do Ptr COMDAT cd <- ShortByteString -> EncodeAST (Ptr COMDAT) referCOMDAT ShortByteString name IO () -> EncodeAST () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST () forall a b. (a -> b) -> a -> b $ Ptr GlobalObject -> Ptr COMDAT -> IO () FFI.setCOMDAT (Ptr v -> Ptr GlobalObject forall a b. DescendentOf a b => Ptr b -> Ptr a FFI.upCast Ptr v g) Ptr COMDAT cd setAlignment :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> Word32 -> EncodeAST () setAlignment :: Ptr v -> Word32 -> EncodeAST () setAlignment g :: Ptr v g i :: Word32 i = IO () -> EncodeAST () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> EncodeAST ()) -> IO () -> EncodeAST () forall a b. (a -> b) -> a -> b $ Ptr GlobalValue -> CUInt -> IO () FFI.setAlignment (Ptr v -> Ptr GlobalValue forall a b. DescendentOf a b => Ptr b -> Ptr a FFI.upCast Ptr v g) (Word32 -> CUInt forall a b. (Integral a, Num b) => a -> b fromIntegral Word32 i) getAlignment :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> DecodeAST Word32 getAlignment :: Ptr v -> DecodeAST Word32 getAlignment g :: Ptr v g = IO Word32 -> DecodeAST Word32 forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO Word32 -> DecodeAST Word32) -> IO Word32 -> DecodeAST Word32 forall a b. (a -> b) -> a -> b $ CUInt -> Word32 forall a b. (Integral a, Num b) => a -> b fromIntegral (CUInt -> Word32) -> IO CUInt -> IO Word32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Ptr GlobalValue -> IO CUInt FFI.getAlignment (Ptr v -> Ptr GlobalValue forall a b. DescendentOf a b => Ptr b -> Ptr a FFI.upCast Ptr v 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 :: Ptr v -> DecodeAST (Maybe Model) getThreadLocalMode g :: Ptr v g = IO (Maybe Model) -> DecodeAST (Maybe Model) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Maybe Model) -> DecodeAST (Maybe Model)) -> IO (Maybe Model) -> DecodeAST (Maybe Model) forall a b. (a -> b) -> a -> b $ ThreadLocalMode -> IO (Maybe Model) forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (ThreadLocalMode -> IO (Maybe Model)) -> IO ThreadLocalMode -> IO (Maybe Model) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Ptr GlobalValue -> IO ThreadLocalMode FFI.getThreadLocalMode (Ptr v -> Ptr GlobalValue forall a b. DescendentOf a b => Ptr b -> Ptr a FFI.upCast Ptr v g) setThreadLocalMode :: FFI.DescendentOf FFI.GlobalValue v => Ptr v -> Maybe A.TLS.Model -> EncodeAST () setThreadLocalMode :: Ptr v -> Maybe Model -> EncodeAST () setThreadLocalMode g :: Ptr v g m :: Maybe Model m = IO () -> EncodeAST () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> EncodeAST ()) -> (ThreadLocalMode -> IO ()) -> ThreadLocalMode -> EncodeAST () forall b c a. (b -> c) -> (a -> b) -> a -> c . Ptr GlobalValue -> ThreadLocalMode -> IO () FFI.setThreadLocalMode (Ptr v -> Ptr GlobalValue forall a b. DescendentOf a b => Ptr b -> Ptr a FFI.upCast Ptr v g) (ThreadLocalMode -> EncodeAST ()) -> EncodeAST ThreadLocalMode -> EncodeAST () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Maybe Model -> EncodeAST ThreadLocalMode forall (e :: * -> *) h c. EncodeM e h c => h -> e c encodeM Maybe Model m genCodingInstance [t| Maybe A.G.UnnamedAddr |] ''FFI.UnnamedAddr [ (FFI.unnamedAddrNo, Nothing), (FFI.unnamedAddrLocal, Just A.G.LocalAddr), (FFI.unnamedAddrGlobal, Just A.G.GlobalAddr) ]