-- | functionality necessary when running LLVM in multiple threads at the same time.
module LLVM.Threading (
  setMultithreaded,
  isMultithreaded
  ) where

import LLVM.Prelude

import LLVM.Internal.Threading

{-# DEPRECATED setMultithreaded "LLVM no longer features runtime control of multithreading support" #-}
-- | This function used set the multithreading mode of LLVM, but that feature no longer exists. Threading is
-- controlled only at runtime with the configure flag --enable-threads (default is YES). This function will
-- now check that the the compiled-in multithreading support (returned by 'isMultithreaded') is
-- sufficient to support the requested access, and fail if not, so as to prevent uncontrolled use of a
-- version of LLVM compiled to be capable only of singled threaded use by haskell code requesting
-- multithreading support.
setMultithreaded :: Bool -> IO ()
setMultithreaded :: Bool -> IO ()
setMultithreaded desired :: Bool
desired = do
  Bool
actual <- IO Bool
isMultithreaded
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
desired Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
actual) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
     String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Multithreading support requested but not available. " String -> String -> String
forall a. [a] -> [a] -> [a]
++ 
            "Please use an LLVM built with threading enabled"
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()