[Git][ghc/ghc][wip/hadrian-windows-bindist] 2 commits: Remove $tooldir support

Matthew Pickering (@mpickering) gitlab at gitlab.haskell.org
Tue Aug 15 11:17:56 UTC 2023



Matthew Pickering pushed to branch wip/hadrian-windows-bindist at Glasgow Haskell Compiler / GHC


Commits:
f150089f by Matthew Pickering at 2023-08-15T12:05:30+01:00
Remove $tooldir support

- - - - -
f08bd58f by Matthew Pickering at 2023-08-15T12:17:44+01:00
fixes

- - - - -


11 changed files:

- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Settings.hs
- compiler/GHC/Settings/IO.hs
- compiler/GHC/SysTools/BaseDir.hs
- distrib/configure.ac.in
- hadrian/bindist/Makefile
- hadrian/bindist/config.mk.in
- hadrian/cfg/system.config.in
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Rules/Generate.hs


Changes:

=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -56,7 +56,7 @@ module GHC.Driver.DynFlags (
 
         -- ** System tool settings and locations
         programName, projectVersion,
-        ghcUsagePath, ghciUsagePath, topDir, toolDir,
+        ghcUsagePath, ghciUsagePath, topDir,
         versionedAppDir, versionedFilePath,
         extraGccViaCFlags, globalPackageDatabasePath,
 
@@ -1432,8 +1432,6 @@ ghciUsagePath         :: DynFlags -> FilePath
 ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags
 topDir                :: DynFlags -> FilePath
 topDir dflags = fileSettings_topDir $ fileSettings dflags
-toolDir               :: DynFlags -> Maybe FilePath
-toolDir dflags = fileSettings_toolDir $ fileSettings dflags
 extraGccViaCFlags     :: DynFlags -> [String]
 extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags
 globalPackageDatabasePath   :: DynFlags -> FilePath


=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -86,7 +86,6 @@ module GHC.Driver.Session (
         sProjectVersion,
         sGhcUsagePath,
         sGhciUsagePath,
-        sToolDir,
         sTopDir,
         sGlobalPackageDatabasePath,
         sLdSupportsCompactUnwind,
@@ -262,7 +261,7 @@ import GHC.Settings
 import GHC.CmmToAsm.CFG.Weight
 import GHC.Core.Opt.CallerCC
 
-import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir )
+import GHC.SysTools.BaseDir ( expandTopDir )
 
 import Data.IORef
 import Control.Arrow ((&&&))
@@ -3537,7 +3536,7 @@ compilerInfo dflags
       -- Next come the settings, so anything else can be overridden
       -- in the settings file (as "lookup" uses the first match for the
       -- key)
-    : map (fmap $ expandDirectories (topDir dflags) (toolDir dflags))
+    : map (fmap $ expandDirectories (topDir dflags))
           (rawSettings dflags)
    ++ [("Project version",             projectVersion dflags),
        ("Project Git commit id",       cProjectGitCommitId),
@@ -3592,8 +3591,8 @@ compilerInfo dflags
     platform  = targetPlatform dflags
     isWindows = platformOS platform == OSMinGW32
     useInplaceMinGW = toolSettings_useInplaceMinGW $ toolSettings dflags
-    expandDirectories :: FilePath -> Maybe FilePath -> String -> String
-    expandDirectories topd mtoold = expandToolDir useInplaceMinGW mtoold . expandTopDir topd
+    expandDirectories :: FilePath -> String -> String
+    expandDirectories topd = expandTopDir topd
 
 {- -----------------------------------------------------------------------------
 Note [DynFlags consistency]


=====================================
compiler/GHC/Settings.hs
=====================================
@@ -14,7 +14,6 @@ module GHC.Settings
   , sProjectVersion
   , sGhcUsagePath
   , sGhciUsagePath
-  , sToolDir
   , sTopDir
   , sGlobalPackageDatabasePath
   , sLdSupportsCompactUnwind
@@ -148,7 +147,6 @@ data ToolSettings = ToolSettings
 data FileSettings = FileSettings
   { fileSettings_ghcUsagePath          :: FilePath       -- ditto
   , fileSettings_ghciUsagePath         :: FilePath       -- ditto
-  , fileSettings_toolDir               :: Maybe FilePath -- ditto
   , fileSettings_topDir                :: FilePath       -- ditto
   , fileSettings_globalPackageDatabase :: FilePath
   }
@@ -176,8 +174,6 @@ sGhcUsagePath        :: Settings -> FilePath
 sGhcUsagePath = fileSettings_ghcUsagePath . sFileSettings
 sGhciUsagePath       :: Settings -> FilePath
 sGhciUsagePath = fileSettings_ghciUsagePath . sFileSettings
-sToolDir             :: Settings -> Maybe FilePath
-sToolDir = fileSettings_toolDir . sFileSettings
 sTopDir              :: Settings -> FilePath
 sTopDir = fileSettings_topDir . sFileSettings
 sGlobalPackageDatabasePath :: Settings -> FilePath


=====================================
compiler/GHC/Settings/IO.hs
=====================================
@@ -62,19 +62,13 @@ initSettings top_dir = do
   -- But we might be disabled, in which we we don't do that.
   useInplaceMinGW <- getBooleanSetting "Use inplace MinGW toolchain"
 
-  -- see Note [topdir: How GHC finds its files]
-  -- NB: top_dir is assumed to be in standard Unix
-  -- format, '/' separated
-  mtool_dir <- liftIO $ findToolDir useInplaceMinGW top_dir
-        -- see Note [tooldir: How GHC finds mingw on Windows]
-
   -- 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 $
         getRawFilePathSetting top_dir settingsFile mySettings key
       getToolSetting :: String -> ExceptT SettingsError m String
-      getToolSetting key = expandToolDir useInplaceMinGW mtool_dir <$> getSetting key
+      getToolSetting key = getSetting key
   targetPlatformString <- getSetting "target platform string"
   cc_prog <- getToolSetting "C compiler command"
   cxx_prog <- getToolSetting "C++ compiler command"
@@ -163,7 +157,6 @@ initSettings top_dir = do
     , sFileSettings = FileSettings
       { fileSettings_ghcUsagePath   = ghc_usage_msg_path
       , fileSettings_ghciUsagePath  = ghci_usage_msg_path
-      , fileSettings_toolDir        = mtool_dir
       , fileSettings_topDir         = top_dir
       , fileSettings_globalPackageDatabase = globalpkgdb_path
       }


=====================================
compiler/GHC/SysTools/BaseDir.hs
=====================================
@@ -12,8 +12,8 @@
 -}
 
 module GHC.SysTools.BaseDir
-  ( expandTopDir, expandToolDir
-  , findTopDir, findToolDir
+  ( expandTopDir
+  , findTopDir
   , tryFindTopDir
   ) where
 
@@ -50,88 +50,9 @@ On Windows:
   - we strip off the "<foo>/<something>.exe" to leave $topdir.
 
 from topdir we can find package.conf, ghc-asm, etc.
-
-
-Note [tooldir: How GHC finds mingw on Windows]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-GHC has some custom logic on Windows for finding the mingw
-toolchain. In general we will find the mingw toolchain
-in $topdir/../../mingw/.
-
-This story is long and with lots of twist and turns..  But let's talk about how
-the build system finds and wires through the toolchain information.
-
-1) It all starts in configure.ac which has two modes it operates on:
-   a) The default is where `EnableDistroToolchain` is false.  This indicates
-      that we want to use the in-tree bundled toolchains.  In this mode we will
-      download and unpack some custom toolchains into the `inplace/mingw` folder
-      and everything is pointed to that folder.
-   b) The second path is when `EnableDistroToolchain` is true.  This makes the
-      toolchain behave a lot like Linux, in that  the environment is queried for
-      information on the tools we require.
-
-  From configure.ac we export the standard variables to set the paths to the
-  tools for the build system to use.
-
-2) After we have the path to the tools we have to generate the right paths to
-   store in the settings file for ghc to use.  This is done in aclocal.m4.
-   Again we have two modes of operation:
-   a) If not `EnableDistroToolchain` the paths are rewritten to paths using a
-      variable `$tooldir` as we need an absolute path.  $tooldir is filled in by
-      the `expandToolDir` function in this module at GHC startup.
-   b) When `EnableDistroToolchain` then instead of filling in a absolute path
-      we fill in just the program name.  The assumption here is that at runtime
-      the environment GHC is operating on will be the same as the one configure
-      was run in.  This means we expect `gcc, ld, as` etc to be on the PATH.
-
-  From `aclocal.m4` we export a couple of variables starting with `Settings`
-  which will be used to generate the settings file.
-
-3) The next step is to generate the settings file: The file
-  `cfg/system.config.in` is preprocessed by configure and the output written to
-  `system.config`.  This serves the same purpose as `config.mk` but it rewrites
-  the values that were exported.  As an example `SettingsCCompilerCommand` is
-  rewritten to `settings-c-compiler-command`.
-
-  Next up is `src/Oracles/Settings.hs` which makes from some Haskell ADT to
-  the settings `keys` in the `system.config`.  As an example,
-  `settings-c-compiler-command` is mapped to
-  `SettingsFileSetting_CCompilerCommand`.
-
-  The last part of this is the `generateSettings` in `src/Rules/Generate.hs`
-  which produces the desired settings file out of Hadrian. This is the
-  equivalent to `rts/include/ghc.mk`.
-
---
-
-So why do we have these? On Windows there's no such thing as a platform compiler
-and as such we need to provide GCC and binutils.  The easiest way is to bundle
-these with the compiler and wire them up.  This gives you a relocatable
-binball.  This works fine for most users.  However mingw-w64 have a different
-requirement.  They require all packages in the repo to be compiled using the
-same version of the compiler.  So it means when they are rebuilding the world to
-add support for GCC X, they expect all packages to have been compiled with GCC X
-which is a problem since we ship an older GCC version.
-
-GHC is a package in mingw-w64 because there are Haskell packages in the
-repository which of course requires a Haskell compiler.  To help them we
-provide the override which allows GHC to instead of using an inplace compiler to
-play nice with the system compiler instead.
 -}
 
