- ghc-commits - Haskell.org

[Git][ghc/ghc] Pushed new branch wip/9.10.3-backports
by Zubin (＠wz1000) 11 Jul '25

11 Jul '25

Zubin pushed new branch wip/9.10.3-backports at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/9.10.3-backports You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/haanss/depdir] revert returning dir contents from qAddDependetDirectory
by Hassan Al-Awwadi (＠hassan.awwadi) 11 Jul '25

11 Jul '25

Hassan Al-Awwadi pushed to branch wip/haanss/depdir at Glasgow Haskell Compiler / GHC Commits: 75856938 by Hassan Al-Awwadi at 2025-07-11T13:30:37+02:00 revert returning dir contents from qAddDependetDirectory - - - - - 5 changed files: - compiler/GHC/Tc/Gen/Splice.hs - libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs - libraries/ghci/GHCi/Message.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/interface-stability/template-haskell-exports.stdout Changes: ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -1528,13 +1528,6 @@ instance TH.Quasi TcM where ref <- fmap tcg_dependent_dirs getGblEnv dep_dirs <- readTcRef ref writeTcRef ref (dp:dep_dirs) - -- listDirectory does not return an absolute path, so - -- we need to prepend the directory path to make the - -- the contents absolute. - contents <- liftIO $ listDirectory dp - let path_prefix = dp ++ "\\" - let abs_contents = map (path_prefix ++) contents - return abs_contents qAddTempFile suffix = do dflags <- getDynFlags ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs ===================================== @@ -136,7 +136,7 @@ class (MonadIO m, MonadFail m) => Quasi m where qAddDependentFile :: FilePath -> m () -- | See 'addDependentDirectory'. - qAddDependentDirectory :: FilePath -> m [FilePath] + qAddDependentDirectory :: FilePath -> m () -- | See 'addTempFile'. qAddTempFile :: String -> m FilePath @@ -839,23 +839,9 @@ getPackageRoot = Q qGetPackageRoot -- * The dependency is shallow, just a hash of its direct contents. It returns -- a list of the contents (absolute paths), files and subdirectories both, so -- you can manually depend on (a subset of) those, if you wish. -addDependentDirectory :: FilePath -> Q [FilePath] +addDependentDirectory :: FilePath -> Q () addDependentDirectory dp = Q (qAddDependentDirectory dp) --- | Record external directories that runIO is using (dependent upon). --- The compiler can then recognize that it should re-compile the Haskell file --- when a directory changes. --- --- Expects an absolute directory path. --- --- Notes: --- --- * ghc -M does not know about these dependencies - it does not execute TH. --- --- * The dependency is shallow, just a hash of its direct contents. --- See 'addDependentDirectory' for a version that returns the contents. -addDependentDirectory_ :: FilePath -> Q () -addDependentDirectory_ dp = addDependentDirectory dp >> pure () -- | Record external files that runIO is using (dependent upon). -- The compiler can then recognize that it should re-compile the Haskell file ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -291,7 +291,7 @@ data THMessage a where GetPackageRoot :: THMessage (THResult FilePath) AddDependentFile :: FilePath -> THMessage (THResult ()) - AddDependentDirectory :: FilePath -> THMessage (THResult [FilePath]) + AddDependentDirectory :: FilePath -> THMessage (THResult ()) AddTempFile :: String -> THMessage (THResult FilePath) AddModFinalizer :: RemoteRef (TH.Q ()) -> THMessage (THResult ()) AddCorePlugin :: String -> THMessage (THResult ()) ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -33,7 +33,6 @@ module Language.Haskell.TH.Syntax ( addCorePlugin, addDependentFile, addDependentDirectory, - addDependentDirectory_, addForeignFile, addForeignFilePath, addForeignSource, ===================================== testsuite/tests/interface-stability/template-haskell-exports.stdout ===================================== @@ -1715,7 +1715,7 @@ module Language.Haskell.TH.Syntax where qRunIO :: forall a. GHC.Internal.Types.IO a -> m a qGetPackageRoot :: m GHC.Internal.IO.FilePath qAddDependentFile :: GHC.Internal.IO.FilePath -> m () - qAddDependentDirectory :: GHC.Internal.IO.FilePath -> m [GHC.Internal.IO.FilePath] + qAddDependentDirectory :: GHC.Internal.IO.FilePath -> m () qAddTempFile :: GHC.Internal.Base.String -> m GHC.Internal.IO.FilePath qAddTopDecls :: [Dec] -> m () qAddForeignFilePath :: ForeignSrcLang -> GHC.Internal.Base.String -> m () @@ -1780,8 +1780,7 @@ module Language.Haskell.TH.Syntax where type VarStrictType :: * type VarStrictType = VarBangType addCorePlugin :: GHC.Internal.Base.String -> Q () - addDependentDirectory :: GHC.Internal.IO.FilePath -> Q [GHC.Internal.IO.FilePath] - addDependentDirectory_ :: GHC.Internal.IO.FilePath -> Q () + addDependentDirectory :: GHC.Internal.IO.FilePath -> Q () addDependentFile :: GHC.Internal.IO.FilePath -> Q () addForeignFile :: ForeignSrcLang -> GHC.Internal.Base.String -> Q () addForeignFilePath :: ForeignSrcLang -> GHC.Internal.IO.FilePath -> Q () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/75856938050c94945fc6ca91c0cf542… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/75856938050c94945fc6ca91c0cf542… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26115] Wibbles
by Simon Peyton Jones (＠simonpj) 11 Jul '25

11 Jul '25

Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC Commits: 3afdcdca by Simon Peyton Jones at 2025-07-11T10:29:01+01:00 Wibbles - - - - - 2 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/Specialise.hs Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -188,24 +188,21 @@ exprSomeFreeVarsDSet fv_cand e = fvDVarSet $ filterFV fv_cand $ exprFVs e exprsSomeFreeVars :: InterestingVarFun -- Says which 'Var's are interesting -> [CoreExpr] -> VarSet -exprsSomeFreeVars fv_cand es = - fvVarSet $ filterFV fv_cand $ mapUnionFV exprFVs es +exprsSomeFreeVars fv_cand es = fvVarSet $ filterFV fv_cand $ mapUnionFV exprFVs es -- | Finds free variables in several expressions selected by a predicate -- returning a deterministically ordered list. exprsSomeFreeVarsList :: InterestingVarFun -- Says which 'Var's are interesting -> [CoreExpr] -> [Var] -exprsSomeFreeVarsList fv_cand es = - fvVarList $ filterFV fv_cand $ mapUnionFV exprFVs es +exprsSomeFreeVarsList fv_cand es = fvVarList $ filterFV fv_cand $ mapUnionFV exprFVs es -- | Finds free variables in several expressions selected by a predicate -- returning a deterministic set. exprsSomeFreeVarsDSet :: InterestingVarFun -- ^ Says which 'Var's are interesting -> [CoreExpr] -> DVarSet -exprsSomeFreeVarsDSet fv_cand e = - fvDVarSet $ filterFV fv_cand $ mapUnionFV exprFVs e +exprsSomeFreeVarsDSet fv_cand e = fvDVarSet $ filterFV fv_cand $ mapUnionFV exprFVs e -- Comment about obsolete code -- We used to gather the free variables the RULES at a variable occurrence ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -2594,12 +2594,12 @@ specHeader , Core.Subst -- Apply this to the body -- RULE helpers - -- RULE forall rule_bndrs. f rule_es = $sf spec_bndrs + -- `RULE forall rule_bndrs. f rule_es = $sf spec_bndrs` , [OutBndr] -- rule_bndrs: Binders for the RULE , [OutExpr] -- rule_es: Args for the LHS of the rule -- Specialised function helpers - -- $sf = \spec_bndrs. let { dx_binds } in <orig-rhs> spec_arg + -- `$sf = \spec_bndrs. let { dx_binds } in <orig-rhs> spec_arg` , [OutBndr] -- spec_bndrs: Binders for $sf. Subset of rule_bndrs. , [DictBind] -- dx_binds: Auxiliary dictionary bindings , [OutExpr] -- spec_args: Specialised arguments for unfolding View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3afdcdca67a54c537e33de808a2b5b8… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3afdcdca67a54c537e33de808a2b5b8… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/24212] Fix
by Rodrigo Mesquita (＠alt-romes) 11 Jul '25

