module LLVM.Internal.Analysis where

import LLVM.Prelude

import Control.Monad.AnyCont
import Control.Monad.Catch
import Control.Monad.IO.Class

import qualified LLVM.Internal.FFI.Analysis as FFI
import qualified LLVM.Internal.FFI.LLVMCTypes as FFI

import LLVM.Internal.Module
import LLVM.Internal.Coding

import LLVM.Exception

-- | Run basic sanity checks on a 'Module'. Note that the same checks will trigger assertions
-- within LLVM if LLVM was built with them turned on, before this function can be is called.
verify :: Module -> IO ()
verify :: Module -> IO ()
verify m :: Module
m = (AnyContT IO () -> (() -> IO ()) -> IO ())
-> (() -> IO ()) -> AnyContT IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT IO () -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
runAnyContT () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyContT IO () -> IO ()) -> AnyContT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Ptr (OwnerTransfered CString)
errorPtr <- AnyContT IO (Ptr (OwnerTransfered CString))
forall a (m :: * -> *).
(Storable a, MonadAnyCont IO m) =>
m (Ptr a)
alloca
  Ptr Module
m' <- Module -> AnyContT IO (Ptr Module)
forall (m :: * -> *). MonadIO m => Module -> m (Ptr Module)
readModule Module
m
  Bool
result <- LLVMBool -> AnyContT IO Bool
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (LLVMBool -> AnyContT IO Bool)
-> AnyContT IO LLVMBool -> AnyContT IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO LLVMBool -> AnyContT IO LLVMBool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LLVMBool -> AnyContT IO LLVMBool)
-> IO LLVMBool -> AnyContT IO LLVMBool
forall a b. (a -> b) -> a -> b
$ Ptr Module
-> VerifierFailureAction
-> Ptr (OwnerTransfered CString)
-> IO LLVMBool
FFI.verifyModule Ptr Module
m' VerifierFailureAction
FFI.verifierFailureActionReturnStatus Ptr (OwnerTransfered CString)
errorPtr)
  Bool -> AnyContT IO () -> AnyContT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
result (AnyContT IO () -> AnyContT IO ())
-> AnyContT IO () -> AnyContT IO ()
forall a b. (a -> b) -> a -> b
$ VerifyException -> AnyContT IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (VerifyException -> AnyContT IO ())
-> (String -> VerifyException) -> String -> AnyContT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VerifyException
VerifyException (String -> AnyContT IO ()) -> AnyContT IO String -> AnyContT IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (OwnerTransfered CString) -> AnyContT IO String
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM Ptr (OwnerTransfered CString)
errorPtr