--- | Expand occurrences of the @$tooldir@ interpolation in a string
--- on Windows, leave the string untouched otherwise.
-expandToolDir
-  :: Bool -- ^ whether we use the ambient mingw toolchain
-  -> Maybe FilePath -- ^ tooldir
-  -> String -> String
-#if defined(mingw32_HOST_OS)
-expandToolDir False (Just tool_dir) s = expandPathVar "tooldir" tool_dir s
-expandToolDir False Nothing         _ = panic "Could not determine $tooldir"
-expandToolDir True  _               s = s
-#else
-expandToolDir _ _ s = s
-#endif
+
 
 -- | Returns a Unix-format path pointing to TopDir.
 findTopDir :: Maybe String -- Maybe TopDir path (without the '-B' prefix).
@@ -160,30 +81,3 @@ tryFindTopDir Nothing
              Nothing -> getBaseDir
 
 
--- See Note [tooldir: How GHC finds mingw on Windows]
--- Returns @Nothing@ when not on Windows.
--- When called on Windows, it either throws an error when the
--- tooldir can't be located, or returns @Just tooldirpath at .
--- If the distro toolchain is being used we treat Windows the same as Linux
-findToolDir
-  :: Bool -- ^ whether we use the ambient mingw toolchain
-  -> FilePath -- ^ topdir
-  -> IO (Maybe FilePath)
-#if defined(mingw32_HOST_OS)
-findToolDir False top_dir = go 0 (top_dir </> "..") []
-  where maxDepth = 3
-        go :: Int -> FilePath -> [FilePath] -> IO (Maybe FilePath)
-        go k path tried
-          | k == maxDepth = throwGhcExceptionIO $
-              InstallationError $ "could not detect mingw toolchain in the following paths: " ++ show tried
-          | otherwise = do
-              let try = path </> "mingw"
-              let tried' = tried ++ [try]
-              oneLevel <- doesDirectoryExist try
-              if oneLevel
-                then return (Just path)
-                else go (k+1) (path </> "..") tried'
-findToolDir True _ = return Nothing
-#else
-findToolDir _ _ = return Nothing
-#endif


