{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} module LLVM.Internal.InlineAssembly where import LLVM.Prelude import Control.Monad.IO.Class import qualified Data.ByteString.Char8 as ByteString import Foreign.C import Foreign.Ptr import qualified LLVM.Internal.FFI.InlineAssembly as FFI import qualified LLVM.Internal.FFI.LLVMCTypes as FFI import qualified LLVM.Internal.FFI.Module as FFI import qualified LLVM.Internal.FFI.PtrHierarchy as FFI import qualified LLVM.AST as A (Definition(..)) import qualified LLVM.AST.InlineAssembly as A import qualified LLVM.AST.Type as A import LLVM.Internal.Coding import LLVM.Internal.EncodeAST import LLVM.Internal.DecodeAST import LLVM.Internal.Value genCodingInstance [t| A.Dialect |] ''FFI.AsmDialect [ (FFI.asmDialectATT, A.ATTDialect), (FFI.asmDialectIntel, A.IntelDialect) ] instance EncodeM EncodeAST A.InlineAssembly (Ptr FFI.InlineAsm) where encodeM :: InlineAssembly -> EncodeAST (Ptr InlineAsm) encodeM (A.InlineAssembly { type' :: InlineAssembly -> Type A.type' = Type t, assembly :: InlineAssembly -> ByteString A.assembly = ByteString assembly, constraints :: InlineAssembly -> ShortByteString A.constraints = ShortByteString constraints, hasSideEffects :: InlineAssembly -> Bool A.hasSideEffects = Bool hasSideEffects, alignStack :: InlineAssembly -> Bool A.alignStack = Bool alignStack, dialect :: InlineAssembly -> Dialect A.dialect = Dialect dialect }) = do Ptr Type t <- Type -> EncodeAST (Ptr Type) forall (e :: * -> *) h c. EncodeM e h c => h -> e c encodeM Type t CString assembly <- ByteString -> EncodeAST CString forall (e :: * -> *) h c. EncodeM e h c => h -> e c encodeM ByteString assembly CString constraints <- ShortByteString -> EncodeAST CString forall (e :: * -> *) h c. EncodeM e h c => h -> e c encodeM ShortByteString constraints LLVMBool hasSideEffects <- Bool -> EncodeAST LLVMBool forall (e :: * -> *) h c. EncodeM e h c => h -> e c encodeM Bool hasSideEffects LLVMBool alignStack <- Bool -> EncodeAST LLVMBool forall (e :: * -> *) h c. EncodeM e h c => h -> e c encodeM Bool alignStack AsmDialect dialect <- Dialect -> EncodeAST AsmDialect forall (e :: * -> *) h c. EncodeM e h c => h -> e c encodeM Dialect dialect IO (Ptr InlineAsm) -> EncodeAST (Ptr InlineAsm) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Ptr InlineAsm) -> EncodeAST (Ptr InlineAsm)) -> IO (Ptr InlineAsm) -> EncodeAST (Ptr InlineAsm) forall a b. (a -> b) -> a -> b $ Ptr Type -> CString -> CString -> LLVMBool -> LLVMBool -> AsmDialect -> IO (Ptr InlineAsm) FFI.createInlineAsm Ptr Type t CString assembly CString constraints LLVMBool hasSideEffects LLVMBool alignStack AsmDialect dialect instance DecodeM DecodeAST A.InlineAssembly (Ptr FFI.InlineAsm) where decodeM :: Ptr InlineAsm -> DecodeAST InlineAssembly decodeM p :: Ptr InlineAsm p = do (Type -> ByteString -> ShortByteString -> Bool -> Bool -> Dialect -> InlineAssembly) -> DecodeAST (Type -> ByteString -> ShortByteString -> Bool -> Bool -> Dialect -> InlineAssembly) forall (m :: * -> *) a. Monad m => a -> m a return Type -> ByteString -> ShortByteString -> Bool -> Bool -> Dialect -> InlineAssembly A.InlineAssembly DecodeAST (Type -> ByteString -> ShortByteString -> Bool -> Bool -> Dialect -> InlineAssembly) -> DecodeAST Type -> DecodeAST (ByteString -> ShortByteString -> Bool -> Bool -> Dialect -> InlineAssembly) forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b `ap` ((Type -> Type) -> DecodeAST Type -> DecodeAST Type forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r liftM (\(A.PointerType f :: Type f _) -> Type f) (Ptr InlineAsm -> DecodeAST Type forall v. DescendentOf Value v => Ptr v -> DecodeAST Type typeOf Ptr InlineAsm p)) DecodeAST (ByteString -> ShortByteString -> Bool -> Bool -> Dialect -> InlineAssembly) -> DecodeAST ByteString -> DecodeAST (ShortByteString -> Bool -> Bool -> Dialect -> InlineAssembly) forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b `ap` (CString -> DecodeAST ByteString forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (CString -> DecodeAST ByteString) -> DecodeAST CString -> DecodeAST ByteString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO CString -> DecodeAST CString forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (Ptr InlineAsm -> IO CString FFI.getInlineAsmAssemblyString Ptr InlineAsm p)) DecodeAST (ShortByteString -> Bool -> Bool -> Dialect -> InlineAssembly) -> DecodeAST ShortByteString -> DecodeAST (Bool -> Bool -> Dialect -> InlineAssembly) forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b `ap` (CString -> DecodeAST ShortByteString forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (CString -> DecodeAST ShortByteString) -> DecodeAST CString -> DecodeAST ShortByteString forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO CString -> DecodeAST CString forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (Ptr InlineAsm -> IO CString FFI.getInlineAsmConstraintString Ptr InlineAsm p)) DecodeAST (Bool -> Bool -> Dialect -> InlineAssembly) -> DecodeAST Bool -> DecodeAST (Bool -> Dialect -> InlineAssembly) forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b `ap` (LLVMBool -> DecodeAST Bool forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (LLVMBool -> DecodeAST Bool) -> DecodeAST LLVMBool -> DecodeAST Bool forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO LLVMBool -> DecodeAST LLVMBool forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (Ptr InlineAsm -> IO LLVMBool FFI.inlineAsmHasSideEffects Ptr InlineAsm p)) DecodeAST (Bool -> Dialect -> InlineAssembly) -> DecodeAST Bool -> DecodeAST (Dialect -> InlineAssembly) forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b `ap` (LLVMBool -> DecodeAST Bool forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (LLVMBool -> DecodeAST Bool) -> DecodeAST LLVMBool -> DecodeAST Bool forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO LLVMBool -> DecodeAST LLVMBool forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (Ptr InlineAsm -> IO LLVMBool FFI.inlineAsmIsAlignStack Ptr InlineAsm p)) DecodeAST (Dialect -> InlineAssembly) -> DecodeAST Dialect -> DecodeAST InlineAssembly forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b `ap` (AsmDialect -> DecodeAST Dialect forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM (AsmDialect -> DecodeAST Dialect) -> DecodeAST AsmDialect -> DecodeAST Dialect forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO AsmDialect -> DecodeAST AsmDialect forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (Ptr InlineAsm -> IO AsmDialect FFI.getInlineAsmDialect Ptr InlineAsm p)) instance DecodeM DecodeAST [A.Definition] (FFI.ModuleAsm CString) where decodeM :: ModuleAsm CString -> DecodeAST [Definition] decodeM (FFI.ModuleAsm s :: CString s) = do ByteString s' <- CString -> DecodeAST ByteString forall (d :: * -> *) h c. DecodeM d h c => c -> d h decodeM CString s [Definition] -> DecodeAST [Definition] forall (m :: * -> *) a. Monad m => a -> m a return ([Definition] -> DecodeAST [Definition]) -> ([ByteString] -> [Definition]) -> [ByteString] -> DecodeAST [Definition] forall b c a. (b -> c) -> (a -> b) -> a -> c . (ByteString -> Definition) -> [ByteString] -> [Definition] forall a b. (a -> b) -> [a] -> [b] map ByteString -> Definition A.ModuleInlineAssembly ([ByteString] -> DecodeAST [Definition]) -> [ByteString] -> DecodeAST [Definition] forall a b. (a -> b) -> a -> b $ ByteString -> [ByteString] ByteString.lines ByteString s'