Pull out the settings file parsing code into it's own module.

This has two benefits:

1. One less hunk of code dependent on DynFlags

2. Add a little bit of error granularity to distrinugish between missing
   data and bad data. This could someday be shared with ghc-pkg which
   aims to work even with a missing file. I also am about to to make
   --supported-extensions use this too.

1 files changed, 8 insertions, 214 deletions

diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index bfaa6562cc..fa339bbb87 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -44,22 +44,19 @@ import GHC.Settings
 
 import Module
 import Packages
-import Config
 import Outputable
 import ErrUtils
 import GHC.Platform
 import DynFlags
-import Fingerprint
-import ToolSettings
 
-import qualified Data.Map as Map
+import Control.Monad.Trans.Except (runExceptT)
 import System.FilePath
 import System.IO
-import System.Directory
 import SysTools.ExtraObj
 import SysTools.Info
 import SysTools.Tasks
 import SysTools.BaseDir
+import SysTools.Settings
 
 {-
 Note [How GHC finds toolchain utilities]
@@ -137,215 +134,12 @@ initSysTools :: String          -- TopDir path
                                 --      (a) the system programs
                                 --      (b) the package-config file
                                 --      (c) the GHC usage message
-initSysTools top_dir
-  = do       -- see Note [topdir: How GHC finds its files]
-             -- NB: top_dir is assumed to be in standard Unix
-             -- format, '/' separated
-       mtool_dir <- findToolDir top_dir
-             -- see Note [tooldir: How GHC finds mingw on Windows]
-
-       let installed :: FilePath -> FilePath
-           installed file = top_dir </> file
-           libexec :: FilePath -> FilePath
-           libexec file = top_dir </> "bin" </> file
-           settingsFile = installed "settings"
-           platformConstantsFile = installed "platformConstants"
-
-       settingsStr <- readFile settingsFile
-       platformConstantsStr <- readFile platformConstantsFile
-       settingsList <- case maybeReadFuzzy settingsStr of
-                     Just s ->
-                         return s
-                     Nothing ->
-                         pgmError ("Can't parse " ++ show settingsFile)
-       let mySettings = Map.fromList settingsList
-       platformConstants <- case maybeReadFuzzy platformConstantsStr of
-                            Just s ->
-                                return s
-                            Nothing ->
-                                pgmError ("Can't parse " ++
-                                          show platformConstantsFile)
-       -- See Note [Settings file] for a little more about this file. We're
-       -- just partially applying those functions and throwing 'Left's; they're
-       -- written in a very portable style to keep ghc-boot light.
-       let getSetting key = either pgmError pure $
-             getFilePathSetting0 top_dir settingsFile mySettings key
-           getToolSetting :: String -> IO String
-           getToolSetting key = expandToolDir mtool_dir <$> getSetting key
-           getBooleanSetting :: String -> IO Bool
-           getBooleanSetting key = either pgmError pure $
-             getBooleanSetting0 settingsFile mySettings key
-       targetPlatformString <- getSetting "target platform string"
-       tablesNextToCode <- getBooleanSetting "Tables next to code"
-       myExtraGccViaCFlags <- getSetting "GCC extra via C opts"
-       -- On Windows, mingw is distributed with GHC,
-       -- so we look in TopDir/../mingw/bin,
-       -- as well as TopDir/../../mingw/bin for hadrian.
-       -- It would perhaps be nice to be able to override this
-       -- with the settings file, but it would be a little fiddly
-       -- to make that possible, so for now you can't.
-       cc_prog <- getToolSetting "C compiler command"
-       cc_args_str <- getSetting "C compiler flags"
-       cxx_args_str <- getSetting "C++ compiler flags"
-       gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie"
-       cpp_prog <- getToolSetting "Haskell CPP command"
-       cpp_args_str <- getSetting "Haskell CPP flags"
-
-       platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings
-
-       let unreg_cc_args = if platformUnregisterised platform
-                           then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"]
-                           else []
-           cpp_args = map Option (words cpp_args_str)
-           cc_args  = words cc_args_str ++ unreg_cc_args
-           cxx_args = words cxx_args_str
-       ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind"
-       ldSupportsBuildId       <- getBooleanSetting "ld supports build-id"
-       ldSupportsFilelist      <- getBooleanSetting "ld supports filelist"
-       ldIsGnuLd               <- getBooleanSetting "ld is GNU ld"
-
-       let pkgconfig_path = installed "package.conf.d"
-           ghc_usage_msg_path  = installed "ghc-usage.txt"
-           ghci_usage_msg_path = installed "ghci-usage.txt"
-
-       -- For all systems, unlit, split, mangle are GHC utilities
-       -- architecture-specific stuff is done when building Config.hs
-       unlit_path <- getToolSetting "unlit command"
-
-       windres_path <- getToolSetting "windres command"
-       libtool_path <- getToolSetting "libtool command"
-       ar_path <- getToolSetting "ar command"
-       ranlib_path <- getToolSetting "ranlib command"
-
-       tmpdir <- getTemporaryDirectory
-
-       touch_path <- getToolSetting "touch command"
-
-       mkdll_prog <- getToolSetting "dllwrap command"
-       let mkdll_args = []
-
-       -- cpp is derived from gcc on all platforms
-       -- HACK, see setPgmP below. We keep 'words' here to remember to fix
-       -- Config.hs one day.
-
-
-       -- Other things being equal, as and ld are simply gcc
-       cc_link_args_str <- getSetting "C compiler link flags"
-       let   as_prog  = cc_prog
-             as_args  = map Option cc_args
-             ld_prog  = cc_prog
-             ld_args  = map Option (cc_args ++ words cc_link_args_str)
-
-       llvmTarget <- getSetting "LLVM target"
-
-       -- We just assume on command line
-       lc_prog <- getSetting "LLVM llc command"
-       lo_prog <- getSetting "LLVM opt command"
-       lcc_prog <- getSetting "LLVM clang command"
-
-       let iserv_prog = libexec "ghc-iserv"
-
-       integerLibrary <- getSetting "integer library"
-       integerLibraryType <- case integerLibrary of
-         "integer-gmp" -> pure IntegerGMP
-         "integer-simple" -> pure IntegerSimple
-         _ -> pgmError $ unwords
-           [ "Entry for"
-           , show "integer library"
-           , "must be one of"
-           , show "integer-gmp"
-           , "or"
-           , show "integer-simple"
-           ]
-
-       ghcWithInterpreter <- getBooleanSetting "Use interpreter"
-       ghcWithNativeCodeGen <- getBooleanSetting "Use native code generator"
-       ghcWithSMP <- getBooleanSetting "Support SMP"
-       ghcRTSWays <- getSetting "RTS ways"
-       leadingUnderscore <- getBooleanSetting "Leading underscore"
-       useLibFFI <- getBooleanSetting "Use LibFFI"
-       ghcThreaded <- getBooleanSetting "Use Threads"
-       ghcDebugged <- getBooleanSetting "Use Debugging"
-       ghcRtsWithLibdw <- getBooleanSetting "RTS expects libdw"
-
-       return $ Settings
-         { sGhcNameVersion = GhcNameVersion
-           { ghcNameVersion_programName = "ghc"
-           , ghcNameVersion_projectVersion = cProjectVersion
-           }
-
-         , sFileSettings = FileSettings
-           { fileSettings_tmpDir         = normalise tmpdir
-           , fileSettings_ghcUsagePath   = ghc_usage_msg_path
-           , fileSettings_ghciUsagePath  = ghci_usage_msg_path
-           , fileSettings_toolDir        = mtool_dir
-           , fileSettings_topDir         = top_dir
-           , fileSettings_systemPackageConfig = pkgconfig_path
-           }
-
-         , sToolSettings = ToolSettings
-           { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind
-           , toolSettings_ldSupportsBuildId       = ldSupportsBuildId
-           , toolSettings_ldSupportsFilelist      = ldSupportsFilelist
-           , toolSettings_ldIsGnuLd               = ldIsGnuLd
-           , toolSettings_ccSupportsNoPie         = gccSupportsNoPie
-
-           , toolSettings_pgm_L   = unlit_path
-           , toolSettings_pgm_P   = (cpp_prog, cpp_args)
-           , toolSettings_pgm_F   = ""
-           , toolSettings_pgm_c   = cc_prog
-           , toolSettings_pgm_a   = (as_prog, as_args)
-           , toolSettings_pgm_l   = (ld_prog, ld_args)
-           , toolSettings_pgm_dll = (mkdll_prog,mkdll_args)
-           , toolSettings_pgm_T   = touch_path
-           , toolSettings_pgm_windres = windres_path
-           , toolSettings_pgm_libtool = libtool_path
-           , toolSettings_pgm_ar = ar_path
-           , toolSettings_pgm_ranlib = ranlib_path
-           , toolSettings_pgm_lo  = (lo_prog,[])
-           , toolSettings_pgm_lc  = (lc_prog,[])
-           , toolSettings_pgm_lcc = (lcc_prog,[])
-           , toolSettings_pgm_i   = iserv_prog
-           , toolSettings_opt_L       = []
-           , toolSettings_opt_P       = []
-           , toolSettings_opt_P_fingerprint = fingerprint0
-           , toolSettings_opt_F       = []
-           , toolSettings_opt_c       = cc_args
-           , toolSettings_opt_cxx     = cxx_args
-           , toolSettings_opt_a       = []
-           , toolSettings_opt_l       = []
-           , toolSettings_opt_windres = []
-           , toolSettings_opt_lcc     = []
-           , toolSettings_opt_lo      = []
-           , toolSettings_opt_lc      = []
-           , toolSettings_opt_i       = []
-
-           , toolSettings_extraGccViaCFlags = words myExtraGccViaCFlags
-           }
-
-         , sTargetPlatform = platform
-         , sPlatformMisc = PlatformMisc
-           { platformMisc_targetPlatformString = targetPlatformString
-           , platformMisc_integerLibrary = integerLibrary
-           , platformMisc_integerLibraryType = integerLibraryType
-           , platformMisc_ghcWithInterpreter = ghcWithInterpreter
-           , platformMisc_ghcWithNativeCodeGen = ghcWithNativeCodeGen
-           , platformMisc_ghcWithSMP = ghcWithSMP
-           , platformMisc_ghcRTSWays = ghcRTSWays
-           , platformMisc_tablesNextToCode = tablesNextToCode
-           , platformMisc_leadingUnderscore = leadingUnderscore
-           , platformMisc_libFFI = useLibFFI
-           , platformMisc_ghcThreaded = ghcThreaded
-           , platformMisc_ghcDebugged = ghcDebugged
-           , platformMisc_ghcRtsWithLibdw = ghcRtsWithLibdw
-           , platformMisc_llvmTarget = llvmTarget
-           }
-
-         , sPlatformConstants = platformConstants
-
-         , sRawSettings    = settingsList
-         }
-
+initSysTools top_dir = do
+  res <- runExceptT $ initSettings top_dir
+  case res of
+    Right a -> pure a
+    Left (SettingsError_MissingData msg) -> pgmError msg
+    Left (SettingsError_BadData msg) -> pgmError msg
 
 {- Note [Windows stack usage]