{-# 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'