StaticFlags code cleanup (fixes #7595)

Function responsible for parsing the static flags, that were spread
across two modules (StaticFlags and StaticFlagParser), are now
in one file. This is analogous to dynamic flags parsing, which is
also contained within a single module.

Signed-off-by: David Terei <davidterei@gmail.com>

6 files changed, 201 insertions, 230 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index feadd3d6a8..5160f5a5d8 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -119,6 +119,8 @@ module DynFlags (
         mAX_PTR_TAG,
         tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD,
 
+        unsafeGlobalDynFlags, setUnsafeGlobalDynFlags,
+
         -- * SSE
         isSse2Enabled,
         isSse4_2Enabled,
@@ -136,7 +138,6 @@ import Config
 import CmdLineParser
 import Constants
 import Panic
-import StaticFlags
 import Util
 import Maybes           ( orElse )
 import MonadUtils
@@ -149,9 +150,7 @@ import Foreign.C        ( CInt(..) )
 #endif
 import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessage )
 
-#ifdef GHCI
 import System.IO.Unsafe ( unsafePerformIO )
-#endif
 import Data.IORef
 import Control.Monad
 
@@ -3407,6 +3406,23 @@ makeDynFlagsConsistent dflags
           arch = platformArch platform
           os   = platformOS   platform
 
+--------------------------------------------------------------------------
+-- Do not use unsafeGlobalDynFlags!
+--
+-- unsafeGlobalDynFlags is a hack, necessary because we need to be able
+-- to show SDocs when tracing, but we don't always have DynFlags
+-- available.
+--
+-- Do not use it if you can help it. You may get the wrong value!
+
+GLOBAL_VAR(v_unsafeGlobalDynFlags, panic "v_unsafeGlobalDynFlags: not initialised", DynFlags)
+
+unsafeGlobalDynFlags :: DynFlags
+unsafeGlobalDynFlags = unsafePerformIO $ readIORef v_unsafeGlobalDynFlags
+
+setUnsafeGlobalDynFlags :: DynFlags -> IO ()
+setUnsafeGlobalDynFlags = writeIORef v_unsafeGlobalDynFlags
+
 -- -----------------------------------------------------------------------------
 -- SSE
 
diff --git a/compiler/main/DynFlags.hs-boot b/compiler/main/DynFlags.hs-boot
index 9f22439661..da54e49e66 100644
--- a/compiler/main/DynFlags.hs-boot
+++ b/compiler/main/DynFlags.hs-boot
@@ -5,7 +5,7 @@ import Platform
 
 data DynFlags
 
-targetPlatform :: DynFlags -> Platform
-pprUserLength :: DynFlags -> Int
-pprCols :: DynFlags -> Int
-
+targetPlatform       :: DynFlags -> Platform
+pprUserLength        :: DynFlags -> Int
+pprCols              :: DynFlags -> Int
+unsafeGlobalDynFlags :: DynFlags
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 40e913ee80..35db120849 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -289,8 +289,7 @@ import DriverPhases     ( Phase(..), isHaskellSrcFilename )
 import Finder
 import HscTypes
 import DynFlags
-import StaticFlagParser
-import qualified StaticFlags
+import StaticFlags
 import SysTools
 import Annotations
 import Module
@@ -446,7 +445,7 @@ initGhcMonad mb_top_dir = do
   -- catch ^C
   liftIO $ installSignalHandlers
 
-  liftIO $ StaticFlags.initStaticOpts
+  liftIO $ initStaticOpts
 
   mySettings <- liftIO $ initSysTools mb_top_dir
   dflags <- liftIO $ initDynFlags (defaultDynFlags mySettings)
diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs
deleted file mode 100644
index 76454bdfa5..0000000000
--- a/compiler/main/StaticFlagParser.hs
+++ /dev/null
@@ -1,151 +0,0 @@
------------------------------------------------------------------------------
---
--- Static flags
---
--- Static flags can only be set once, on the command-line.  Inside GHC,
--- each static flag corresponds to a top-level value, usually of type Bool.
---
--- (c) The University of Glasgow 2005
---
------------------------------------------------------------------------------
-
-module StaticFlagParser (
-        parseStaticFlags,
-        parseStaticFlagsFull,
-        flagsStatic
-    ) where
-
-#include "HsVersions.h"
-
-import qualified StaticFlags as SF
-import StaticFlags ( v_opt_C_ready )
-import CmdLineParser
-import SrcLoc
-import Util
-import Panic
-
-import Control.Monad
-import Data.Char
-import Data.IORef
-import Data.List
-
------------------------------------------------------------------------------
--- Static flags
-
--- | Parses GHC's static flags from a list of command line arguments.
---
--- These flags are static in the sense that they can be set only once and they
--- are global, meaning that they affect every instance of GHC running;
--- multiple GHC threads will use the same flags.
---
--- This function must be called before any session is started, i.e., before
--- the first call to 'GHC.withGhc'.
---
--- Static flags are more of a hack and are static for more or less historical
--- reasons.  In the long run, most static flags should eventually become
--- dynamic flags.
---
--- XXX: can we add an auto-generated list of static flags here?
---
-parseStaticFlags :: [Located String] -> IO ([Located String], [Located String])
-parseStaticFlags = parseStaticFlagsFull flagsStatic
-
--- | Parse GHC's static flags as @parseStaticFlags@ does. However it also
--- takes a list of available static flags, such that certain flags can be
--- enabled or disabled through this argument.
-parseStaticFlagsFull :: [Flag IO] -> [Located String]
-                     -> IO ([Located String], [Located String])
-parseStaticFlagsFull flagsAvailable args = do
-  ready <- readIORef v_opt_C_ready
-  when ready $ throwGhcException (ProgramError "Too late for parseStaticFlags: call it before newSession")
-
-  (leftover, errs, warns) <- processArgs flagsAvailable args
-  when (not (null errs)) $ throwGhcException $ errorsToGhcException errs
-
-    -- see sanity code in staticOpts
-  writeIORef v_opt_C_ready True
-
-  return (leftover, warns)
-
-flagsStatic :: [Flag IO]
--- All the static flags should appear in this list.  It describes how each
--- static flag should be processed.  Two main purposes:
--- (a) if a command-line flag doesn't appear in the list, GHC can complain
--- (b) a command-line flag may remove, or add, other flags; e.g. the "-fno-X" things
---
--- The common (PassFlag addOpt) action puts the static flag into the bunch of
--- things that are searched up by the top-level definitions like
---      opt_foo = lookUp (fsLit "-dfoo")
-
--- Note that ordering is important in the following list: any flag which
--- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override
--- flags further down the list with the same prefix.
-
-flagsStatic = [
-        ------ Debugging ----------------------------------------------------
-    Flag "dppr-debug"                  (PassFlag addOpt)
-  , Flag "dno-debug-output"            (PassFlag addOpt)
-      -- rest of the debugging flags are dynamic
-
-        ----- RTS opts ------------------------------------------------------
-  , Flag "H"              (HasArg (\s -> liftEwM (setHeapSize (fromIntegral (decodeSize s)))))
-
-  , Flag "Rghc-timing"    (NoArg (liftEwM enableTimingStats))
-
-        ------ Compiler flags -----------------------------------------------
-
-        -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
-  , Flag "fno-"
-         (PrefixPred (\s -> isStaticFlag ("f"++s)) (\s -> removeOpt ("-f"++s)))
-
-
-        -- Pass all remaining "-f<blah>" options to hsc
-  , Flag "f" (AnySuffixPred isStaticFlag addOpt)
-  ]
-
-isStaticFlag :: String -> Bool
-isStaticFlag f =
-  f `elem` [
-    "fdicts-strict",
-    "fspec-inline-join-points",
-    "fno-hi-version-check",
-    "dno-black-holing",
-    "fno-state-hack",
-    "fruntime-types",
-    "fno-opt-coercion",
-    "fno-flat-cache",
-    "fhardwire-lib-paths",
-    "fcpr-off"
-    ]
-  || any (`isPrefixOf` f) [
-     ]
-
------------------------------------------------------------------------------
--- convert sizes like "3.5M" into integers
-
-decodeSize :: String -> Integer
-decodeSize str
-  | c == ""      = truncate n
-  | c == "K" || c == "k" = truncate (n * 1000)
-  | c == "M" || c == "m" = truncate (n * 1000 * 1000)
-  | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
-  | otherwise            = throwGhcException (CmdLineError ("can't decode size: " ++ str))
-  where (m, c) = span pred str
-        n      = readRational m
-        pred c = isDigit c || c == '.'
-
-
-type StaticP = EwM IO
-
-addOpt :: String -> StaticP ()
-addOpt = liftEwM . SF.addOpt
-
-removeOpt :: String -> StaticP ()
-removeOpt = liftEwM . SF.removeOpt
-
------------------------------------------------------------------------------
--- RTS Hooks
-
-foreign import ccall unsafe "setHeapSize"       setHeapSize       :: Int -> IO ()
-foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()
-
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index 8c514a5af3..76845644e0 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -20,7 +20,8 @@
 -----------------------------------------------------------------------------
 
 module StaticFlags (
-        unsafeGlobalDynFlags, setUnsafeGlobalDynFlags,
+        -- entry point
+        parseStaticFlags,
 
 	staticFlags,
         initStaticOpts,
@@ -38,46 +39,129 @@ module StaticFlags (
 	opt_NoOptCoercion,
         opt_NoFlatCache,
 
-    -- For the parser
-    addOpt, removeOpt, v_opt_C_ready,
+        -- For the parser
+        addOpt, removeOpt, v_opt_C_ready,
 
-    -- Saving/restoring globals
-    saveStaticFlagGlobals, restoreStaticFlagGlobals
+        -- Saving/restoring globals
+        saveStaticFlagGlobals, restoreStaticFlagGlobals
   ) where
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} DynFlags (DynFlags)
-
+import CmdLineParser
 import FastString
+import SrcLoc
 import Util
 -- import Maybes		( firstJusts )
 import Panic
 
 import Control.Monad
+import Data.Char
 import Data.IORef
 import System.IO.Unsafe	( unsafePerformIO )
--- import Data.List
 
---------------------------------------------------------------------------
--- Do not use unsafeGlobalDynFlags!
+
+-----------------------------------------------------------------------------
+-- Static flags
+
+-- | Parses GHC's static flags from a list of command line arguments.
+--
+-- These flags are static in the sense that they can be set only once and they
+-- are global, meaning that they affect every instance of GHC running;
+-- multiple GHC threads will use the same flags.
 --
--- unsafeGlobalDynFlags is a hack, necessary because we need to be able
--- to show SDocs when tracing, but we don't always have DynFlags
--- available.
+-- This function must be called before any session is started, i.e., before
+-- the first call to 'GHC.withGhc'.
 --
--- Do not use it if you can help it. You may get the wrong value!
+-- Static flags are more of a hack and are static for more or less historical
+-- reasons.  In the long run, most static flags should eventually become
+-- dynamic flags.
+--
+-- XXX: can we add an auto-generated list of static flags here?
+--
+parseStaticFlags :: [Located String] -> IO ([Located String], [Located String])
+parseStaticFlags = parseStaticFlagsFull flagsStatic
+
+-- | Parse GHC's static flags as @parseStaticFlags@ does. However it also
+-- takes a list of available static flags, such that certain flags can be
+-- enabled or disabled through this argument.
+parseStaticFlagsFull :: [Flag IO] -> [Located String]
+                     -> IO ([Located String], [Located String])
+parseStaticFlagsFull flagsAvailable args = do
+  ready <- readIORef v_opt_C_ready
+  when ready $ throwGhcException (ProgramError "Too late for parseStaticFlags: call it before newSession")
 
-GLOBAL_VAR(v_unsafeGlobalDynFlags, panic "v_unsafeGlobalDynFlags: not initialised", DynFlags)
+  (leftover, errs, warns) <- processArgs flagsAvailable args
+  when (not (null errs)) $ throwGhcException $ errorsToGhcException errs
 
-unsafeGlobalDynFlags :: DynFlags
-unsafeGlobalDynFlags = unsafePerformIO $ readIORef v_unsafeGlobalDynFlags
+    -- see sanity code in staticOpts
+  writeIORef v_opt_C_ready True
+  return (leftover, warns)
+
+-- holds the static opts while they're being collected, before
+-- being unsafely read by unpacked_static_opts below.
+GLOBAL_VAR(v_opt_C, [], [String])
+GLOBAL_VAR(v_opt_C_ready, False, Bool)
 
-setUnsafeGlobalDynFlags :: DynFlags -> IO ()
-setUnsafeGlobalDynFlags = writeIORef v_unsafeGlobalDynFlags
 
------------------------------------------------------------------------------
--- Static flags
+staticFlags :: [String]
+staticFlags = unsafePerformIO $ do
+  ready <- readIORef v_opt_C_ready
+  if (not ready)
+        then panic "Static flags have not been initialised!\n        Please call GHC.newSession or GHC.parseStaticFlags early enough."
+        else readIORef v_opt_C
+
+-- All the static flags should appear in this list.  It describes how each
+-- static flag should be processed.  Two main purposes:
+-- (a) if a command-line flag doesn't appear in the list, GHC can complain
+-- (b) a command-line flag may remove, or add, other flags; e.g. the "-fno-X" 
+--     things
+--
+-- The common (PassFlag addOpt) action puts the static flag into the bunch of
+-- things that are searched up by the top-level definitions like
+--      opt_foo = lookUp (fsLit "-dfoo")
+
+-- Note that ordering is important in the following list: any flag which
+-- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override
+-- flags further down the list with the same prefix.
+
+flagsStatic :: [Flag IO]
+flagsStatic = [
+  ------ Debugging ----------------------------------------------------
+    Flag "dppr-debug"       (PassFlag addOptEwM)
+  , Flag "dno-debug-output" (PassFlag addOptEwM)
+  -- rest of the debugging flags are dynamic
+
+  ----- RTS opts ------------------------------------------------------
+  , Flag "H"           (HasArg (\s -> liftEwM (setHeapSize (fromIntegral (decodeSize s)))))
+
+  , Flag "Rghc-timing" (NoArg (liftEwM enableTimingStats))
+
+  ------ Compiler flags -----------------------------------------------
+  -- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
+  , Flag "fno-"
+         (PrefixPred (\s -> isStaticFlag ("f"++s)) (\s -> removeOptEwM ("-f"++s)))
+
+  -- Pass all remaining "-f<blah>" options to hsc
+  , Flag "f" (AnySuffixPred isStaticFlag addOptEwM)
+  ]
+
+
+isStaticFlag :: String -> Bool
+isStaticFlag f =
+  f `elem` [
+    "fdicts-strict",
+    "fspec-inline-join-points",
+    "fno-hi-version-check",
+    "dno-black-holing",
+    "fno-state-hack",
+    "fruntime-types",
+    "fno-opt-coercion",
+    "fno-flat-cache",
+    "fhardwire-lib-paths",
+    "fcpr-off"
+    ]
+
 
 initStaticOpts :: IO ()
 initStaticOpts = writeIORef v_opt_C_ready True
@@ -90,24 +174,79 @@ removeOpt f = do
   fs <- readIORef v_opt_C
   writeIORef v_opt_C $! filter (/= f) fs
 
-lookUp	       	 :: FastString -> Bool
+type StaticP = EwM IO
 
--- holds the static opts while they're being collected, before
--- being unsafely read by unpacked_static_opts below.
-GLOBAL_VAR(v_opt_C, [], [String])
-GLOBAL_VAR(v_opt_C_ready, False, Bool)
+addOptEwM :: String -> StaticP ()
+addOptEwM = liftEwM . addOpt
 
-staticFlags :: [String]
-staticFlags = unsafePerformIO $ do
-  ready <- readIORef v_opt_C_ready
-  if (not ready)
-        then panic "Static flags have not been initialised!\n        Please call GHC.newSession or GHC.parseStaticFlags early enough."
-        else readIORef v_opt_C
+removeOptEwM :: String -> StaticP ()
+removeOptEwM = liftEwM . removeOpt
 
 packed_static_opts :: [FastString]
 packed_static_opts   = map mkFastString staticFlags
 
-lookUp     sw = sw `elem` packed_static_opts
+lookUp :: FastString -> Bool
+lookUp sw = sw `elem` packed_static_opts
+
+-- debugging options
+
+opt_PprStyle_Debug :: Bool
+opt_PprStyle_Debug = lookUp  (fsLit "-dppr-debug")
+
+opt_NoDebugOutput  :: Bool
+opt_NoDebugOutput  = lookUp  (fsLit "-dno-debug-output")
+
+-- language opts
+opt_DictsStrict    :: Bool
+opt_DictsStrict	   = lookUp  (fsLit "-fdicts-strict")
+
+opt_NoStateHack    :: Bool
+opt_NoStateHack	   = lookUp  (fsLit "-fno-state-hack")
+
+-- Switch off CPR analysis in the new demand analyser
+opt_CprOff         :: Bool
+opt_CprOff         = lookUp  (fsLit "-fcpr-off")
+
+opt_NoOptCoercion  :: Bool
+opt_NoOptCoercion  = lookUp  (fsLit "-fno-opt-coercion")
+
+opt_NoFlatCache    :: Bool
+opt_NoFlatCache     = lookUp  (fsLit "-fno-flat-cache")
+
+
+-----------------------------------------------------------------------------
+-- Convert sizes like "3.5M" into integers
+
+decodeSize :: String -> Integer
+decodeSize str
+  | c == ""      = truncate n
+  | c == "K" || c == "k" = truncate (n * 1000)
+  | c == "M" || c == "m" = truncate (n * 1000 * 1000)
+  | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
+  | otherwise            = throwGhcException (CmdLineError ("can't decode size: " ++ str))
+  where (m, c) = span pred str
+        n      = readRational m
+        pred c = isDigit c || c == '.'
+
+
+-----------------------------------------------------------------------------
+-- 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
+
+
+-----------------------------------------------------------------------------
+-- RTS Hooks
+
+foreign import ccall unsafe "setHeapSize"       setHeapSize       :: Int -> IO ()
+foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()
+
 
 {-
 -- (lookup_str "foo") looks for the flag -foo=X or -fooX,
@@ -157,39 +296,3 @@ unpacked_opts =
    expandAts l = [l]
 -}
 
--- debugging options
-
-opt_PprStyle_Debug  :: Bool
-opt_PprStyle_Debug              = lookUp  (fsLit "-dppr-debug")
-
-opt_NoDebugOutput   :: Bool
-opt_NoDebugOutput               = lookUp  (fsLit "-dno-debug-output")
-
--- language opts
-opt_DictsStrict :: Bool
-opt_DictsStrict			= lookUp  (fsLit "-fdicts-strict")
-
-opt_NoStateHack :: Bool
-opt_NoStateHack			= lookUp  (fsLit "-fno-state-hack")
-
-opt_CprOff :: Bool
-opt_CprOff			= lookUp  (fsLit "-fcpr-off")
-	-- Switch off CPR analysis in the new demand analyser
-
-opt_NoOptCoercion :: Bool
-opt_NoOptCoercion    	        = lookUp  (fsLit "-fno-opt-coercion")
-
-opt_NoFlatCache :: Bool
-opt_NoFlatCache    	        = lookUp  (fsLit "-fno-flat-cache")
-
------------------------------------------------------------------------------
--- 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
-
diff --git a/compiler/main/StaticFlags.hs-boot b/compiler/main/StaticFlags.hs-boot
new file mode 100644
index 0000000000..53ee13bf15
--- /dev/null
+++ b/compiler/main/StaticFlags.hs-boot
@@ -0,0 +1,4 @@
+module StaticFlags where
+
+opt_PprStyle_Debug :: Bool
+opt_NoDebugOutput  :: Bool