diff options
| author | Nicolas Frisby <nicolas.frisby@gmail.com> | 2013-07-04 19:26:03 -0500 |
|---|---|---|
| committer | Nicolas Frisby <nicolas.frisby@gmail.com> | 2013-07-04 20:33:36 -0500 |
| commit | 279ac9f66a83203448b279ea478b2cc1dafbd35d (patch) | |
| tree | cadc018a0028387f2efacfdfedc3c34715dba9f2 /compiler/simplCore | |
| parent | 163de25813d12764aa5ded1666af7c06fee0d67e (diff) | |
| download | haskell-279ac9f66a83203448b279ea478b2cc1dafbd35d.tar.gz | |
copy the plugin's FastStringTable changes back into the host compiler
Diffstat (limited to 'compiler/simplCore')
| -rw-r--r-- | compiler/simplCore/CoreMonad.lhs | 13 | ||||
| -rw-r--r-- | compiler/simplCore/SimplCore.lhs | 4 |
2 files changed, 14 insertions, 3 deletions
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) |