summaryrefslogtreecommitdiff
path: root/compiler/GHC/Settings/IO.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Settings/IO.hs')
-rw-r--r--compiler/GHC/Settings/IO.hs251
1 files changed, 251 insertions, 0 deletions
diff --git a/compiler/GHC/Settings/IO.hs b/compiler/GHC/Settings/IO.hs
new file mode 100644
index 0000000000..bc15564543
--- /dev/null
+++ b/compiler/GHC/Settings/IO.hs
@@ -0,0 +1,251 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module GHC.Settings.IO
+ ( SettingsError (..)
+ , initSettings
+ ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Settings.Platform
+import GHC.Settings.Utils
+
+import Config
+import CliOption
+import Fingerprint
+import GHC.Platform
+import Outputable
+import GHC.Settings
+import GHC.SysTools.BaseDir
+
+import Control.Monad.Trans.Except
+import Control.Monad.IO.Class
+import qualified Data.Map as Map
+import System.FilePath
+import System.Directory
+
+data SettingsError
+ = SettingsError_MissingData String
+ | SettingsError_BadData String
+
+initSettings
+ :: forall m
+ . MonadIO m
+ => String -- ^ TopDir path
+ -> ExceptT SettingsError m Settings
+initSettings 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 <- liftIO $ 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"
+
+ readFileSafe :: FilePath -> ExceptT SettingsError m String
+ readFileSafe path = liftIO (doesFileExist path) >>= \case
+ True -> liftIO $ readFile path
+ False -> throwE $ SettingsError_MissingData $ "Missing file: " ++ path
+
+ settingsStr <- readFileSafe settingsFile
+ platformConstantsStr <- readFileSafe platformConstantsFile
+ settingsList <- case maybeReadFuzzy settingsStr of
+ Just s -> pure s
+ Nothing -> throwE $ SettingsError_BadData $
+ "Can't parse " ++ show settingsFile
+ let mySettings = Map.fromList settingsList
+ platformConstants <- case maybeReadFuzzy platformConstantsStr of
+ Just s -> pure s
+ Nothing -> throwE $ SettingsError_BadData $
+ "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 -> ExceptT SettingsError m String
+ getToolSetting key = expandToolDir mtool_dir <$> getSetting key
+ getBooleanSetting :: String -> ExceptT SettingsError m 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 globalpkgdb_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"
+
+ -- TODO this side-effect doesn't belong here. Reading and parsing the settings
+ -- should be idempotent and accumulate no resources.
+ tmpdir <- liftIO $ 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_globalPackageDatabase = globalpkgdb_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
+ }