Commit 163de258 authored by nfrisby's avatar nfrisby

include FastString.string_table in CoreMonad.reinitializeGlobals

parent a5b7ee5f
...@@ -722,11 +722,12 @@ data CoreReader = CoreReader { ...@@ -722,11 +722,12 @@ data CoreReader = CoreReader {
cr_hsc_env :: HscEnv, cr_hsc_env :: HscEnv,
cr_rule_base :: RuleBase, cr_rule_base :: RuleBase,
cr_module :: Module, cr_module :: Module,
cr_globals :: ((Bool, [String]), cr_globals :: (,,) (Bool, [String]) -- from StaticFlags
FastStringTable -- from FastString
#ifdef GHCI #ifdef GHCI
(MVar PersistentLinkerState, Bool)) (MVar PersistentLinkerState, Bool) -- from Linker
#else #else
()) ()
#endif #endif
} }
...@@ -789,7 +790,7 @@ runCoreM :: HscEnv ...@@ -789,7 +790,7 @@ runCoreM :: HscEnv
-> CoreM a -> CoreM a
-> IO (a, SimplCount) -> IO (a, SimplCount)
runCoreM hsc_env rule_base us mod m = do runCoreM hsc_env rule_base us mod m = do
glbls <- liftM2 (,) saveStaticFlagGlobals saveLinkerGlobals glbls <- liftM3 (,,) saveStaticFlagGlobals saveFSTable saveLinkerGlobals
liftM extract $ runIOEnv (reader glbls) $ unCoreM m state liftM extract $ runIOEnv (reader glbls) $ unCoreM m state
where where
reader glbls = CoreReader { reader glbls = CoreReader {
...@@ -891,6 +892,8 @@ getOrigNameCache = do ...@@ -891,6 +892,8 @@ getOrigNameCache = do
%* * %* *
%************************************************************************ %************************************************************************
Note [Initializing globals]
This is a rather annoying function. When a plugin is loaded, it currently This is a rather annoying function. When a plugin is loaded, it currently
gets linked against a *newly loaded* copy of the GHC package. This would 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 not be a problem, except that the new copy has its own mutable state
...@@ -921,13 +924,36 @@ I've threaded the cr_globals through CoreM rather than giving them as an ...@@ -921,13 +924,36 @@ I've threaded the cr_globals through CoreM rather than giving them as an
argument to the plugin function so that we can turn this function into argument to the plugin function so that we can turn this function into
(return ()) without breaking any plugins when we eventually get 1. working. (return ()) without breaking any plugins when we eventually get 1. working.
-----
We include the FastString table in this mechanism, because we'd like
FastStrings created by the plugin to have the same uniques as similar strings
created by the host compiler itself. For example, this allows plugins to
lookup known names (eg `mkTcOcc "MySpecialType"`) in the GlobalRdrEnv or even
re-invoke the parser.
In particular, the following little sanity test was failing in a plugin
prototyping safe newtype-coercions.
let rdrName = mkModuleName "GHC.NT.Type" `mkRdrQual` mkTcOcc "NT"
putMsgS $ showSDoc dflags $ ppr $ lookupGRE_RdrName rdrName $ mg_rdr_env guts
`mkTcOcc` involves the lookup (or creation) of a FastString. Since the
plugin's FastString.string_table is empty, constructing the RdrName also
allocates new uniques for the FastStrings "GHC.NT.Type" and "NT". These
uniques are almost certainly unequal to the ones that the host compiler
originally assigned to those FastStrings. Thus the lookup fails since the
domain of the GlobalRdrEnv is affected by the RdrName's OccName's FastString's
unique.
\begin{code} \begin{code}
reinitializeGlobals :: CoreM () reinitializeGlobals :: CoreM ()
reinitializeGlobals = do reinitializeGlobals = do
(sf_globals, linker_globals) <- read cr_globals (sf_globals, fs_table, linker_globals) <- read cr_globals
hsc_env <- getHscEnv hsc_env <- getHscEnv
let dflags = hsc_dflags hsc_env let dflags = hsc_dflags hsc_env
liftIO $ restoreStaticFlagGlobals sf_globals liftIO $ restoreStaticFlagGlobals sf_globals
liftIO $ restoreFSTable fs_table
liftIO $ restoreLinkerGlobals linker_globals liftIO $ restoreLinkerGlobals linker_globals
liftIO $ setUnsafeGlobalDynFlags dflags liftIO $ setUnsafeGlobalDynFlags dflags
\end{code} \end{code}
......
...@@ -91,7 +91,10 @@ module FastString ...@@ -91,7 +91,10 @@ module FastString
unpackLitString, unpackLitString,
-- ** Operations -- ** Operations
lengthLS lengthLS,
-- * Saving/restoring globals
saveFSTable, restoreFSTable, FastStringTable
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -573,4 +576,14 @@ fsLit x = mkFastString x ...@@ -573,4 +576,14 @@ fsLit x = mkFastString x
forall x . sLit (unpackCString# x) = mkLitString# x #-} forall x . sLit (unpackCString# x) = mkLitString# x #-}
{-# RULES "fslit" {-# RULES "fslit"
forall x . fsLit (unpackCString# x) = mkFastString# x #-} forall x . fsLit (unpackCString# x) = mkFastString# x #-}
--------------------
-- for plugins; see Note [Initializing globals] in CoreMonad
saveFSTable :: IO FastStringTable
saveFSTable = readIORef string_table
restoreFSTable :: FastStringTable -> IO ()
restoreFSTable = writeIORef string_table
\end{code} \end{code}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment