Rename "extra-gcc-opts" to "settings", and start generalising it

4 files changed, 71 insertions, 41 deletions

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 9dd9cc7b65..c23f674763 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1028,7 +1028,7 @@ runPhase cc_phase input_fn dflags
                               (cmdline_include_paths ++ pkg_include_dirs)
 
         let md_c_flags = machdepCCOpts dflags
-        gcc_extra_viac_flags <- io $ getExtraViaCOpts dflags
+        let gcc_extra_viac_flags = extraGccViaCFlags dflags
         let pic_c_flags = picCCOpts dflags
 
         let verbFlags = getVerbFlags dflags
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index fa051957f6..ed4f5ff0ca 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -61,7 +61,6 @@ module DynFlags (
         getStgToDo,
 
         -- * Compiler configuration suitable for display to the user
-        Printable(..),
         compilerInfo
 #ifdef GHCI
 -- Only in stage 2 can we be sure that the RTS 
@@ -484,10 +483,12 @@ data DynFlags = DynFlags {
 
   --  Package flags
   extraPkgConfs         :: [FilePath],
-  topDir                :: FilePath,    -- filled in by SysTools
-  systemPackageConfig   :: FilePath,    -- ditto
         -- ^ The @-package-conf@ flags given on the command line, in the order
         -- they appeared.
+  topDir                :: FilePath,           -- filled in by SysTools
+  settings              :: [(String, String)], -- filled in by SysTools
+  extraGccViaCFlags     :: [String],           -- filled in by SysTools
+  systemPackageConfig   :: FilePath,           -- filled in by SysTools
 
   packageFlags          :: [PackageFlag],
         -- ^ The @-package@ and @-hide-package@ flags from the command-line
@@ -724,6 +725,8 @@ defaultDynFlags =
         ghcUsagePath            = panic "defaultDynFlags: No ghciUsagePath",
         ghciUsagePath           = panic "defaultDynFlags: No ghciUsagePath",
         topDir                  = panic "defaultDynFlags: No topDir",
+        settings                = panic "defaultDynFlags: No settings",
+        extraGccViaCFlags       = panic "defaultDynFlags: No extraGccViaCFlags",
         systemPackageConfig     = panic  "no systemPackageConfig: call GHC.setSessionDynFlags",
         pgm_L                   = panic "defaultDynFlags: No pgm_L",
         pgm_P                   = panic "defaultDynFlags: No pgm_P",
@@ -2140,11 +2143,10 @@ setOptHpcDir arg  = upd $ \ d -> d{hpcDir = arg}
 -- There are some options that we need to pass to gcc when compiling
 -- Haskell code via C, but are only supported by recent versions of
 -- gcc.  The configure script decides which of these options we need,
--- and puts them in the file "extra-gcc-opts" in $topdir, which is
--- read before each via-C compilation.  The advantage of having these
--- in a separate file is that the file can be created at install-time
--- depending on the available gcc version, and even re-generated  later
--- if gcc is upgraded.
+-- and puts them in the "settings" file in $topdir. The advantage of
+-- having these in a separate file is that the file can be created at
+-- install-time depending on the available gcc version, and even
+-- re-generated later if gcc is upgraded.
 --
 -- The options below are not dependent on the version of gcc, only the
 -- platform.
@@ -2222,30 +2224,35 @@ can_split = cSupportsSplitObjs == "YES"
 -- -----------------------------------------------------------------------------
 -- Compiler Info
 
-data Printable = String String
-               | FromDynFlags (DynFlags -> String)
-
-compilerInfo :: [(String, Printable)]
-compilerInfo = [("Project name",                String cProjectName),
-                ("Project version",             String cProjectVersion),
-                ("Booter version",              String cBooterVersion),
-                ("Stage",                       String cStage),
-                ("Build platform",              String cBuildPlatformString),
-                ("Host platform",               String cHostPlatformString),
-                ("Target platform",             String cTargetPlatformString),
-                ("Have interpreter",            String cGhcWithInterpreter),
-                ("Object splitting supported",  String cSupportsSplitObjs),
-                ("Have native code generator",  String cGhcWithNativeCodeGen),
-                ("Support SMP",                 String cGhcWithSMP),
-                ("Unregisterised",              String cGhcUnregisterised),
-                ("Tables next to code",         String cGhcEnableTablesNextToCode),
-                ("RTS ways",                    String cGhcRTSWays),
-                ("Leading underscore",          String cLeadingUnderscore),
-                ("Debug on",                    String (show debugIsOn)),
-                ("LibDir",                      FromDynFlags topDir),
-                ("Global Package DB",           FromDynFlags systemPackageConfig),
-                ("C compiler flags",            String (show cCcOpts)),
-                ("Gcc Linker flags",            String (show cGccLinkerOpts)),
-                ("Ld Linker flags",             String (show cLdLinkerOpts))
-               ]
+compilerInfo :: DynFlags -> [(String, String)]
+compilerInfo dflags
+    = -- We always make "Project name" be first to keep parsing in
+      -- other languages simple, i.e. when looking for other fields,
+      -- you don't have to worry whether there is a leading '[' or not
+      ("Project name",                 cProjectName)
+      -- Next come the settings, so anything else can be overridden
+      -- in the settings file (as "lookup" uses the first match for the
+      -- key)
+    : settings dflags
+   ++ [("Project version",             cProjectVersion),
+       ("Booter version",              cBooterVersion),
+       ("Stage",                       cStage),
+       ("Build platform",              cBuildPlatformString),
+       ("Host platform",               cHostPlatformString),
+       ("Target platform",             cTargetPlatformString),
+       ("Have interpreter",            cGhcWithInterpreter),
+       ("Object splitting supported",  cSupportsSplitObjs),
+       ("Have native code generator",  cGhcWithNativeCodeGen),
+       ("Support SMP",                 cGhcWithSMP),
+       ("Unregisterised",              cGhcUnregisterised),
+       ("Tables next to code",         cGhcEnableTablesNextToCode),
+       ("RTS ways",                    cGhcRTSWays),
+       ("Leading underscore",          cLeadingUnderscore),
+       ("Debug on",                    show debugIsOn),
+       ("LibDir",                      topDir dflags),
+       ("Global Package DB",           systemPackageConfig dflags),
+       ("C compiler flags",            show cCcOpts),
+       ("Gcc Linker flags",            show cGccLinkerOpts),
+       ("Ld Linker flags",             show cLdLinkerOpts)
+      ]
 
diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index 5c64a34650..9bc26cfddb 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -26,7 +26,6 @@ module SysTools (
         touch,                  -- String -> String -> IO ()
         copy,
         copyWithHeader,
-        getExtraViaCOpts,
 
         -- Temporary-file management
         setTmpDir,
@@ -162,6 +161,19 @@ initSysTools mbMinusB dflags0
                 -- NB: top_dir is assumed to be in standard Unix
                 -- format, '/' separated
 
+        ; let settingsFile = top_dir </> "settings"
+        ; settingsStr <- readFile settingsFile
+        ; mySettings <- case maybeReadFuzzy settingsStr of
+                        Just s ->
+                            return s
+                        Nothing ->
+                            pgmError ("Can't parse " ++ show settingsFile)
+        ; let getSetting key = case lookup key mySettings of
+                               Just xs ->
+                                   return xs
+                               Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
+        ; myExtraGccViaCFlags <- getSetting "GCC extra via C opts"
+
         ; let installed :: FilePath -> FilePath
               installed file = top_dir </> file
               installed_mingw_bin file = top_dir </> ".." </> "mingw" </> "bin" </> file
@@ -229,6 +241,8 @@ initSysTools mbMinusB dflags0
                         ghcUsagePath = ghc_usage_msg_path,
                         ghciUsagePath = ghci_usage_msg_path,
                         topDir  = top_dir,
+                        settings = mySettings,
+                        extraGccViaCFlags = words myExtraGccViaCFlags,
                         systemPackageConfig = pkgconfig_path,
                         pgm_L   = unlit_path,
                         pgm_P   = cpp_path,
@@ -448,11 +462,6 @@ copyWithHeader dflags purpose maybe_header from to = do
   hClose hout
   hClose hin
 
-getExtraViaCOpts :: DynFlags -> IO [String]
-getExtraViaCOpts dflags = do
-  f <- readFile (topDir dflags </> "extra-gcc-opts")
-  return (words f)
-
 -- | read the contents of the named section in an ELF object as a
 -- String.
 readElfSection :: DynFlags -> String -> FilePath -> IO (Maybe String)
diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 0e46889ec5..dc4f32ec5e 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -66,6 +66,9 @@ module Util (
         -- * Floating point
         readRational,
 
+        -- * read helpers
+        maybeReadFuzzy,
+
         -- * IO-ish utilities
         createDirectoryHierarchy,
         doesDirNameExist,
@@ -966,6 +969,17 @@ readRational top_s
 
 
 -----------------------------------------------------------------------------
+-- read helpers
+
+maybeReadFuzzy :: Read a => String -> Maybe a
+maybeReadFuzzy str = case reads str of
+                     [(x, s)]
+                      | all isSpace s ->
+                         Just x
+                     _ ->
+                         Nothing
+
+-----------------------------------------------------------------------------
 -- Create a hierarchy of directories
 
 createDirectoryHierarchy :: FilePath -> IO ()