[commit: ghc] master: include FastString.string_table in CoreMonad.reinitializeGlobals (163de25)

[Nicolas Frisby]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

https://github.com/ghc/ghc/commit/163de25813d12764aa5ded1666af7c06fee0d67e

>---------------------------------------------------------------

commit 163de25813d12764aa5ded1666af7c06fee0d67e
Author: Nicolas Frisby <nicolas.frisby at gmail.com>
Date:   Wed Jul 3 18:23:54 2013 -0500

    include FastString.string_table in CoreMonad.reinitializeGlobals

>---------------------------------------------------------------

 compiler/simplCore/CoreMonad.lhs | 36 +++++++++++++++++++++++++++++++-----
 compiler/utils/FastString.lhs    | 15 ++++++++++++++-
 2 files changed, 45 insertions(+), 6 deletions(-)

diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index e11c139..7fe5554 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -722,11 +722,12 @@ data CoreReader = CoreReader {
         cr_hsc_env :: HscEnv,
         cr_rule_base :: RuleBase,
         cr_module :: Module,
-        cr_globals :: ((Bool, [String]),
+        cr_globals :: (,,)    (Bool, [String]) -- from StaticFlags
+                              FastStringTable  -- from FastString
 #ifdef GHCI
-                       (MVar PersistentLinkerState, Bool))
+                              (MVar PersistentLinkerState, Bool) -- from Linker
 #else
-                       ())
+                              ()
 #endif
 }
 
@@ -789,7 +790,7 @@ runCoreM :: HscEnv
          -> CoreM a
          -> IO (a, SimplCount)
 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
   where
     reader glbls = CoreReader {
@@ -891,6 +892,8 @@ getOrigNameCache = do
 %*									*
 %************************************************************************
 
+Note [Initializing globals]
+
 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
 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
 argument to the plugin function so that we can turn this function into
 (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}
 reinitializeGlobals :: CoreM ()
 reinitializeGlobals = do
-    (sf_globals, linker_globals) <- read cr_globals
+    (sf_globals, fs_table, linker_globals) <- read cr_globals
     hsc_env <- getHscEnv
     let dflags = hsc_dflags hsc_env
     liftIO $ restoreStaticFlagGlobals sf_globals
+    liftIO $ restoreFSTable fs_table
     liftIO $ restoreLinkerGlobals linker_globals
     liftIO $ setUnsafeGlobalDynFlags dflags
 \end{code}
diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index 36b1b1e..0bdf0a0 100644
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -91,7 +91,10 @@ module FastString
         unpackLitString,
         
         -- ** Operations
-        lengthLS
+        lengthLS,
+
+        -- * Saving/restoring globals
+        saveFSTable, restoreFSTable, FastStringTable
        ) where
 
 #include "HsVersions.h"
@@ -573,4 +576,14 @@ fsLit x = mkFastString x
     forall x . sLit  (unpackCString# x) = mkLitString#  x #-}
 {-# RULES "fslit"
     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}