=====================================
distrib/configure.ac.in
=====================================
@@ -104,7 +104,7 @@ AC_ARG_ENABLE(distro-toolchain,
 )
 
 if test "$HostOS" = "mingw32" -a "$EnableDistroToolchain" = "NO"; then
-  FP_SETUP_WINDOWS_TOOLCHAIN([$hardtop/mingw/], [\$\$topdir/../../mingw/])
+  FP_SETUP_WINDOWS_TOOLCHAIN([$hardtop/mingw/], [\$\$topdir/../mingw/])
 fi
 
 dnl ** Which gcc to use?


=====================================
hadrian/bindist/Makefile
=====================================
@@ -167,7 +167,7 @@ install_bin_direct:
 install_lib: lib/settings
 	@echo "Copying libraries to $(DESTDIR)$(ActualLibsDir)"
 	$(INSTALL_DIR) "$(DESTDIR)$(ActualLibsDir)"
-	
+
 	@dest="$(DESTDIR)$(ActualLibsDir)"; \
 	cd lib; \
 	for i in `$(FIND) . -type f`; do \


=====================================
hadrian/bindist/config.mk.in
=====================================
@@ -231,7 +231,6 @@ GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseL
 # We are in the process of moving the settings file from being entirely
 # generated by configure, to generated being by the build system. Many of these
 # might become redundant.
