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@well-typed.com>

2 files changed, 20 insertions, 21 deletions

diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index c35b1273cd..01dc3b7275 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 a3f8e3b966..6bcdbb09a2 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}