[commit: ghc] master: Nuke {save, restore}StaticFlagGlobals. (16c4011)

[git at git.haskell.org]

Repository : ssh://git at git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/16c401137a0d2aa803a5806493889056538c2de4/ghc

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

commit 16c401137a0d2aa803a5806493889056538c2de4
Author: Austin Seipp <austin at well-typed.com>
Date:   Wed Oct 9 10:47:06 2013 -0500

    Nuke {save,restore}StaticFlagGlobals.
    
    As discussed in #8276, this code was somewhat broken because while you
    could always revert the actual argument list, you can never revert the
    CAFs upon which they are based - so really this didn't buy you much.
    
    However, Haddock in particular expects to be able to parse GHC flags,
    including static flags, and used this code to do so. In its place, we
    instead have discardStaticFlags, which will safely remove any of the
    remaining 5 flags from a list of arguments. Haddock instead discards
    these, as they aren't related to anything it does anyway (mostly
    controlling debugging output and some basic optimizer phases.)
    
    This fixes #8276. In the future, we will eventually completely remove
    the remaining StaticFlags, removing the need for this fix. Unfortunately
    these changes will be quite invasive and require more time.
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>


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

16c401137a0d2aa803a5806493889056538c2de4
 compiler/main/StaticFlags.hs     |   31 ++++++++++++++++---------------
 compiler/simplCore/CoreMonad.lhs |   10 ++++------
 2 files changed, 20 insertions(+), 21 deletions(-)

diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index c35b127..01dc3b7 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -18,6 +18,7 @@ module StaticFlags (
 
         staticFlags,
         initStaticOpts,
+        discardStaticFlags,
 
         -- Output style options
         opt_PprStyle_Debug,
@@ -31,9 +32,6 @@ module StaticFlags (
         -- For the parser
         addOpt, removeOpt, v_opt_C_ready,
 
-        -- Saving/restoring globals
-        saveStaticFlagGlobals, restoreStaticFlagGlobals,
-
         -- For options autocompletion
         flagsStatic, flagsStaticNames
   ) where
@@ -145,6 +143,21 @@ flagsStaticNames = [
     "fcpr-off"
     ]
 
+-- We specifically need to discard static flags for clients of the
+-- GHC API, since they can't be safely reparsed or reinitialized. In general,
+-- the existing flags do nothing other than control debugging and some low-level
+-- optimizer phases, so for the most part this is OK.
+--
+-- See GHC issue #8267: http://ghc.haskell.org/trac/ghc/ticket/8276#comment:37
+discardStaticFlags :: [String] -> [String]
+discardStaticFlags = filter (\x -> x `notElem` flags)
+  where flags = [ "-fno-state-hack"
+                , "-fno-opt-coercion"
+                , "-fcpr-off"
+                , "-dppr-debug"
+                , "-dno-debug-output"
+                ]
+
 
 initStaticOpts :: IO ()
 initStaticOpts = writeIORef v_opt_C_ready True
@@ -189,18 +202,6 @@ opt_CprOff         = lookUp  (fsLit "-fcpr-off")
 opt_NoOptCoercion  :: Bool
 opt_NoOptCoercion  = lookUp  (fsLit "-fno-opt-coercion")
 
------------------------------------------------------------------------------
--- Tunneling our global variables into a new instance of the GHC library
-
-saveStaticFlagGlobals :: IO (Bool, [String])
-saveStaticFlagGlobals = liftM2 (,) (readIORef v_opt_C_ready) (readIORef v_opt_C)
-
-restoreStaticFlagGlobals :: (Bool, [String]) -> IO ()
-restoreStaticFlagGlobals (c_ready, c) = do
-    writeIORef v_opt_C_ready c_ready
-    writeIORef v_opt_C c
-
-
 {-
 -- (lookup_str "foo") looks for the flag -foo=X or -fooX,
 -- and returns the string X
diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index a3f8e3b..6bcdbb0 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -777,11 +777,10 @@ data CoreReader = CoreReader {
         cr_hsc_env :: HscEnv,
         cr_rule_base :: RuleBase,
         cr_module :: Module,
-        cr_globals :: ((Bool, [String]),
 #ifdef GHCI
-                       (MVar PersistentLinkerState, Bool))
+        cr_globals :: (MVar PersistentLinkerState, Bool)
 #else
-                       ())
+        cr_globals :: ()
 #endif
 }
 
@@ -854,7 +853,7 @@ runCoreM :: HscEnv
          -> CoreM a
          -> IO (a, SimplCount)
 runCoreM hsc_env rule_base us mod m = do
-        glbls <- liftM2 (,) saveStaticFlagGlobals saveLinkerGlobals
+        glbls <- saveLinkerGlobals
         liftM extract $ runIOEnv (reader glbls) $ unCoreM m state
   where
     reader glbls = CoreReader {
@@ -997,10 +996,9 @@ argument to the plugin function so that we can turn this function into
 \begin{code}
 reinitializeGlobals :: CoreM ()
 reinitializeGlobals = do
-    (sf_globals, linker_globals) <- read cr_globals
+    linker_globals <- read cr_globals
     hsc_env <- getHscEnv
     let dflags = hsc_dflags hsc_env
-    liftIO $ restoreStaticFlagGlobals sf_globals
     liftIO $ restoreLinkerGlobals linker_globals
     liftIO $ setUnsafeGlobalDynFlags dflags
 \end{code}