{-# LANGUAGE CPP #-}

{-# OPTIONS_GHC -fno-cse #-}
-- -fno-cse is needed for GLOBAL_VAR's to behave properly

-- | Do not use global variables!
--
-- Global variables are a hack. Do not use them if you can help it.
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));



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 )

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

{-
************************************************************************
*                                                                      *
                        Globals and the RTS
*                                                                      *
************************************************************************

When a plugin is loaded, it currently gets linked against a *newly
loaded* copy of the GHC package. This would not be a problem, except
that the new copy has its own mutable state that is not shared with
that state that has already been initialized by the original GHC
package.

(Note that if the GHC executable was dynamically linked this
wouldn't be a problem, because we could share the GHC library it
links to; this is only a problem if DYNAMIC_GHC_PROGRAMS=NO.)

The solution is to make use of @sharedCAF@ through @sharedGlobal@
for globals that are shared between multiple copies of ghc packages.
-}

-- Global variables:

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)

-- Shared global variables:

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