From 279ac9f66a83203448b279ea478b2cc1dafbd35d Mon Sep 17 00:00:00 2001
From: Nicolas Frisby <nicolas.frisby@gmail.com>
Date: Thu, 4 Jul 2013 19:26:03 -0500
Subject: copy the plugin's FastStringTable changes back into the host compiler

---
 compiler/simplCore/CoreMonad.lhs | 13 ++++++++++++-
 compiler/simplCore/SimplCore.lhs |  4 ++--
 2 files changed, 14 insertions(+), 3 deletions(-)

(limited to 'compiler/simplCore')

diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index 7fe5554f94..2aa42cc9ad 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -44,7 +44,7 @@ module CoreMonad (
     liftIO1, liftIO2, liftIO3, liftIO4,
     
     -- ** Global initialization
-    reinitializeGlobals,
+    reinitializeGlobals, bracketGlobals,
     
     -- ** Dealing with annotations
     getAnnotations, getFirstAnnotations,
@@ -947,6 +947,7 @@ domain of the GlobalRdrEnv is affected by the RdrName's OccName's FastString's
 unique.
 
 \begin{code}
+-- called by plugin
 reinitializeGlobals :: CoreM ()
 reinitializeGlobals = do
     (sf_globals, fs_table, linker_globals) <- read cr_globals
@@ -956,6 +957,16 @@ reinitializeGlobals = do
     liftIO $ restoreFSTable fs_table
     liftIO $ restoreLinkerGlobals linker_globals
     liftIO $ setUnsafeGlobalDynFlags dflags
+
+-- called by host compiler, assuming argument is code from a plugin
+bracketGlobals :: CoreM a -> CoreM a
+bracketGlobals (CoreM f) = do
+  tbl <- liftIO saveFSTable
+  let upd e = e {cr_globals=(x,tbl,z)}
+        where (x,_,z) = cr_globals e
+  x <- CoreM (\s -> updEnv upd (f s))
+  liftIO unsaveFSTable
+  return x
 \end{code}
 
 %************************************************************************
diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index 62e167a79e..9c67be95cb 100644
--- a/compiler/simplCore/SimplCore.lhs
+++ b/compiler/simplCore/SimplCore.lhs
@@ -311,7 +311,7 @@ addPluginPasses dflags builtin_passes
        ; foldM query_plug builtin_passes named_plugins }
   where
     query_plug todos (mod_nm, plug)
-       = installCoreToDos plug options todos
+       = bracketGlobals $ installCoreToDos plug options todos
        where
          options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags
                             , opt_mod_nm == mod_nm ]
@@ -407,7 +407,7 @@ doCorePass _      CoreDoNothing                = return
 doCorePass _      (CoreDoPasses passes)        = runCorePasses passes
 
 #ifdef GHCI
-doCorePass _      (CoreDoPluginPass _ pass) = {-# SCC "Plugin" #-} pass
+doCorePass _      (CoreDoPluginPass _ pass) = {-# SCC "Plugin" #-} (bracketGlobals . pass)
 #endif
 
 doCorePass _      pass = pprPanic "doCorePass" (ppr pass)
-- 
cgit v1.2.1