-# See Note [tooldir: How GHC finds mingw on Windows]
 
 LdHasFilelist = @LdHasFilelist@
 MergeObjsSupportsResponseFiles = @MergeObjsSupportsResponseFiles@


=====================================
hadrian/cfg/system.config.in
=====================================
@@ -75,7 +75,6 @@ project-git-commit-id  = @ProjectGitCommitId@
 # We are in the process of moving the settings file from being entirely
 # generated by configure, to generated being by the build system. Many of these
 # might become redundant.
-# See Note [tooldir: How GHC finds mingw on Windows]
 
 settings-otool-command = @SettingsOtoolCommand@
 settings-install_name_tool-command = @SettingsInstallNameToolCommand@


=====================================
hadrian/src/Oracles/Setting.hs
=====================================
@@ -127,7 +127,6 @@ setting key = lookupSystemConfig $ case key of
 
 -- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the
 -- result.
--- See Note [tooldir: How GHC finds mingw on Windows]
 -- ROMES:TODO: This should be queryTargetTargetConfig
 settingsFileSetting :: ToolchainSetting -> Action String
 settingsFileSetting key = lookupSystemConfig $ case key of


=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -430,44 +430,44 @@ generateSettings :: Expr String
 generateSettings = do
     ctx <- getContext
     settings <- traverse sequence $
