never executed always true always false

    1 {-# LANGUAGE CPP #-}
    2 
    3 {-# OPTIONS_GHC -fno-cse #-}
    4 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
    5 
    6 -- | Do not use global variables!
    7 --
    8 -- Global variables are a hack. Do not use them if you can help it.
    9 module GHC.Utils.GlobalVars
   10    ( v_unsafeHasPprDebug
   11    , v_unsafeHasNoDebugOutput
   12    , v_unsafeHasNoStateHack
   13    , unsafeHasPprDebug
   14    , unsafeHasNoDebugOutput
   15    , unsafeHasNoStateHack
   16 
   17    , global
   18    , consIORef
   19    , globalM
   20    , sharedGlobal
   21    , sharedGlobalM
   22    )
   23 where
   24 
   25 -- For GHC_STAGE
   26 #include "ghcplatform.h"
   27 
   28 import GHC.Prelude
   29 
   30 import GHC.Conc.Sync ( sharedCAF )
   31 
   32 import System.IO.Unsafe
   33 import Data.IORef
   34 import Foreign (Ptr)
   35 
   36 #define GLOBAL_VAR(name,value,ty)  \
   37 {-# NOINLINE name #-};             \
   38 name :: IORef (ty);                \
   39 name = global (value);
   40 
   41 #define GLOBAL_VAR_M(name,value,ty) \
   42 {-# NOINLINE name #-};              \
   43 name :: IORef (ty);                 \
   44 name = globalM (value);
   45 
   46 
   47 #define SHARED_GLOBAL_VAR(name,accessor,saccessor,value,ty) \
   48 {-# NOINLINE name #-};                                      \
   49 name :: IORef (ty);                                         \
   50 name = sharedGlobal (value) (accessor);                     \
   51 foreign import ccall unsafe saccessor                       \
   52   accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));
   53 
   54 #define SHARED_GLOBAL_VAR_M(name,accessor,saccessor,value,ty)  \
   55 {-# NOINLINE name #-};                                         \
   56 name :: IORef (ty);                                            \
   57 name = sharedGlobalM (value) (accessor);                       \
   58 foreign import ccall unsafe saccessor                          \
   59   accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));
   60 
   61 
   62 
   63 #if GHC_STAGE < 2
   64 
   65 GLOBAL_VAR(v_unsafeHasPprDebug,      False, Bool)
   66 GLOBAL_VAR(v_unsafeHasNoDebugOutput, False, Bool)
   67 GLOBAL_VAR(v_unsafeHasNoStateHack,   False, Bool)
   68 
   69 #else
   70 SHARED_GLOBAL_VAR( v_unsafeHasPprDebug
   71                  , getOrSetLibHSghcGlobalHasPprDebug
   72                  , "getOrSetLibHSghcGlobalHasPprDebug"
   73                  , False
   74                  , Bool )
   75 SHARED_GLOBAL_VAR( v_unsafeHasNoDebugOutput
   76                  , getOrSetLibHSghcGlobalHasNoDebugOutput
   77                  , "getOrSetLibHSghcGlobalHasNoDebugOutput"
   78                  , False
   79                  , Bool )
   80 SHARED_GLOBAL_VAR( v_unsafeHasNoStateHack
   81                  , getOrSetLibHSghcGlobalHasNoStateHack
   82                  , "getOrSetLibHSghcGlobalHasNoStateHack"
   83                  , False
   84                  , Bool )
   85 #endif
   86 
   87 unsafeHasPprDebug :: Bool
   88 unsafeHasPprDebug = unsafePerformIO $ readIORef v_unsafeHasPprDebug
   89 
   90 unsafeHasNoDebugOutput :: Bool
   91 unsafeHasNoDebugOutput = unsafePerformIO $ readIORef v_unsafeHasNoDebugOutput
   92 
   93 unsafeHasNoStateHack :: Bool
   94 unsafeHasNoStateHack = unsafePerformIO $ readIORef v_unsafeHasNoStateHack
   95 
   96 {-
   97 ************************************************************************
   98 *                                                                      *
   99                         Globals and the RTS
  100 *                                                                      *
  101 ************************************************************************
  102 
  103 When a plugin is loaded, it currently gets linked against a *newly
  104 loaded* copy of the GHC package. This would not be a problem, except
  105 that the new copy has its own mutable state that is not shared with
  106 that state that has already been initialized by the original GHC
  107 package.
  108 
  109 (Note that if the GHC executable was dynamically linked this
  110 wouldn't be a problem, because we could share the GHC library it
  111 links to; this is only a problem if DYNAMIC_GHC_PROGRAMS=NO.)
  112 
  113 The solution is to make use of @sharedCAF@ through @sharedGlobal@
  114 for globals that are shared between multiple copies of ghc packages.
  115 -}
  116 
  117 -- Global variables:
  118 
  119 global :: a -> IORef a
  120 global a = unsafePerformIO (newIORef a)
  121 
  122 consIORef :: IORef [a] -> a -> IO ()
  123 consIORef var x =
  124   atomicModifyIORef' var (\xs -> (x:xs,()))
  125 
  126 globalM :: IO a -> IORef a
  127 globalM ma = unsafePerformIO (ma >>= newIORef)
  128 
  129 -- Shared global variables:
  130 
  131 sharedGlobal :: a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
  132 sharedGlobal a get_or_set = unsafePerformIO $
  133   newIORef a >>= flip sharedCAF get_or_set
  134 
  135 sharedGlobalM :: IO a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
  136 sharedGlobalM ma get_or_set = unsafePerformIO $
  137   ma >>= newIORef >>= flip sharedCAF get_or_set