{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-cse #-}
module GHC.Utils.GlobalVars
( v_unsafeHasPprDebug
, v_unsafeHasNoDebugOutput
, v_unsafeHasNoStateHack
, unsafeHasPprDebug
, unsafeHasNoDebugOutput
, unsafeHasNoStateHack
, global
, consIORef
, globalM
, sharedGlobal
, sharedGlobalM
)
where
import GHC.Prelude.Basic
import GHC.Conc.Sync ( sharedCAF )
import System.IO.Unsafe
import Data.IORef
import Foreign (Ptr)
#define GLOBAL_VAR(name,value,ty) \
{-# NOINLINE name #-}; \
name :: IORef (ty); \
name = global (value);
#define GLOBAL_VAR_M(name,value,ty) \
{-# NOINLINE name #-}; \
name :: IORef (ty); \
name = globalM (value);
#define SHARED_GLOBAL_VAR(name,accessor,saccessor,value,ty) \
{-# NOINLINE name #-}; \
name :: IORef (ty); \
name = sharedGlobal (value) (accessor); \
foreign import ccall unsafe saccessor \
accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));
#define SHARED_GLOBAL_VAR_M(name,accessor,saccessor,value,ty) \
{-# NOINLINE name #-}; \
name :: IORef (ty); \
name = sharedGlobalM (value) (accessor); \
foreign import ccall unsafe saccessor \
accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));
#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
GLOBAL_VAR(v_unsafeHasPprDebug, False, Bool)
GLOBAL_VAR(v_unsafeHasNoDebugOutput, False, Bool)
GLOBAL_VAR(v_unsafeHasNoStateHack, False, Bool)
#else
SHARED_GLOBAL_VAR( v_unsafeHasPprDebug
, getOrSetLibHSghcGlobalHasPprDebug
, "getOrSetLibHSghcGlobalHasPprDebug"
, False
, Bool )
SHARED_GLOBAL_VAR( v_unsafeHasNoDebugOutput
, getOrSetLibHSghcGlobalHasNoDebugOutput
, "getOrSetLibHSghcGlobalHasNoDebugOutput"
, False
, Bool )
SHARED_GLOBAL_VAR( v_unsafeHasNoStateHack
, getOrSetLibHSghcGlobalHasNoStateHack
, "getOrSetLibHSghcGlobalHasNoStateHack"
, False
, Bool )
#endif
unsafeHasPprDebug :: Bool
unsafeHasPprDebug :: Bool
unsafeHasPprDebug = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
v_unsafeHasPprDebug
unsafeHasNoDebugOutput :: Bool
unsafeHasNoDebugOutput :: Bool
unsafeHasNoDebugOutput = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
v_unsafeHasNoDebugOutput
unsafeHasNoStateHack :: Bool
unsafeHasNoStateHack :: Bool
unsafeHasNoStateHack = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
v_unsafeHasNoStateHack
global :: a -> IORef a
global :: forall a. a -> IORef a
global a
a = IO (IORef a) -> IORef a
forall a. IO a -> a
unsafePerformIO (a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
a)
consIORef :: IORef [a] -> a -> IO ()
consIORef :: forall a. IORef [a] -> a -> IO ()
consIORef IORef [a]
var a
x =
IORef [a] -> ([a] -> ([a], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [a]
var (\[a]
xs -> (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs,()))
globalM :: IO a -> IORef a
globalM :: forall a. IO a -> IORef a
globalM IO a
ma = IO (IORef a) -> IORef a
forall a. IO a -> a
unsafePerformIO (IO a
ma IO a -> (a -> IO (IORef a)) -> IO (IORef a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef)
sharedGlobal :: a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
sharedGlobal :: forall a. a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
sharedGlobal a
a Ptr (IORef a) -> IO (Ptr (IORef a))
get_or_set = IO (IORef a) -> IORef a
forall a. IO a -> a
unsafePerformIO (IO (IORef a) -> IORef a) -> IO (IORef a) -> IORef a
forall a b. (a -> b) -> a -> b
$
a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
a IO (IORef a) -> (IORef a -> IO (IORef a)) -> IO (IORef a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IORef a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IO (IORef a))
-> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a -> IO (IORef a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip IORef a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IO (IORef a)
forall a. a -> (Ptr a -> IO (Ptr a)) -> IO a
sharedCAF Ptr (IORef a) -> IO (Ptr (IORef a))
get_or_set
sharedGlobalM :: IO a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
sharedGlobalM :: forall a. IO a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
sharedGlobalM IO a
ma Ptr (IORef a) -> IO (Ptr (IORef a))
get_or_set = IO (IORef a) -> IORef a
forall a. IO a -> a
unsafePerformIO (IO (IORef a) -> IORef a) -> IO (IORef a) -> IORef a
forall a b. (a -> b) -> a -> b
$
IO a
ma IO a -> (a -> IO (IORef a)) -> IO (IORef a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef IO (IORef a) -> (IORef a -> IO (IORef a)) -> IO (IORef a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IORef a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IO (IORef a))
-> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a -> IO (IORef a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip IORef a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IO (IORef a)
forall a. a -> (Ptr a -> IO (Ptr a)) -> IO a
sharedCAF Ptr (IORef a) -> IO (Ptr (IORef a))
get_or_set