diff options
Diffstat (limited to 'compiler/utils/Util.hs')
| -rw-r--r-- | compiler/utils/Util.hs | 34 |
1 files changed, 34 insertions, 0 deletions
diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs index 3104c747a1..88b5090f0a 100644 --- a/compiler/utils/Util.hs +++ b/compiler/utils/Util.hs @@ -104,6 +104,7 @@ module Util ( hSetTranslit, global, consIORef, globalM, + sharedGlobal, sharedGlobalM, -- * Filenames and paths Suffix, @@ -144,6 +145,7 @@ import qualified GHC.Stack import Control.Applicative ( liftA2 ) import Control.Monad ( liftM ) import GHC.IO.Encoding (mkTextEncoding, textEncodingName) +import GHC.Conc.Sync ( sharedCAF ) import System.IO (Handle, hGetEncoding, hSetEncoding) import System.IO.Error as IO ( isDoesNotExistError ) import System.Directory ( doesDirectoryExist, getModificationTime ) @@ -930,6 +932,28 @@ seqList :: [a] -> b -> b seqList [] b = b seqList (x:xs) b = x `seq` seqList xs b + +{- +************************************************************************ +* * + 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 @@ -942,6 +966,16 @@ consIORef var x = do globalM :: IO a -> IORef a globalM ma = unsafePerformIO (ma >>= newIORef) +-- Shared global variables: + +sharedGlobal :: a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a +sharedGlobal a get_or_set = unsafePerformIO $ + newIORef a >>= flip sharedCAF get_or_set + +sharedGlobalM :: IO a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a +sharedGlobalM ma get_or_set = unsafePerformIO $ + ma >>= newIORef >>= flip sharedCAF get_or_set + -- Module names: looksLikeModuleName :: String -> Bool |