-        [ ("C compiler command",   queryTarget' ccPath)
-        , ("C compiler flags",     queryTarget' ccFlags)
-        , ("C++ compiler command", queryTarget' cxxPath)
-        , ("C++ compiler flags",   queryTarget' cxxFlags)
-        , ("C compiler link flags",       queryTarget' clinkFlags)
-        , ("C compiler supports -no-pie", queryTarget' linkSupportsNoPie)
-        , ("CPP command",         queryTarget' cppPath)
-        , ("CPP flags",           queryTarget' cppFlags)
-        , ("Haskell CPP command", queryTarget' hsCppPath)
-        , ("Haskell CPP flags",   queryTarget' hsCppFlags)
-        , ("ld supports compact unwind", queryTarget' linkSupportsCompactUnwind)
-        , ("ld supports filelist",       queryTarget' linkSupportsFilelist)
-        , ("ld is GNU ld",               queryTarget' linkIsGnu)
-        , ("Merge objects command", queryTarget' mergeObjsPath)
-        , ("Merge objects flags", queryTarget' mergeObjsFlags)
-        , ("Merge objects supports response files", queryTarget' mergeObjsSupportsResponseFiles')
-        , ("ar command",          queryTarget' arPath)
-        , ("ar flags",            queryTarget' arFlags)
-        , ("ar supports at file", queryTarget' arSupportsAtFile')
-        , ("ar supports -L",      queryTarget' arSupportsDashL')
-        , ("ranlib command", queryTarget' ranlibPath)
+        [ ("C compiler command",   queryTarget ccPath)
+        , ("C compiler flags",     queryTarget ccFlags)
+        , ("C++ compiler command", queryTarget cxxPath)
+        , ("C++ compiler flags",   queryTarget cxxFlags)
+        , ("C compiler link flags",       queryTarget clinkFlags)
+        , ("C compiler supports -no-pie", queryTarget linkSupportsNoPie)
+        , ("CPP command",         queryTarget cppPath)
+        , ("CPP flags",           queryTarget cppFlags)
+        , ("Haskell CPP command", queryTarget hsCppPath)
+        , ("Haskell CPP flags",   queryTarget hsCppFlags)
+        , ("ld supports compact unwind", queryTarget linkSupportsCompactUnwind)
+        , ("ld supports filelist",       queryTarget linkSupportsFilelist)
+        , ("ld is GNU ld",               queryTarget linkIsGnu)
+        , ("Merge objects command", queryTarget mergeObjsPath)
+        , ("Merge objects flags", queryTarget mergeObjsFlags)
+        , ("Merge objects supports response files", queryTarget mergeObjsSupportsResponseFiles')
+        , ("ar command",          queryTarget arPath)
+        , ("ar flags",            queryTarget arFlags)
+        , ("ar supports at file", queryTarget arSupportsAtFile')
+        , ("ar supports -L",      queryTarget arSupportsDashL')
+        , ("ranlib command", queryTarget ranlibPath)
         , ("otool command", expr $ settingsFileSetting ToolchainSetting_OtoolCommand)
         , ("install_name_tool command", expr $ settingsFileSetting ToolchainSetting_InstallNameToolCommand)
         , ("touch command", expr $ settingsFileSetting ToolchainSetting_TouchCommand)
-        , ("windres command", queryTarget' (maybe "/bin/false" prgPath . tgtWindres)) -- TODO: /bin/false is not available on many distributions by default, but we keep it as it were before the ghc-toolchain patch. Fix-me.
+        , ("windres command", queryTarget (maybe "/bin/false" prgPath . tgtWindres)) -- TODO: /bin/false is not available on many distributions by default, but we keep it as it were before the ghc-toolchain patch. Fix-me.
         , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit })))
         , ("cross compiling", expr $ yesNo <$> flag CrossCompiling)
-        , ("target platform string", queryTarget' targetPlatformTriple)
-        , ("target os",        queryTarget' (show . archOS_OS . tgtArchOs))
-        , ("target arch",      queryTarget' (show . archOS_arch . tgtArchOs))
-        , ("target word size", queryTarget' wordSize)
-        , ("target word big endian",       queryTarget' isBigEndian)
-        , ("target has GNU nonexec stack", queryTarget' (yesNo . Toolchain.tgtSupportsGnuNonexecStack))
-        , ("target has .ident directive",  queryTarget' (yesNo . Toolchain.tgtSupportsIdentDirective))
-        , ("target has subsections via symbols", queryTarget' (yesNo . Toolchain.tgtSupportsSubsectionsViaSymbols))
+        , ("target platform string", queryTarget targetPlatformTriple)
+        , ("target os",        queryTarget (show . archOS_OS . tgtArchOs))
+        , ("target arch",      queryTarget (show . archOS_arch . tgtArchOs))
+        , ("target word size", queryTarget wordSize)
+        , ("target word big endian",       queryTarget isBigEndian)
+        , ("target has GNU nonexec stack", queryTarget (yesNo . Toolchain.tgtSupportsGnuNonexecStack))
+        , ("target has .ident directive",  queryTarget (yesNo . Toolchain.tgtSupportsIdentDirective))
+        , ("target has subsections via symbols", queryTarget (yesNo . Toolchain.tgtSupportsSubsectionsViaSymbols))
         , ("target has libm", expr $  lookupSystemConfig "target-has-libm")
-        , ("Unregisterised", queryTarget' (yesNo . tgtUnregisterised))
-        , ("LLVM target", queryTarget' tgtLlvmTarget)
+        , ("Unregisterised", queryTarget (yesNo . tgtUnregisterised))
+        , ("LLVM target", queryTarget tgtLlvmTarget)
         , ("LLVM llc command", expr $ settingsFileSetting ToolchainSetting_LlcCommand)
         , ("LLVM opt command", expr $ settingsFileSetting ToolchainSetting_OptCommand)
         , ("Use inplace MinGW toolchain", expr $ settingsFileSetting ToolchainSetting_DistroMinGW)
@@ -475,8 +475,8 @@ generateSettings = do
         , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter)
         , ("Support SMP", expr $ yesNo <$> targetSupportsSMP)
         , ("RTS ways", unwords . map show . Set.toList <$> getRtsWays)
-        , ("Tables next to code", queryTarget' (yesNo . tgtTablesNextToCode))
-        , ("Leading underscore",  queryTarget' (yesNo . tgtSymbolsHaveLeadingUnderscore))
+        , ("Tables next to code", queryTarget (yesNo . tgtTablesNextToCode))
+        , ("Leading underscore",  queryTarget (yesNo . tgtSymbolsHaveLeadingUnderscore))
         , ("Use LibFFI", expr $ yesNo <$> useLibffiForAdjustors)
         , ("RTS expects libdw", yesNo <$> getFlag UseLibdw)
         ]
@@ -512,22 +512,6 @@ generateSettings = do
     wordSize    = show . wordSize2Bytes . tgtWordSize
     mergeObjsSupportsResponseFiles' = maybe "NO" (yesNo . mergeObjsSupportsResponseFiles) . tgtMergeObjs
 
-    -- Like @'queryTarget'@ specialized to String, but replace occurrences of
-    -- @topDirectory </> inplace/mingw@ with @$tooldir/mingw@ in the resulting string
-    --
-    -- See Note [How we configure the bundled windows toolchain]
-    queryTarget' :: (Toolchain.Target -> String) -> Expr String
-    queryTarget' f = do
-      topdir <- expr $ topDirectory
-      queryTarget (\t -> substTooldir topdir (archOS_OS $ tgtArchOs t) (f t))
-      where
-        substTooldir :: String -> OS -> String -> String
-        substTooldir topdir OSMinGW32 s
-          = T.unpack $
-            T.replace (T.pack $ normalise $ topdir </> "inplace" </> "mingw") (T.pack "$tooldir/mingw") (T.pack $ normalise s)
-        substTooldir _ _ s = s
-
-
 -- | Generate @Config.hs@ files.
 generateConfigHs :: Expr String
 generateConfigHs = do



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/93cc8fd07f517fad59756f1d670716350ed299e2...f08bd58f6e802c59f7459224d7b60e42cd4a6167

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/93cc8fd07f517fad59756f1d670716350ed299e2...f08bd58f6e802c59f7459224d7b60e42cd4a6167
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230815/e733d1f4/attachment-0001.html>


More information about the ghc-commits mailing list