11 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/24212 at Glasgow Haskell Compiler / GHC Commits: a7ec377a by Rodrigo Mesquita at 2025-07-11T09:09:32+01:00 Fix - - - - - 1 changed file: - compiler/GHC/Driver/Session.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -407,6 +407,7 @@ settings dflags = Settings , sToolSettings = toolSettings dflags , sPlatformMisc = platformMisc dflags , sRawSettings = rawSettings dflags + , sRawTarget = rawTarget dflags } pgm_L :: DynFlags -> String View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7ec377a3bbd8efe6dc42be65854e98… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7ec377a3bbd8efe6dc42be65854e98… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/24212] Fix ghc --info
by Rodrigo Mesquita (＠alt-romes) 11 Jul '25

11 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/24212 at Glasgow Haskell Compiler / GHC Commits: 307a675c by Rodrigo Mesquita at 2025-07-11T08:40:13+01:00 Fix ghc --info - - - - - 1 changed file: - compiler/GHC/Driver/Session.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -279,6 +279,10 @@ import GHC.Parser (parseIdentifier) import GHC.Parser.Lexer (mkParserOpts, initParserState, P(..), ParseResult(..)) import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir ) +import GHC.ResponseFile + +import GHC.Toolchain +import GHC.Toolchain.Program import Data.IORef import Control.Arrow ((&&&)) @@ -3454,69 +3458,58 @@ 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) - -- TODO: - -- : map (fmap $ ) - -- (rawSettings dflags) - : - [("C compiler command", query), - ("C compiler flags", "$(SettingsCCompilerFlags)"), - ("C++ compiler command", "$(SettingsCxxCompilerCommand)"), - ("C++ compiler flags", "$(SettingsCxxCompilerFlags)"), - ("C compiler link flags", "$(SettingsCCompilerLinkFlags)"), - ("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)"), - ("CPP command", "$(SettingsCPPCommand)"), - ("CPP flags", "$(SettingsCPPFlags)"), - ("Haskell CPP command", "$(SettingsHaskellCPPCommand)"), - ("Haskell CPP flags", "$(SettingsHaskellCPPFlags)"), - ("JavaScript CPP command", "$(SettingsJavaScriptCPPCommand)"), - ("JavaScript CPP flags", "$(SettingsJavaScriptCPPFlags)"), - ("C-- CPP command", "$(SettingsCmmCPPCommand)"), - ("C-- CPP flags", "$(SettingsCmmCPPFlags)"), - ("C-- CPP supports -g0", "$(SettingsCmmCPPSupportsG0)"), - ("ld supports compact unwind", "$(LdHasNoCompactUnwind)"), - ("ld supports filelist", "$(LdHasFilelist)"), - ("ld supports single module", "$(LdHasSingleModule)"), - ("ld is GNU ld", "$(LdIsGNULd)"), - ("Merge objects command", "$(SettingsMergeObjectsCommand)"), - ("Merge objects flags", "$(SettingsMergeObjectsFlags)"), - ("Merge objects supports response files", "$(MergeObjsSupportsResponseFiles)"), - ("ar command", "$(SettingsArCommand)"), - ("ar flags", "$(ArArgs)"), - ("ar supports at file", "$(ArSupportsAtFile)"), - ("ar supports -L", "$(ArSupportsDashL)"), - ("ranlib command", "$(SettingsRanlibCommand)"), - ("otool command", "$(SettingsOtoolCommand)"), - ("install_name_tool command", "$(SettingsInstallNameToolCommand)"), - ("windres command", "$(SettingsWindresCommand)"), - ("unlit command", "$$topdir/../bin/$(CrossCompilePrefix)unlit"), - ("cross compiling", "$(CrossCompiling)"), - ("target platform string", "$(TARGETPLATFORM)"), - ("target os", "$(HaskellTargetOs)"), - ("target arch", "$(HaskellTargetArch)"), - ("target word size", "$(TargetWordSize)"), - ("target word big endian", "$(TargetWordBigEndian)"), - ("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)"), - ("target has .ident directive", "$(TargetHasIdentDirective)"), - ("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)"), - ("target has libm", "$(TargetHasLibm)"), - ("Unregisterised", "$(GhcUnregisterised)"), - ("LLVM target", "$(LLVMTarget)"), - ("LLVM llc command", "$(SettingsLlcCommand)"), - ("LLVM opt command", "$(SettingsOptCommand)"), - ("LLVM llvm-as command", "$(SettingsLlvmAsCommand)"), - ("LLVM llvm-as flags", "$(SettingsLlvmAsFlags)"), - ("target RTS linker only supports shared libraries", "$(TargetRTSLinkerOnlySupportsSharedLibs)"), - ("Use interpreter", "$(GhcWithInterpreter)"), - ("Support SMP", "$(GhcWithSMP)"), - ("RTS ways", "$(GhcRTSWays)"), - ("Tables next to code", "$(TablesNextToCode)"), - ("Leading underscore", "$(LeadingUnderscore)"), - ("Use LibFFI", "$(UseLibffiForAdjustors)"), - ("RTS expects libdw", "$(GhcRtsWithLibdw)"), - ("Relative Global Package DB", "package.conf.d"), - ("base unit-id", "$(BaseUnitId)") - ] - ++ [("Project version", projectVersion dflags), + : map (fmap expandDirectories) + (rawSettings dflags) + ++ + [("C compiler command", queryCmd $ ccProgram . tgtCCompiler), + ("C compiler flags", queryFlags $ ccProgram . tgtCCompiler), + ("C++ compiler command", queryCmd $ cxxProgram . tgtCxxCompiler), + ("C++ compiler flags", queryFlags $ cxxProgram . tgtCxxCompiler), + ("C compiler link flags", queryFlags $ ccLinkProgram . tgtCCompilerLink), + ("C compiler supports -no-pie", queryBool $ ccLinkSupportsNoPie . tgtCCompilerLink), + ("CPP command", queryCmd $ cppProgram . tgtCPreprocessor), + ("CPP flags", queryFlags $ cppProgram . tgtCPreprocessor), + ("Haskell CPP command", queryCmd $ hsCppProgram . tgtHsCPreprocessor), + ("Haskell CPP flags", queryFlags $ hsCppProgram . tgtHsCPreprocessor), + ("JavaScript CPP command", queryCmdMaybe jsCppProgram tgtJsCPreprocessor), + ("JavaScript CPP flags", queryFlagsMaybe jsCppProgram tgtJsCPreprocessor), + ("C-- CPP command", queryCmd $ cmmCppProgram . tgtCmmCPreprocessor), + ("C-- CPP flags", queryFlags $ cmmCppProgram . tgtCmmCPreprocessor), + ("C-- CPP supports -g0", queryBool $ cmmCppSupportsG0 . tgtCmmCPreprocessor), + ("ld supports compact unwind", queryBool $ ccLinkSupportsCompactUnwind . tgtCCompilerLink), + ("ld supports filelist", queryBool $ ccLinkSupportsFilelist . tgtCCompilerLink), + ("ld supports single module", queryBool $ ccLinkSupportsSingleModule . tgtCCompilerLink), + ("ld is GNU ld", queryBool $ ccLinkIsGnu . tgtCCompilerLink), + ("Merge objects command", queryCmdMaybe mergeObjsProgram tgtMergeObjs), + ("Merge objects flags", queryFlagsMaybe mergeObjsProgram tgtMergeObjs), + ("Merge objects supports response files", queryBool $ maybe False mergeObjsSupportsResponseFiles . tgtMergeObjs), + ("ar command", queryCmd $ arMkArchive . tgtAr), + ("ar flags", queryFlags $ arMkArchive . tgtAr), + ("ar supports at file", queryBool $ arSupportsAtFile . tgtAr), + ("ar supports -L", queryBool $ arSupportsDashL . tgtAr), + ("ranlib command", queryCmdMaybe ranlibProgram tgtRanlib), + ("otool command", queryCmdMaybe id tgtOtool), + ("install_name_tool command", queryCmdMaybe id tgtInstallNameTool), + ("windres command", queryCmd $ fromMaybe (Program "/bin/false" []) . tgtWindres), + ("cross compiling", queryBool (not . tgtLocallyExecutable)), + ("target platform string", query targetPlatformTriple), + ("target os", query (show . archOS_OS . tgtArchOs)), + ("target arch", query (show . archOS_arch . tgtArchOs)), + ("target word size", query $ show . wordSize2Bytes . tgtWordSize), + ("target word big endian", queryBool $ (\case BigEndian -> True; LittleEndian -> False) . tgtEndianness), + ("target has GNU nonexec stack", queryBool tgtSupportsGnuNonexecStack), + ("target has .ident directive", queryBool tgtSupportsIdentDirective), + ("target has subsections via symbols", queryBool tgtSupportsSubsectionsViaSymbols), + ("Unregisterised", queryBool tgtUnregisterised), + ("LLVM target", query tgtLlvmTarget), + ("LLVM llc command", queryCmdMaybe id tgtLlc), + ("LLVM opt command", queryCmdMaybe id tgtOpt), + ("LLVM llvm-as command", queryCmdMaybe id tgtLlvmAs), + ("LLVM llvm-as flags", queryFlagsMaybe id tgtLlvmAs), + ("Tables next to code", queryBool tgtTablesNextToCode), + ("Leading underscore", queryBool tgtSymbolsHaveLeadingUnderscore) + ] ++ + [("Project version", projectVersion dflags), ("Project Git commit id", cProjectGitCommitId), ("Project Version Int", cProjectVersionInt), ("Project Patch Level", cProjectPatchLevel), @@ -3574,7 +3567,15 @@ compilerInfo dflags platform = targetPlatform dflags isWindows = platformOS platform == OSMinGW32 expandDirectories = expandToolDir (toolDir dflags) . expandTopDir (topDir dflags) + query :: (Target -> a) -> a query f = f (rawTarget dflags) + queryFlags f = query (escapeArgs . prgFlags . f) + queryCmd f = expandDirectories (query (prgPath . f)) + queryBool = showBool . query + + queryCmdMaybe, queryFlagsMaybe :: (a -> Program) -> (Target -> Maybe a) -> String + queryCmdMaybe p f = expandDirectories (query (maybe "" (prgPath . p) . f)) + queryFlagsMaybe p f = query (maybe "" (escapeArgs . prgFlags . p) . f) -- Note [Special unit-ids] -- ~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/307a675c688bcf0b17f6d796c5503f6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/307a675c688bcf0b17f6d796c5503f6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/warning-for-last-and-init] Re CLC issue 292 Warn GHC.Internal.List.{init,last} are partial
by Bodigrim (＠Bodigrim) 10 Jul '25

10 Jul '25

Bodigrim pushed to branch wip/warning-for-last-and-init at Glasgow Haskell Compiler / GHC Commits: 3da64044 by Mike Pilgrem at 2025-07-10T23:41:02+01:00 Re CLC issue 292 Warn GHC.Internal.List.{init,last} are partial Also corrects the warning for `tail` to refer to `Data.List.uncons` (like the existing warning for `head`). In module `Settings.Warnings`, applies `-Wno-unrecognised-warning-flags` `-Wno-x-partial` to the `Cabal`, `filepath`, `hsc2hs`, `hpc`, `parsec`, `text` and `time` packages (outside GHC's repository). - - - - - 16 changed files: - compiler/GHC/Core/Utils.hs - compiler/GHC/Driver/Session/Units.hs - compiler/GHC/Prelude/Basic.hs - ghc/GHCi/UI.hs - ghc/Main.hs - libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs - libraries/ghc-internal/src/GHC/Internal/Float.hs - libraries/ghc-internal/src/GHC/Internal/List.hs - libraries/ghc-internal/src/GHC/Internal/System/IO.hs - libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs - libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs - testsuite/tests/driver/j-space/jspace.hs - testsuite/tests/rts/KeepCafsBase.hs - utils/check-exact/Utils.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs - utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -112,8 +112,7 @@ import GHC.Utils.Misc import Data.ByteString ( ByteString ) import Data.Function ( on ) -import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL ) -import qualified Data.List as Partial ( init, last ) +import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL, unsnoc ) import Data.Ord ( comparing ) import Control.Monad ( guard ) import qualified Data.Set as Set @@ -1871,10 +1870,10 @@ app_ok fun_ok primop_ok fun args PrimOpId op _ | primOpIsDiv op - , Lit divisor <- Partial.last args + , Just (initArgs, Lit divisor) <- unsnoc args -- there can be 2 args (most div primops) or 3 args -- (WordQuotRem2Op), hence the use of last/init - -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) (Partial.init args) + -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) initArgs -- Special case for dividing operations that fail -- In general they are NOT ok-for-speculation -- (which primop_ok will catch), but they ARE OK ===================================== compiler/GHC/Driver/Session/Units.hs ===================================== @@ -183,7 +183,7 @@ checkUnitCycles dflags graph = processSCCs (HUG.hugSCCs graph) processSCCs [] = return () processSCCs (AcyclicSCC _: other_sccs) = processSCCs other_sccs - processSCCs (CyclicSCC uids: _) = throwGhcException $ CmdLineError $ showSDoc dflags (cycle_err uids) + processSCCs (NECyclicSCC uids: _) = throwGhcException $ CmdLineError $ showSDoc dflags (cycle_err uids) cycle_err uids = @@ -195,8 +195,8 @@ checkUnitCycles dflags graph = processSCCs (HUG.hugSCCs graph) (map (\uid -> text "-" <+> ppr uid <+> text "depends on") start) ++ [text "-" <+> ppr final] where - start = init uids - final = last uids + start = NE.init uids + final = NE.last uids -- | Check that we don't have multiple units with the same UnitId. checkDuplicateUnits :: DynFlags -> [(FilePath, DynFlags)] -> Ghc () ===================================== compiler/GHC/Prelude/Basic.hs ===================================== @@ -2,8 +2,8 @@ {-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_GHC -O2 #-} -- See Note [-O2 Prelude] --- See Note [Proxies for head and tail] -{-# OPTIONS_GHC -Wno-unrecognised-warning-flags -Wno-x-partial #-} +-- See Note [Proxies for partial list functions] +{-# OPTIONS_GHC -Wno-x-partial #-} -- | Custom minimal GHC "Prelude" -- @@ -24,7 +24,7 @@ module GHC.Prelude.Basic , bit , shiftL, shiftR , setBit, clearBit - , head, tail, unzip + , head, tail, init, last, unzip , strictGenericLength ) where @@ -59,7 +59,7 @@ NoImplicitPrelude. There are two motivations for this: -} import qualified Prelude -import Prelude as X hiding ((<>), Applicative(..), Foldable(..), head, tail, unzip) +import Prelude as X hiding ((<>), Applicative(..), Foldable(..), head, tail, init, last, unzip) import Control.Applicative (Applicative(..)) import Data.Foldable as X (Foldable (elem, foldMap, foldl, foldl', foldr, length, null, product, sum)) import Data.Foldable1 as X hiding (head, last) @@ -118,24 +118,35 @@ setBit = \ x i -> x Bits..|. bit i clearBit :: (Num a, Bits.Bits a) => a -> Int -> a clearBit = \ x i -> x Bits..&. Bits.complement (bit i) -{- Note [Proxies for head and tail] +{- Note [Proxies for partial list functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Prelude.head and Prelude.tail have recently acquired {-# WARNING in "x-partial" #-}, +Prelude.head, Prelude.tail, Prelude.init and Prelude.last +have recently acquired {-# WARNING in "x-partial" #-}, but the GHC codebase uses them fairly extensively and insists on building warning-free. Thus, instead of adding {-# OPTIONS_GHC -Wno-x-partial #-} to every module which employs them, we define warning-less proxies and export them from GHC.Prelude. -} --- See Note [Proxies for head and tail] +-- See Note [Proxies for partial list functions] head :: HasCallStack => [a] -> a head = Prelude.head {-# INLINE head #-} --- See Note [Proxies for head and tail] +-- See Note [Proxies for partial list functions] tail :: HasCallStack => [a] -> [a] tail = Prelude.tail {-# INLINE tail #-} +-- See Note [Proxies for partial list functions] +init :: HasCallStack => [a] -> [a] +init = Prelude.init +{-# INLINE init #-} + +-- See Note [Proxies for partial list functions] +last :: HasCallStack => [a] -> a +last = Prelude.last +{-# INLINE last #-} + {- | The 'genericLength' function defined in base can't be specialised due to the NOINLINE pragma. ===================================== ghc/GHCi/UI.hs ===================================== @@ -133,7 +133,7 @@ import Data.Char import Data.Function import qualified Data.Foldable as Foldable import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef ) -import Data.List ( find, intercalate, intersperse, +import Data.List ( find, intercalate, intersperse, unsnoc, isPrefixOf, isSuffixOf, nub, partition, sort, sortBy, (\\) ) import qualified Data.List.NonEmpty as NE import qualified Data.Set as S @@ -2399,9 +2399,9 @@ setContextAfterLoad keep_ctxt (Just graph) = do [] -> let graph' = flattenSCCs $ filterToposortToModules $ GHC.topSortModuleGraph True (GHC.mkModuleGraph loaded_graph) Nothing - in case graph' of - [] -> setContextKeepingPackageModules keep_ctxt [] - xs -> load_this (last xs) + in case unsnoc graph' of + Nothing -> setContextKeepingPackageModules keep_ctxt [] + Just (_, lst) -> load_this lst (m:_) -> load_this m where ===================================== ghc/Main.hs ===================================== @@ -88,7 +88,7 @@ import System.Exit import Control.Monad import Control.Monad.Trans.Class import Control.Monad.Trans.Except (throwE, runExceptT) -import Data.List ( isPrefixOf, partition, intercalate ) +import Data.List ( isPrefixOf, partition, intercalate, unsnoc ) import Prelude import qualified Data.List.NonEmpty as NE @@ -115,8 +115,7 @@ main = do argv0 <- getArgs let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0 - mbMinusB | null minusB_args = Nothing - | otherwise = Just (drop 2 (last minusB_args)) + mbMinusB = drop 2 . snd <$> unsnoc minusB_args let argv2 = map (mkGeneralLocated "on the commandline") argv1 ===================================== libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs ===================================== @@ -13,7 +13,7 @@ import GHC.Boot.TH.PprLib import GHC.Boot.TH.Syntax import Data.Word ( Word8 ) import Data.Char ( toLower, chr ) -import Data.List ( intersperse ) +import Data.List ( intersperse, unsnoc ) import GHC.Show ( showMultiLineString ) import GHC.Lexeme( isVarSymChar ) import Data.Ratio ( numerator, denominator ) @@ -214,9 +214,10 @@ pprExp i (MDoE m ss_) = parensIf (i > noPrec) $ pprStms [s] = ppr s pprStms ss = braces (semiSep ss) -pprExp _ (CompE []) = text "<<Empty CompExp>>" -- This will probably break with fixity declarations - would need a ';' -pprExp _ (CompE ss) = +pprExp _ (CompE ss) = case unsnoc ss of + Nothing -> text "<<Empty CompExp>>" + Just (ss', s) -> if null ss' -- If there are no statements in a list comprehension besides the last -- one, we simply treat it like a normal list. @@ -225,8 +226,6 @@ pprExp _ (CompE ss) = <+> bar <+> commaSep ss' <> text "]" - where s = last ss - ss' = init ss pprExp _ (ArithSeqE d) = ppr d pprExp _ (ListE es) = brackets (commaSep es) pprExp i (SigE e t) = parensIf (i > noPrec) $ pprExp sigPrec e ===================================== libraries/ghc-internal/src/GHC/Internal/Float.hs ===================================== @@ -13,6 +13,9 @@ {-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +-- For init in formatRealFloatAlt +{-# OPTIONS_GHC -Wno-x-partial #-} + ----------------------------------------------------------------------------- -- | -- Module : GHC.Internal.Float ===================================== libraries/ghc-internal/src/GHC/Internal/List.hs ===================================== @@ -190,12 +190,18 @@ tail :: HasCallStack => [a] -> [a] tail (_:xs) = xs tail [] = errorEmptyList "tail" -{-# WARNING in "x-partial" tail "This is a partial function, it throws an error on empty lists. Replace it with 'drop' 1, or use pattern matching or 'GHC.Internal.Data.List.uncons' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} +{-# WARNING in "x-partial" tail "This is a partial function, it throws an error on empty lists. Replace it with 'drop' 1, or use pattern matching or 'Data.List.uncons' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} -- | $\mathcal{O}(n)$. Extract the last element of a list, which must be -- finite and non-empty. -- --- WARNING: This function is partial. Consider using 'unsnoc' instead. +-- To disable the warning about partiality put +-- @{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}@ +-- at the top of the file. To disable it throughout a package put the same +-- options into @ghc-options@ section of Cabal file. To disable it in GHCi +-- put @:set -Wno-x-partial -Wno-unrecognised-warning-flags@ into @~/.ghci@ +-- config file. See also the +-- [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides…. -- -- ==== __Examples__ -- @@ -218,10 +224,18 @@ last xs = foldl (\_ x -> x) lastError xs lastError :: HasCallStack => a lastError = errorEmptyList "last" +{-# WARNING in "x-partial" last "This is a partial function, it throws an error on empty lists. Use 'Data.List.unsnoc' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} + -- | $\mathcal{O}(n)$. Return all the elements of a list except the last one. -- The list must be non-empty. -- --- WARNING: This function is partial. Consider using 'unsnoc' instead. +-- To disable the warning about partiality put +-- @{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}@ +-- at the top of the file. To disable it throughout a package put the same +-- options into @ghc-options@ section of Cabal file. To disable it in GHCi +-- put @:set -Wno-x-partial -Wno-unrecognised-warning-flags@ into @~/.ghci@ +-- config file. See also the +-- [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides…. -- -- ==== __Examples__ -- @@ -240,6 +254,8 @@ init (x:xs) = init' x xs where init' _ [] = [] init' y (z:zs) = y : init' z zs +{-# WARNING in "x-partial" init "This is a partial function, it throws an error on empty lists. Use 'Data.List.unsnoc' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-} + -- | $\mathcal{O}(1)$. Test whether a list is empty. -- -- >>> null [] ===================================== libraries/ghc-internal/src/GHC/Internal/System/IO.hs ===================================== @@ -825,11 +825,12 @@ output_flags = std_flags where -- XXX bits copied from System.FilePath, since that's not available here - combine a b - | null b = a - | null a = b - | pathSeparator [last a] = a ++ b - | otherwise = a ++ [pathSeparatorChar] ++ b + combine a [] = a + combine a b = case unsnoc a of + Nothing -> b + Just (_, lastA) + | pathSeparator [lastA] -> a ++ b + | otherwise -> a ++ [pathSeparatorChar] ++ b tempCounter :: IORef Int tempCounter = unsafePerformIO $ newIORef 0 ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs ===================================== @@ -39,6 +39,7 @@ import Control.Exception.Base (FixIOException (..)) import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar) import System.IO ( hPutStrLn, stderr ) import Data.Char ( isAlpha, isAlphaNum, isUpper ) +import Data.List ( unsnoc ) import Data.List.NonEmpty ( NonEmpty(..) ) import Data.Word import qualified Data.Kind as Kind (Type) @@ -54,6 +55,7 @@ import GHC.Internal.Base hiding (NonEmpty(..),Type, Module, sequence) import GHC.Internal.Data.Data hiding (Fixity(..)) import GHC.Internal.Data.NonEmpty (NonEmpty(..)) import GHC.Internal.Data.Traversable +import GHC.Internal.List (unsnoc) import GHC.Internal.Word import GHC.Internal.Generics (Generic) import GHC.Internal.IORef @@ -73,7 +75,7 @@ import GHC.Internal.Control.Monad.Fix import GHC.Internal.Control.Exception import GHC.Internal.Num import GHC.Internal.IO.Unsafe -import GHC.Internal.List (dropWhile, break, replicate, reverse, last) +import GHC.Internal.List (dropWhile, break, replicate, reverse) import GHC.Internal.MVar import GHC.Internal.IO.Exception import GHC.Internal.Unicode @@ -1296,7 +1298,7 @@ mkName str -- (i.e. non-empty, starts with capital, all alpha) is_rev_mod_name rev_mod_str | (compt, rest) <- break (== '.') rev_mod_str - , not (null compt), isUpper (last compt), all is_mod_char compt + , Just (_, lastCompt) <- unsnoc compt, isUpper lastCompt, all is_mod_char compt = case rest of [] -> True (_dot : rest') -> is_rev_mod_name rest' ===================================== libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs ===================================== @@ -104,7 +104,7 @@ module System.FilePath.Windows import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper) import Data.Maybe(isJust) -import Data.List(stripPrefix, isSuffixOf) +import Data.List(stripPrefix, isSuffixOf, uncons, unsnoc) import System.Environment(getEnv) @@ -203,14 +203,20 @@ isExtSeparator = (== extSeparator) splitSearchPath :: String -> [FilePath] splitSearchPath = f where - f xs = case break isSearchPathSeparator xs of - (pre, [] ) -> g pre - (pre, _:post) -> g pre ++ f post - - g "" = ["." | isPosix] - g ('\"':x@(_:_)) | isWindows && last x == '\"' = [init x] - g x = [x] - + f xs = let (pre, post) = break isSearchPathSeparator xs + in case uncons post of + Nothing -> g pre + Just (_, t) -> g pre ++ f t + + g x = case uncons x of + Nothing -> ["." | isPosix] + Just (h, t) + | h == '"' + , Just{} <- uncons t -- >= 2 + , isWindows + , Just (i, l) <- unsnoc t + , l == '"' -> [i] + | otherwise -> [x] -- | Get a list of 'FilePath's in the $PATH variable. getSearchPath :: IO [FilePath] @@ -233,12 +239,17 @@ getSearchPath = fmap splitSearchPath (getEnv "PATH") -- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred") -- > splitExtension "file/path.txt/" == ("file/path.txt/","") splitExtension :: FilePath -> (String, String) -splitExtension x = case nameDot of - "" -> (x,"") - _ -> (dir ++ init nameDot, extSeparator : ext) - where - (dir,file) = splitFileName_ x - (nameDot,ext) = breakEnd isExtSeparator file +splitExtension x = case unsnoc nameDot of + -- Imagine x = "no-dots", then nameDot = "" + Nothing -> (x, mempty) + Just (initNameDot, _) + -- Imagine x = "\\shared.with.dots\no-dots" + | isWindows && null (dropDrive nameDot) -> (x, mempty) + -- Imagine x = "dir.with.dots/no-dots" + | any isPathSeparator ext -> (x, mempty) + | otherwise -> (initNameDot, extSeparator : ext) + where + (nameDot, ext) = breakEnd isExtSeparator x -- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise. -- @@ -594,9 +605,13 @@ replaceBaseName pth nam = combineAlways a (nam <.> ext) -- > hasTrailingPathSeparator "test" == False -- > hasTrailingPathSeparator "test/" == True hasTrailingPathSeparator :: FilePath -> Bool -hasTrailingPathSeparator "" = False -hasTrailingPathSeparator x = isPathSeparator (last x) +hasTrailingPathSeparator = isJust . getTrailingPathSeparator +getTrailingPathSeparator :: FilePath -> Maybe Char +getTrailingPathSeparator x = case unsnoc x of + Just (_, lastX) + | isPathSeparator lastX -> Just lastX + _ -> Nothing hasLeadingPathSeparator :: FilePath -> Bool hasLeadingPathSeparator "" = False @@ -619,12 +634,12 @@ addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pat -- > Windows: dropTrailingPathSeparator "\\" == "\\" -- > Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x dropTrailingPathSeparator :: FilePath -> FilePath -dropTrailingPathSeparator x = - if hasTrailingPathSeparator x && not (isDrive x) - then let x' = dropWhileEnd isPathSeparator x - in if null x' then [last x] else x' - else x - +dropTrailingPathSeparator x = case getTrailingPathSeparator x of + Just lastX + | not (isDrive x) + -> let x' = dropWhileEnd isPathSeparator x + in if null x' then [lastX] else x' + _ -> x -- | Get the directory name, move up one level. -- @@ -863,28 +878,37 @@ makeRelative root path -- > Posix: normalise "bob/fred/." == "bob/fred/" -- > Posix: normalise "//home" == "/home" normalise :: FilePath -> FilePath -normalise path = result ++ [pathSeparator | addPathSeparator] - where - (drv,pth) = splitDrive path - result = joinDrive' (normaliseDrive drv) (f pth) +normalise filepath = + result <> + (if addPathSeparator + then [pathSeparator] + else mempty) + where + (drv,pth) = splitDrive filepath + + result = joinDrive' (normaliseDrive drv) (f pth) - joinDrive' "" "" = "." - joinDrive' d p = joinDrive d p + joinDrive' d p + = if null d && null p + then "." + else joinDrive d p - addPathSeparator = isDirPath pth - && not (hasTrailingPathSeparator result) - && not (isRelativeDrive drv) + addPathSeparator = isDirPath pth + && not (hasTrailingPathSeparator result) + && not (isRelativeDrive drv) - isDirPath xs = hasTrailingPathSeparator xs - || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs) + isDirPath xs = hasTrailingPathSeparator xs || case unsnoc xs of + Nothing -> False + Just (initXs, lastXs) -> lastXs == '.' && hasTrailingPathSeparator initXs - f = joinPath . dropDots . propSep . splitDirectories + f = joinPath . dropDots . propSep . splitDirectories - propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs - | otherwise = x : xs - propSep [] = [] + propSep (x:xs) + | all isPathSeparator x = [pathSeparator] : xs + | otherwise = x : xs + propSep [] = [] - dropDots = filter ("." /=) + dropDots = filter ("." /=) normaliseDrive :: FilePath -> FilePath normaliseDrive "" = "" ===================================== testsuite/tests/driver/j-space/jspace.hs ===================================== @@ -7,7 +7,7 @@ import System.Environment import GHC.Driver.Env.Types import GHC.Profiling import System.Mem -import Data.List (isPrefixOf) +import Data.List (isPrefixOf, unsnoc) import Control.Monad import System.Exit import GHC.Platform @@ -41,7 +41,9 @@ initGhcM xs = do requestHeapCensus performGC [ys] <- filter (isPrefixOf (ghcUnitId <> ":GHC.Unit.Module.ModDetails.ModDetails")) . lines <$> readFile "jspace.hp" - let (n :: Int) = read (last (words ys)) + let (n :: Int) = case unsnoc (words ys) of + Nothing -> error "input is unexpectedly empty" + Just (_, lst) -> read lst -- The output should be 50 * 8 * word_size (i.e. 3600, or 1600 on 32-bit architectures): -- the test contains DEPTH + WIDTH + 2 = 50 modules J, H_0, .., H_DEPTH, W_1, .., W_WIDTH, -- and each ModDetails contains 1 (info table) + 8 word-sized fields. ===================================== testsuite/tests/rts/KeepCafsBase.hs ===================================== @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-x-partial #-} + module KeepCafsBase (x) where x :: Int ===================================== utils/check-exact/Utils.hs ===================================== @@ -37,7 +37,7 @@ import GHC.Base (NonEmpty(..)) import GHC.Parser.Lexer (allocateComments) import Data.Data hiding ( Fixity ) -import Data.List (sortBy, partition) +import Data.List (sortBy, partition, unsnoc) import qualified Data.Map.Strict as Map import Debug.Trace @@ -734,8 +734,9 @@ ghead info [] = error $ "ghead "++info++" []" ghead _info (h:_) = h glast :: String -> [a] -> a -glast info [] = error $ "glast " ++ info ++ " []" -glast _info h = last h +glast info xs = case unsnoc xs of + Nothing -> error $ "glast " ++ info ++ " []" + Just (_, lst) -> lst gtail :: String -> [a] -> [a] gtail info [] = error $ "gtail " ++ info ++ " []" ===================================== utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs ===================================== @@ -755,7 +755,7 @@ ppHtmlIndex divAlphabet << unordList ( map (\str -> anchor ! [href (subIndexHtmlFile str)] << str) $ - [ [c] | c <- initialChars, any ((== c) . toUpper . head . fst) index + [ [c] | c <- initialChars, any (maybe False ((== c) . toUpper . fst) . List.uncons . fst) index ] ++ [merged_name] ) @@ -772,7 +772,7 @@ ppHtmlIndex writeUtf8File (joinPath [odir, subIndexHtmlFile [c]]) (renderToString debug html) where html = indexPage True (Just c) index_part - index_part = [(n, stuff) | (n, stuff) <- this_ix, toUpper (head n) == c] + index_part = [(n, stuff) | (n@(headN : _), stuff) <- this_ix, toUpper headN == c] index :: [(String, Map GHC.Name [(Module, Bool)])] index = sortBy cmp (Map.toAscList full_index) ===================================== utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs ===================================== @@ -30,7 +30,7 @@ import Control.Arrow (first) import Control.Monad import Data.Char (chr, isAlpha, isSpace, isUpper) import Data.Functor (($>)) -import Data.List (elemIndex, intercalate, intersperse, unfoldr) +import Data.List (elemIndex, intercalate, intersperse, unfoldr, unsnoc) import Data.Maybe (fromMaybe, mapMaybe) import Data.Monoid import qualified Data.Set as Set @@ -870,10 +870,10 @@ codeblock = DocCodeBlock . parseParagraph . dropSpaces <$> ("@" *> skipHorizontalSpace *> "\n" *> block' <* "@") where - dropSpaces xs = - case splitByNl xs of - [] -> xs - ys -> case T.uncons (last ys) of + dropSpaces xs = let ys = splitByNl xs in + case unsnoc ys of + Nothing -> xs + Just (_, lastYs) -> case T.uncons lastYs of Just (' ', _) -> case mapM dropSpace ys of Nothing -> xs Just zs -> T.intercalate "\n" zs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3da640443d33216ac5f6a235baf0d41… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3da640443d33216ac5f6a235baf0d41… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/24212] Still work to do
by Rodrigo Mesquita (＠alt-romes) 10 Jul '25

10 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/24212 at Glasgow Haskell Compiler / GHC Commits: db272f43 by Rodrigo Mesquita at 2025-07-10T22:11:19+01:00 Still work to do - - - - - 4 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs Changes: ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -145,6 +145,7 @@ import GHC.Foreign (withCString, peekCString) import qualified Data.Set as Set import qualified GHC.LanguageExtensions as LangExt +import GHC.Toolchain.Target (Target) -- ----------------------------------------------------------------------------- -- DynFlags @@ -178,6 +179,7 @@ data DynFlags = DynFlags { toolSettings :: {-# UNPACK #-} !ToolSettings, platformMisc :: {-# UNPACK #-} !PlatformMisc, rawSettings :: [(String, String)], + rawTarget :: Target, tmpDir :: TempDir, llvmOptLevel :: Int, -- ^ LLVM optimisation level @@ -656,6 +658,7 @@ defaultDynFlags mySettings = targetPlatform = sTargetPlatform mySettings, platformMisc = sPlatformMisc mySettings, rawSettings = sRawSettings mySettings, + rawTarget = sRawTarget mySettings, tmpDir = panic "defaultDynFlags: uninitialized tmpDir", ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3454,8 +3454,68 @@ 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)) - (rawSettings dflags) + -- TODO: + -- : map (fmap $ ) + -- (rawSettings dflags) + : + [("C compiler command", query), + ("C compiler flags", "$(SettingsCCompilerFlags)"), + ("C++ compiler command", "$(SettingsCxxCompilerCommand)"), + ("C++ compiler flags", "$(SettingsCxxCompilerFlags)"), + ("C compiler link flags", "$(SettingsCCompilerLinkFlags)"), + ("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)"), + ("CPP command", "$(SettingsCPPCommand)"), + ("CPP flags", "$(SettingsCPPFlags)"), + ("Haskell CPP command", "$(SettingsHaskellCPPCommand)"), + ("Haskell CPP flags", "$(SettingsHaskellCPPFlags)"), + ("JavaScript CPP command", "$(SettingsJavaScriptCPPCommand)"), + ("JavaScript CPP flags", "$(SettingsJavaScriptCPPFlags)"), + ("C-- CPP command", "$(SettingsCmmCPPCommand)"), + ("C-- CPP flags", "$(SettingsCmmCPPFlags)"), + ("C-- CPP supports -g0", "$(SettingsCmmCPPSupportsG0)"), + ("ld supports compact unwind", "$(LdHasNoCompactUnwind)"), + ("ld supports filelist", "$(LdHasFilelist)"), + ("ld supports single module", "$(LdHasSingleModule)"), + ("ld is GNU ld", "$(LdIsGNULd)"), + ("Merge objects command", "$(SettingsMergeObjectsCommand)"), + ("Merge objects flags", "$(SettingsMergeObjectsFlags)"), + ("Merge objects supports response files", "$(MergeObjsSupportsResponseFiles)"), + ("ar command", "$(SettingsArCommand)"), + ("ar flags", "$(ArArgs)"), + ("ar supports at file", "$(ArSupportsAtFile)"), + ("ar supports -L", "$(ArSupportsDashL)"), + ("ranlib command", "$(SettingsRanlibCommand)"), + ("otool command", "$(SettingsOtoolCommand)"), + ("install_name_tool command", "$(SettingsInstallNameToolCommand)"), + ("windres command", "$(SettingsWindresCommand)"), + ("unlit command", "$$topdir/../bin/$(CrossCompilePrefix)unlit"), + ("cross compiling", "$(CrossCompiling)"), + ("target platform string", "$(TARGETPLATFORM)"), + ("target os", "$(HaskellTargetOs)"), + ("target arch", "$(HaskellTargetArch)"), + ("target word size", "$(TargetWordSize)"), + ("target word big endian", "$(TargetWordBigEndian)"), + ("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)"), + ("target has .ident directive", "$(TargetHasIdentDirective)"), + ("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)"), + ("target has libm", "$(TargetHasLibm)"), + ("Unregisterised", "$(GhcUnregisterised)"), + ("LLVM target", "$(LLVMTarget)"), + ("LLVM llc command", "$(SettingsLlcCommand)"), + ("LLVM opt command", "$(SettingsOptCommand)"), + ("LLVM llvm-as command", "$(SettingsLlvmAsCommand)"), + ("LLVM llvm-as flags", "$(SettingsLlvmAsFlags)"), + ("target RTS linker only supports shared libraries", "$(TargetRTSLinkerOnlySupportsSharedLibs)"), + ("Use interpreter", "$(GhcWithInterpreter)"), + ("Support SMP", "$(GhcWithSMP)"), + ("RTS ways", "$(GhcRTSWays)"), + ("Tables next to code", "$(TablesNextToCode)"), + ("Leading underscore", "$(LeadingUnderscore)"), + ("Use LibFFI", "$(UseLibffiForAdjustors)"), + ("RTS expects libdw", "$(GhcRtsWithLibdw)"), + ("Relative Global Package DB", "package.conf.d"), + ("base unit-id", "$(BaseUnitId)") + ] ++ [("Project version", projectVersion dflags), ("Project Git commit id", cProjectGitCommitId), ("Project Version Int", cProjectVersionInt), @@ -3513,8 +3573,8 @@ compilerInfo dflags showBool False = "NO" platform = targetPlatform dflags isWindows = platformOS platform == OSMinGW32 - expandDirectories :: FilePath -> Maybe FilePath -> String -> String - expandDirectories topd mtoold = expandToolDir mtoold . expandTopDir topd + expandDirectories = expandToolDir (toolDir dflags) . expandTopDir (topDir dflags) + query f = f (rawTarget dflags) -- Note [Special unit-ids] -- ~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Settings.hs ===================================== @@ -74,6 +74,7 @@ import GHC.Utils.CliOption import GHC.Utils.Fingerprint import GHC.Platform import GHC.Unit.Types +import GHC.Toolchain.Target data Settings = Settings { sGhcNameVersion :: {-# UNPACk #-} !GhcNameVersion @@ -86,6 +87,10 @@ data Settings = Settings -- You shouldn't need to look things up in rawSettings directly. -- They should have their own fields instead. , sRawSettings :: [(String, String)] + + -- Store the target to print out information about the raw target description + -- (e.g. in --info) + , sRawTarget :: Target } data UnitSettings = UnitSettings { unitSettings_baseUnitId :: !UnitId } ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -239,6 +239,7 @@ initSettings top_dir = do } , sRawSettings = settingsList + , sRawTarget = target } getTargetPlatform :: Bool {-^ Does target have libm -} -> Target -> Platform View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/db272f43c702343f3941bc1716a823d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/db272f43c702343f3941bc1716a823d… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/24212] Doing
by Rodrigo Mesquita (＠alt-romes) 10 Jul '25

10 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/24212 at Glasgow Haskell Compiler / GHC Commits: 7ad095f0 by Rodrigo Mesquita at 2025-07-10T18:31:48+01:00 Doing - - - - - 3 changed files: - distrib/configure.ac.in - hadrian/bindist/Makefile - + m4/subst_tooldir.m4 Changes: ===================================== distrib/configure.ac.in ===================================== @@ -417,6 +417,34 @@ AC_OUTPUT VALIDATE_GHC_TOOLCHAIN([default.target],[default.target.ghc-toolchain]) +if test "$EnableDistroToolchain" = "YES"; then + # If the user specified --enable-distro-toolchain then we just use the + # executable names, not paths. We do this by finding strings of paths to + # programs and keeping the basename only: + cp default.target default.target.bak + + while IFS= read -r line; do + if echo "$line" | grep -q 'prgPath = "'; then + path=$(echo "$line" | sed -E 's/.*prgPath = "([[^"]]+)".*/\1/') + base=$(basename "$path") + echo "$line" | sed "s|$path|$base|" + else + echo "$line" + fi + done < default.target.bak > default.target + echo "Applied --enable-distro-toolchain basename substitution to default.target:" + cat default.target +fi + +if test "$windows" = YES -a "$EnableDistroToolchain" = "NO"; then + # Handle the Windows toolchain installed in FP_SETUP_WINDOWS_TOOLCHAIN. + # We need to issue a substitution to use $tooldir, + # See Note [tooldir: How GHC finds mingw on Windows] + SUBST_TOOLDIR([default.target]) + echo "Applied tooldir substitution to default.target:" + cat default.target +fi + rm -Rf acargs acghc-toolchain actmp-ghc-toolchain echo "****************************************************" ===================================== hadrian/bindist/Makefile ===================================== @@ -87,6 +87,7 @@ lib/settings : config.mk @rm -f $@ @echo '[("target os", "$(HaskellTargetOs)")' >> $@ @echo ',("target arch", "$(HaskellTargetArch)")' >> $@ + @echo ',("target has libm", "$(TargetHasLibm)")' >> $@ @echo ',("unlit command", "$$topdir/../bin/$(CrossCompilePrefix)unlit")' >> $@ @echo ',("target RTS linker only supports shared libraries", "$(TargetRTSLinkerOnlySupportsSharedLibs)")' >> $@ @echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@ @@ -97,9 +98,10 @@ lib/settings : config.mk @echo ',("base unit-id", "$(BaseUnitId)")' >> $@ @echo "]" >> $@ -lib/targets/default.target : config.mk +lib/targets/default.target : config.mk default.target @rm -f $@ - @echo "DOING DEFAULT.TARGET" + @echo "Copying the bindist-configured default.target to lib/targets/default.target" + cp default.target $@ # We need to install binaries relative to libraries. BINARIES = $(wildcard ./bin/*) ===================================== m4/subst_tooldir.m4 ===================================== @@ -0,0 +1,45 @@ +dnl Note [How we configure the bundled windows toolchain] +dnl ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +dnl As per Note [tooldir: How GHC finds mingw on Windows], when using the +dnl bundled windows toolchain, the GHC settings file must refer to the +dnl toolchain through a path relative to $tooldir (binary distributions on +dnl Windows should work without configure, so the paths must be relative to the +dnl installation). However, hadrian expects the configured toolchain to use +dnl full paths to the executable. +dnl +dnl This is how the bundled windows toolchain is configured, to define the +dnl toolchain with paths to the executables, while still writing into GHC +dnl settings the paths relative to $tooldir: +dnl +dnl * If using the bundled toolchain, FP_SETUP_WINDOWS_TOOLCHAIN will be invoked +dnl +dnl * FP_SETUP_WINDOWS_TOOLCHAIN will set the toolchain variables to paths +dnl to the bundled toolchain (e.g. CFLAGS=/full/path/to/mingw/bin/gcc) +dnl +dnl * Later on, at the end of distrib/configure.ac, we substitute occurrences of the path to the +dnl mingw tooldir by $tooldir (see SUBST_TOOLDIR). +dnl The reason is the Settings* variants of toolchain variables are used by the bindist configure to +dnl create the settings file, which needs the windows bundled toolchain to be relative to $tooldir. +dnl +dnl The ghc-toolchain program isn't concerned with any of these complications: +dnl it is passed either the full paths to the toolchain executables, or the bundled +dnl mingw path is set first on $PATH before invoking it. And ghc-toolchain +dnl will, as always, output target files with full paths to the executables. +dnl +dnl Hadrian accounts for this as it does for the toolchain executables +dnl configured by configure -- in fact, hadrian doesn't need to know whether +dnl the toolchain description file was generated by configure or by +dnl ghc-toolchain. + +# SUBST_TOOLDIR +# ---------------------------------- +# $1 - the filepath where to search for occurrences of the path to the +# inplace mingw, and update by substituting said occurrences by +# the value of $mingw_install_prefix, where the mingw toolchain will be at +# install time +# +# See Note [How we configure the bundled windows toolchain] +AC_DEFUN([SUBST_TOOLDIR], +[ + sed -i.bkp $1 's%'"$mingw_prefix"'%'"$mingw_install_prefix"'%g' +]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ad095f064fc71abdf8866045c9cb29… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7ad095f064fc71abdf8866045c9cb29… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/24212] 3 commits: SettingsLdCommand
by Rodrigo Mesquita (＠alt-romes) 10 Jul '25

10 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/24212 at Glasgow Haskell Compiler / GHC Commits: 84763b70 by Rodrigo Mesquita at 2025-07-10T14:48:45+01:00 SettingsLdCommand - - - - - 02d8d9e5 by Rodrigo Mesquita at 2025-07-10T17:23:46+01:00 Doing it - - - - - f2ac37e0 by Rodrigo Mesquita at 2025-07-10T18:14:17+01:00 Doing - - - - - 12 changed files: - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/BaseDir.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - m4/fp_setup_windows_toolchain.m4 - m4/fp_settings.m4 → m4/subst_tooldir.m4 - utils/ghc-toolchain/exe/Main.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3513,9 +3513,8 @@ compilerInfo dflags showBool False = "NO" 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 topd mtoold = expandToolDir mtoold . expandTopDir topd -- Note [Special unit-ids] -- ~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Settings.hs ===================================== @@ -23,7 +23,6 @@ module GHC.Settings , sMergeObjsSupportsResponseFiles , sLdIsGnuLd , sGccSupportsNoPie - , sUseInplaceMinGW , sArSupportsDashL , sPgm_L , sPgm_P @@ -102,7 +101,6 @@ data ToolSettings = ToolSettings , toolSettings_mergeObjsSupportsResponseFiles :: Bool , toolSettings_ldIsGnuLd :: Bool , toolSettings_ccSupportsNoPie :: Bool - , toolSettings_useInplaceMinGW :: Bool , toolSettings_arSupportsDashL :: Bool , toolSettings_cmmCppSupportsG0 :: Bool @@ -221,8 +219,6 @@ sLdIsGnuLd :: Settings -> Bool sLdIsGnuLd = toolSettings_ldIsGnuLd . sToolSettings sGccSupportsNoPie :: Settings -> Bool sGccSupportsNoPie = toolSettings_ccSupportsNoPie . sToolSettings -sUseInplaceMinGW :: Settings -> Bool -sUseInplaceMinGW = toolSettings_useInplaceMinGW . sToolSettings sArSupportsDashL :: Settings -> Bool sArSupportsDashL = toolSettings_arSupportsDashL . sToolSettings ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -68,16 +68,10 @@ initSettings top_dir = do getBooleanSetting key = either pgmError pure $ getRawBooleanSetting settingsFile mySettings key - -- On Windows, by mingw is often distributed with GHC, - -- so we look in TopDir/../mingw/bin, - -- as well as TopDir/../../mingw/bin for hadrian. - -- 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 + mtool_dir <- liftIO $ findToolDir top_dir -- see Note [tooldir: How GHC finds mingw on Windows] let getSetting_raw key = either pgmError pure $ @@ -85,11 +79,11 @@ initSettings top_dir = do getSetting_topDir top key = either pgmError pure $ getRawFilePathSetting top settingsFile mySettings key getSetting_toolDir top tool key = - expandToolDir useInplaceMinGW tool <$> getSetting_topDir top key + expandToolDir tool <$> getSetting_topDir top key getSetting key = getSetting_topDir top_dir key getToolSetting key = getSetting_toolDir top_dir mtool_dir key - expandDirVars top tool = expandToolDir useInplaceMinGW tool . expandTopDir top + expandDirVars top tool = expandToolDir tool . expandTopDir top getToolPath :: (Target -> Program) -> String getToolPath key = expandDirVars top_dir mtool_dir (prgPath . key $ target) @@ -189,7 +183,6 @@ initSettings top_dir = do , toolSettings_mergeObjsSupportsResponseFiles = maybe False mergeObjsSupportsResponseFiles $ tgtMergeObjs target - , toolSettings_useInplaceMinGW = useInplaceMinGW , toolSettings_arSupportsDashL = arSupportsDashL $ tgtAr target , toolSettings_cmmCppSupportsG0 = cmmCppSupportsG0 $ tgtCmmCPreprocessor target ===================================== compiler/GHC/SysTools/BaseDir.hs ===================================== @@ -119,15 +119,14 @@ 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 + :: 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 +expandToolDir (Just tool_dir) s = expandPathVar "tooldir" tool_dir s +expandToolDir Nothing _ = panic "Could not determine $tooldir" +expandToolDir _ s = s #else -expandToolDir _ _ s = s +expandToolDir _ s = s #endif -- | Returns a Unix-format path pointing to TopDir. @@ -161,13 +160,13 @@ tryFindTopDir Nothing -- 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@. --- If the distro toolchain is being used we treat Windows the same as Linux +-- If the distro toolchain is being used, there will be no variables to +-- substitute for anyway, so this is a no-op. findToolDir - :: Bool -- ^ whether we use the ambient mingw toolchain - -> FilePath -- ^ topdir + :: FilePath -- ^ topdir -> IO (Maybe FilePath) #if defined(mingw32_HOST_OS) -findToolDir False top_dir = go 0 (top_dir </> "..") [] +findToolDir top_dir = go 0 (top_dir </> "..") [] where maxDepth = 3 go :: Int -> FilePath -> [FilePath] -> IO (Maybe FilePath) go k path tried @@ -180,7 +179,7 @@ findToolDir False top_dir = go 0 (top_dir </> "..") [] if oneLevel then return (Just path) else go (k+1) (path </> "..") tried' -findToolDir True _ = return Nothing +findToolDir _ = return Nothing #else -findToolDir _ _ = return Nothing +findToolDir _ = return Nothing #endif ===================================== configure.ac ===================================== @@ -132,6 +132,7 @@ AC_ARG_ENABLE(distro-toolchain, [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableDistroToolchain])], [EnableDistroToolchain=NO] ) +AC_SUBST([EnableDistroToolchain]) if test "$EnableDistroToolchain" = "YES"; then TarballsAutodownload=NO @@ -752,8 +753,6 @@ FP_PROG_AR_NEEDS_RANLIB dnl ** Check to see whether ln -s works AC_PROG_LN_S -FP_SETTINGS - dnl ** Find the path to sed AC_PATH_PROGS(SedCmd,gsed sed,sed) ===================================== distrib/configure.ac.in ===================================== @@ -91,6 +91,7 @@ AC_ARG_ENABLE(distro-toolchain, [FP_CAPITALIZE_YES_NO(["$enableval"], [EnableDistroToolchain])], [EnableDistroToolchain=@EnableDistroToolchain@] ) +AC_SUBST([EnableDistroToolchain]) if test "$HostOS" = "mingw32" -a "$EnableDistroToolchain" = "NO"; then FP_SETUP_WINDOWS_TOOLCHAIN([$hardtop/mingw/], [\$\$topdir/../mingw/]) @@ -384,8 +385,6 @@ fi AC_SUBST(BaseUnitId) -FP_SETTINGS - # We get caught by # http://savannah.gnu.org/bugs/index.php?1516 # $(eval ...) inside conditionals causes errors @@ -418,6 +417,32 @@ AC_OUTPUT VALIDATE_GHC_TOOLCHAIN([default.target],[default.target.ghc-toolchain]) +if test "$EnableDistroToolchain" = "YES"; then + # If the user specified --enable-distro-toolchain then we just use the + # executable names, not paths. We do this by finding strings of paths to + # programs and keeping the basename only: + cp Target.hs Target.hs.bak + + while IFS= read -r line; do + if echo "$line" | grep -q 'prgPath = "'; then + path=$(echo "$line" | sed -E 's/.*prgPath = "([^"]+)".*/\1/') + base=$(basename "$path") + echo "$line" | sed "s|$path|$base|" + else + echo "$line" + fi + done < Target.hs.bak > Target.hs +fi + +if test "$windows" = YES -a "$EnableDistroToolchain" = "NO"; then + # Handle the Windows toolchain installed in FP_SETUP_WINDOWS_TOOLCHAIN. + # We need to issue a substitution to use $tooldir, + # See Note [tooldir: How GHC finds mingw on Windows] + SUBST_TOOLDIR([default.target]) + echo "Applied tooldir substitution to default.target:" + cat default.target +fi + rm -Rf acargs acghc-toolchain actmp-ghc-toolchain echo "****************************************************" ===================================== hadrian/bindist/Makefile ===================================== @@ -87,8 +87,8 @@ lib/settings : config.mk @rm -f $@ @echo '[("target os", "$(HaskellTargetOs)")' >> $@ @echo ',("target arch", "$(HaskellTargetArch)")' >> $@ + @echo ',("target has libm", "$(TargetHasLibm)")' >> $@ @echo ',("unlit command", "$$topdir/../bin/$(CrossCompilePrefix)unlit")' >> $@ - @echo ',("Use inplace MinGW toolchain", "$(EnableDistroToolchain)")' >> $@ @echo ',("target RTS linker only supports shared libraries", "$(TargetRTSLinkerOnlySupportsSharedLibs)")' >> $@ @echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@ @echo ',("Support SMP", "$(GhcWithSMP)")' >> $@ @@ -98,6 +98,11 @@ lib/settings : config.mk @echo ',("base unit-id", "$(BaseUnitId)")' >> $@ @echo "]" >> $@ +lib/targets/default.target : config.mk default.target + @rm -f $@ + @echo "Copying the bindist-configured default.target to lib/targets/default.target" + cp default.target $@ + # We need to install binaries relative to libraries. BINARIES = $(wildcard ./bin/*) .PHONY: install_bin_libdir ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -141,7 +141,6 @@ bindistRules = do installPrefix <- fromMaybe (error prefixErr) <$> cmdPrefix installTo NotRelocatable installPrefix - -- TODO: ROMES: TOUCH HERE? phony "binary-dist-dir" $ do version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -487,7 +487,6 @@ generateSettings settingsFile = do , ("target arch", queryTarget (show . archOS_arch . tgtArchOs)) , ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) , ("target has libm", expr $ lookupSystemConfig "target-has-libm") - , ("Use inplace MinGW toolchain", expr $ lookupSystemConfig "settings-use-distro-mingw") , ("target RTS linker only supports shared libraries", expr $ yesNo <$> targetRTSLinkerOnlySupportsSharedLibs) , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) , ("Support SMP", expr $ yesNo <$> targetSupportsSMP) ===================================== m4/fp_setup_windows_toolchain.m4 ===================================== @@ -77,6 +77,7 @@ AC_DEFUN([FP_INSTALL_WINDOWS_TOOLCHAIN],[ # $2 the location that the windows toolchain will be installed in relative to the libdir AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[ + # TODO: UPDATE COMMENT # N.B. The parameters which get plopped in the `settings` file used by the # resulting compiler are computed in `FP_SETTINGS`. Specifically, we use # $$topdir-relative paths instead of fullpaths to the toolchain, by replacing ===================================== m4/fp_settings.m4 → m4/subst_tooldir.m4 ===================================== @@ -16,13 +16,11 @@ dnl dnl * FP_SETUP_WINDOWS_TOOLCHAIN will set the toolchain variables to paths dnl to the bundled toolchain (e.g. CFLAGS=/full/path/to/mingw/bin/gcc) dnl -dnl * Later on, in FP_SETTINGS, we substitute occurrences of the path to the +dnl * Later on, at the end of distrib/configure.ac, we substitute occurrences of the path to the dnl mingw tooldir by $tooldir (see SUBST_TOOLDIR). dnl The reason is the Settings* variants of toolchain variables are used by the bindist configure to dnl create the settings file, which needs the windows bundled toolchain to be relative to $tooldir. dnl -dnl * Finally, hadrian will also substitute the mingw prefix by $tooldir before writing the toolchain to the settings file (see generateSettings) -dnl dnl The ghc-toolchain program isn't concerned with any of these complications: dnl it is passed either the full paths to the toolchain executables, or the bundled dnl mingw path is set first on $PATH before invoking it. And ghc-toolchain @@ -35,7 +33,7 @@ dnl ghc-toolchain. # SUBST_TOOLDIR # ---------------------------------- -# $1 - the variable where to search for occurrences of the path to the +# $1 - the filepath where to search for occurrences of the path to the # inplace mingw, and update by substituting said occurrences by # the value of $mingw_install_prefix, where the mingw toolchain will be at # install time @@ -43,30 +41,5 @@ dnl ghc-toolchain. # See Note [How we configure the bundled windows toolchain] AC_DEFUN([SUBST_TOOLDIR], [ - dnl and Note [How we configure the bundled windows toolchain] - $1=`echo "$$1" | sed 's%'"$mingw_prefix"'%'"$mingw_install_prefix"'%g'` -]) - -# FP_SETTINGS -# ---------------------------------- -# Set the variables used in the settings file -AC_DEFUN([FP_SETTINGS], -[ - # LLVM backend tools - - if test "$EnableDistroToolchain" = "YES"; then - # If the user specified --enable-distro-toolchain then we just use the - # executable names, not paths. - dnl XXX="$(basename XXX)" - SettingsLdCommand="$(basename $SettingsLdCommand)" - fi - - if test "$windows" = YES -a "$EnableDistroToolchain" = "NO"; then - # Handle the Windows toolchain installed in FP_SETUP_WINDOWS_TOOLCHAIN. - # We need to issue a substitution to use $tooldir, - # See Note [tooldir: How GHC finds mingw on Windows] - dnl SUBST_TOOLDIR([XXX]) - fi - - AC_SUBST(EnableDistroToolchain) + sed -i.bkp $1 's%'"$mingw_prefix"'%'"$mingw_install_prefix"'%g' ]) ===================================== utils/ghc-toolchain/exe/Main.hs ===================================== @@ -534,4 +534,3 @@ mkTarget opts = do } return t ---- ROMES:TODO: fp_settings.m4 in general which I don't think was ported completely (e.g. the basenames and windows llvm-XX and such) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/656841725bc1ed58fc2789e3e1a487… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/656841725bc1ed58fc2789e3e1a487… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/rafl/cover-data
by Florian Ragwitz (＠rafl) 10 Jul '25

10 Jul '25

Florian Ragwitz pushed new branch wip/rafl/cover-data at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/rafl/cover-data You're receiving this email because of your account on gitlab.haskell.org.

1 0