- ghc-commits - Haskell.org

[Git][ghc/ghc][master] configure: Bump minimal bootstrap GHC version to 9.8
by Marge Bot (＠marge-bot) 20 Aug '25

20 Aug '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c8882ed7 by Ben Gamari at 2025-08-20T11:55:49-04:00 configure: Bump minimal bootstrap GHC version to 9.8 - - - - - 1 changed file: - configure.ac Changes: ===================================== configure.ac ===================================== @@ -219,7 +219,7 @@ if test "$WithGhc" = "" then AC_MSG_ERROR([GHC is required.]) fi -MinBootGhcVersion="9.6" +MinBootGhcVersion="9.8" FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[$MinBootGhcVersion], [AC_MSG_ERROR([GHC version $MinBootGhcVersion or later is required to compile GHC.])]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8882ed707c2542efe42d0967c74d23… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8882ed707c2542efe42d0967c74d23… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Start with empty inerts in shortcut solving
by Marge Bot (＠marge-bot) 20 Aug '25

20 Aug '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ccda188d by Simon Peyton Jones at 2025-08-20T11:55:07-04:00 Start with empty inerts in shortcut solving When short-cut solving we were starting with an inert set that had unsolved Wanteds. This caused an infinite loop (#26314), because a typechecker plugin kept being given that unsolved Wanted. It's better just to start with an empty inert set - - - - - 3 changed files: - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs Changes: ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -588,22 +588,24 @@ solving fails and we use the superclass of C: The moving parts are relatively simple: * To attempt to solve the constraint completely, we just recursively - call the constraint solver. See the use of `tryTcS` in + call the constraint solver. See the use of `tryShortCutTcS` in `tcShortCutSolver`. -* When this attempted recursive solving, we set a special mode - `TcSShortCut`, which signals that we are trying to solve using only - top-level instances. We switch on `TcSShortCut` mode in - `tryShortCutSolver`. +* When this attempted recursive solving, in `tryShortCutTcS`, we + - start with an empty inert set: no Givens and no Wanteds + - set a special mode `TcSShortCut`, which signals that we are trying to solve + using only top-level instances. -* When in TcSShortCut mode, we behave specially in a few places: - - `tryInertDicts`, where we would otherwise look for a Given to solve our Wanted - - `GHC.Tc.Solver.Monad.lookupInertDict` similarly - - `noMatchableGivenDicts`, which also consults the Givens - - `matchLocalInst`, which would otherwise consult Given quantified constraints - - `GHC.Tc.Solver.Instance.Class.matchInstEnv`: when short-cut solving, don't - pick overlappable top-level instances - - `GHC.Tc.Solver.Solve.runTcPluginsWanted`: don't pass any Givens to the plugin +* When in TcSShortCut mode, since there are no Givens we can short-circuit; + these are all just optimisations: + - `tryInertDicts` + - `GHC.Tc.Solver.Monad.lookupInertDict` + - `noMatchableGivenDicts` + - `matchLocalInst` + - `GHC.Tc.Solver.Solve.runTcPluginsWanted` + +* In `GHC.Tc.Solver.Instance.Class.matchInstEnv`: when short-cut solving, + don't pick overlappable top-level instances Some wrinkles: @@ -770,14 +772,14 @@ tryInertDicts dict_ct try_inert_dicts :: TcSMode -> InertCans -> DictCt -> TcS (StopOrContinue ()) try_inert_dicts mode inerts dict_w@(DictCt { di_ev = ev_w, di_cls = cls, di_tys = tys }) - | not (mode == TcSShortCut) -- Ignore the inerts (esp Givens) in short-cut mode - -- See Note [Shortcut solving] + | not (mode == TcSShortCut) -- Optimisation: ignore the inerts (esp Givens) in + -- short-cut mode. See Note [Shortcut solving] , Just dict_i <- lookupInertDict inerts cls tys , let ev_i = dictCtEvidence dict_i loc_i = ctEvLoc ev_i loc_w = ctEvLoc ev_w = -- There is a matching dictionary in the inert set - do { -- First to try to solve it /completely/ from top level instances + do { -- For a Wanted, first to try to solve it /completely/ from top level instances -- See Note [Shortcut solving] ; short_cut_worked <- tryShortCutSolver (isGiven ev_i) dict_w @@ -833,11 +835,7 @@ tryShortCutSolver try_short_cut dict_w@(DictCt { di_ev = ev_w }) , gopt Opt_SolveConstantDicts dflags -- Enabled by the -fsolve-constant-dicts flag - -> tryTcS $ -- tryTcS tries to completely solve some contraints - -- Inherit the current solved_dicts, so that one invocation of - -- tryShortCutSolver can benefit from the work of earlier invocations - -- See wrinkle (SCS3) of Note [Shortcut solving] - setTcSMode TcSShortCut $ + -> tryShortCutTcS $ -- tryTcS tries to completely solve some contraints do { residual <- solveSimpleWanteds (unitBag (CDictCan dict_w)) ; return (isEmptyBag residual) } @@ -977,7 +975,7 @@ matchClassInst dflags mode inerts clas tys loc noMatchableGivenDicts :: TcSMode -> InertSet -> CtLoc -> Class -> [TcType] -> Bool noMatchableGivenDicts mode inerts@(IS { inert_cans = inert_cans }) loc_w clas tys | TcSShortCut <- mode - = True -- In TcSShortCut mode we behave as if there were no Givens at all + = True -- Optimisation: in TcSShortCut mode there are no Givens | otherwise = not $ anyBag matchable_given $ findDictsByClass (inert_dicts inert_cans) clas @@ -1153,8 +1151,7 @@ matchLocalInst :: TcPredType -> CtLoc -> TcS ClsInstResult -- Look up the predicate in Given quantified constraints, -- which are effectively just local instance declarations. matchLocalInst body_pred loc - = do { -- In TcSShortCut mode we do not look at Givens; - -- c.f. tryInertDicts + = do { -- Optimisation: in TcSShortCut mode there are no Givens (c.f. tryInertDicts) mode <- getTcSMode ; case mode of { TcSShortCut -> do { traceTcS "matchLocalInst:TcSShortCut" (ppr body_pred) ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -19,7 +19,7 @@ module GHC.Tc.Solver.Monad ( runTcS, runTcSEarlyAbort, runTcSWithEvBinds, runTcSInerts, failTcS, warnTcS, addErrTcS, wrapTcS, ctLocWarnTcS, runTcSEqualities, - nestTcS, nestImplicTcS, tryTcS, + nestTcS, nestImplicTcS, tryShortCutTcS, setEvBindsTcS, setTcLevelTcS, emitFunDepWanteds, @@ -1259,20 +1259,31 @@ nestTcS (TcS thing_inside) ; return res } -tryTcS :: TcS Bool -> TcS Bool +tryShortCutTcS :: TcS Bool -> TcS Bool -- Like nestTcS, but --- (a) be a no-op if the nested computation returns Nothing +-- (a) be a no-op if the nested computation returns False -- (b) if (but only if) success, propagate nested bindings to the caller -- Use only by the short-cut solver; -- see Note [Shortcut solving] in GHC.Tc.Solver.Dict -tryTcS (TcS thing_inside) +tryShortCutTcS (TcS thing_inside) = TcS $ \ env@(TcSEnv { tcs_inerts = inerts_var , tcs_ev_binds = old_ev_binds_var }) -> - do { old_inerts <- TcM.readTcRef inerts_var - ; new_inert_var <- TcM.newTcRef old_inerts + do { -- Initialise a fresh inert set, with no Givens and no Wanteds + -- (i.e. empty `inert_cans`) + -- But inherit all the InertSet cache fields; in particular + -- * the given_eq_lvl, so we don't accidentally unify a + -- unification variable from outside a GADT match + -- * the `solved_dicts`; see wrinkle (SCS3) of Note [Shortcut solving] + -- * the `famapp_cache`; similarly + old_inerts <- TcM.readTcRef inerts_var + ; let given_eq_lvl = inert_given_eq_lvl (inert_cans old_inerts) + new_inerts = old_inerts { inert_cans = emptyInertCans given_eq_lvl } + ; new_inert_var <- TcM.newTcRef new_inerts + ; new_wl_var <- TcM.newTcRef emptyWorkList ; new_ev_binds_var <- TcM.cloneEvBindsVar old_ev_binds_var - ; let nest_env = env { tcs_ev_binds = new_ev_binds_var + ; let nest_env = env { tcs_mode = TcSShortCut + , tcs_ev_binds = new_ev_binds_var , tcs_inerts = new_inert_var , tcs_worklist = new_wl_var } ===================================== compiler/GHC/Tc/Solver/Solve.hs ===================================== @@ -1681,8 +1681,9 @@ runTcPluginsWanted wanted ; if null solvers then return (False, wanted) else do { -- Find the set of Givens to give to the plugin. - -- If TcSMode = TcSShortCut, we are solving with - -- no Givens so don't return any (#26258)! + -- Optimisation: if TcSMode = TcSShortCut, we are solving with + -- no Givens so don't bother to look (#26258 was a bug in an earlier + -- version when we left the Givens in the inert set) -- See Note [Shortcut solving] in GHC.Tc.Solver.Dict mode <- getTcSMode ; given <- case mode of View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ccda188d726804e4154de9318c72c5a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ccda188d726804e4154de9318c72c5a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] compiler: use zero cost coerce in GHC.CmmToAsm.CFG.loopInfo
by Marge Bot (＠marge-bot) 20 Aug '25

20 Aug '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: df4ee9b4 by Cheng Shao at 2025-08-20T11:54:25-04:00 compiler: use zero cost coerce in GHC.CmmToAsm.CFG.loopInfo This patch refactors GHC.CmmToAsm.CFG.loopInfo to use zero cost coerce and thus addresses the TODO. For coerce to work, constructors of Label/LabelMap/LabelSet from GHC.Cmm.Dataflow.Label are exposed, though I believe it's a worthy tradeoff to avoid unnecessary runtime cost without using unsafeCoerce, since the latter could be a landmine for future refactoring. Co-authored-by: Codex <codex(a)openai.com> - - - - - 2 changed files: - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/CmmToAsm/CFG.hs Changes: ===================================== compiler/GHC/Cmm/Dataflow/Label.hs ===================================== @@ -7,9 +7,9 @@ {-# OPTIONS_GHC -Wno-unused-top-binds #-} module GHC.Cmm.Dataflow.Label - ( Label - , LabelMap - , LabelSet + ( Label(..) + , LabelMap(..) + , LabelSet(..) , FactBase , lookupFact , mkHooplLabel ===================================== compiler/GHC/CmmToAsm/CFG.hs ===================================== @@ -56,22 +56,18 @@ import GHC.Utils.Misc import GHC.Data.Graph.Directed import GHC.Data.Maybe -import GHC.Types.Unique import qualified GHC.CmmToAsm.CFG.Dominators as Dom import GHC.CmmToAsm.CFG.Weight -import GHC.Data.Word64Map.Strict (Word64Map) -import GHC.Data.Word64Set (Word64Set) import Data.IntMap.Strict (IntMap) import Data.IntSet (IntSet) import qualified Data.IntMap.Strict as IM -import qualified GHC.Data.Word64Map.Strict as WM import qualified Data.Map as M import qualified Data.IntSet as IS -import qualified GHC.Data.Word64Set as WS import qualified Data.Set as S import Data.Tree import Data.Bifunctor +import Data.Coerce import GHC.Utils.Outputable import GHC.Utils.Panic @@ -92,7 +88,6 @@ import Data.Array.Base (unsafeRead, unsafeWrite) import Control.Monad import GHC.Data.UnionFind -import Data.Word type Prob = Double @@ -849,10 +844,8 @@ loopInfo cfg root = LoopInfo { liBackEdges = backEdges fmap (setFromList . mapKeys ) cfg :: LabelMap LabelSet - --TODO - This should be a no op: Export constructors? Use unsafeCoerce? ... - rooted = ( fromBlockId root - , toWord64Map $ fmap toWord64Set graph) :: (Word64, Word64Map Word64Set) - tree = fmap toBlockId $ Dom.domTree rooted :: Tree BlockId + rooted = coerce (root, graph) + tree = coerce (Dom.domTree rooted) :: Tree BlockId -- Map from Nodes to their dominators domMap :: LabelMap LabelSet @@ -898,11 +891,6 @@ loopInfo cfg root = LoopInfo { liBackEdges = backEdges loopCount n = length $ nub . map fst . filter (setMember n . snd) $ bodies in map (\n -> (n, loopCount n)) $ nodes :: [(BlockId, Int)] - toWord64Set :: LabelSet -> Word64Set - toWord64Set s = WS.fromList . map fromBlockId . setElems $ s - toWord64Map :: LabelMap a -> Word64Map a - toWord64Map m = WM.fromList $ map (\(x,y) -> (fromBlockId x,y)) $ mapToList m - mkDomMap :: Tree BlockId -> LabelMap LabelSet mkDomMap root = mapFromList $ go setEmpty root where @@ -916,12 +904,6 @@ loopInfo cfg root = LoopInfo { liBackEdges = backEdges (\n -> go (setInsert (rootLabel n) parents) n) leaves - fromBlockId :: BlockId -> Word64 - fromBlockId = getKey . getUnique - - toBlockId :: Word64 -> BlockId - toBlockId = mkBlockId . mkUniqueGrimily - -- We make the CFG a Hoopl Graph, so we can reuse revPostOrder. newtype BlockNode (e :: Extensibility) (x :: Extensibility) = BN (BlockId,[BlockId]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df4ee9b42ca5975ac451fc93d00717b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df4ee9b42ca5975ac451fc93d00717b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] configure: check python3 version and require minimal 3.7
by Marge Bot (＠marge-bot) 20 Aug '25

20 Aug '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 91f4faaa by Cheng Shao at 2025-08-20T11:53:43-04:00 configure: check python3 version and require minimal 3.7 Since !9515, the testsuite driver requires python3 version to be at least 3.7, though this has never been checked by configure logic. This patch implements the version check. Fixes #23234. Co-authored-by: Codex <codex(a)openai.com> - - - - - 1 changed file: - m4/find_python.m4 Changes: ===================================== m4/find_python.m4 ===================================== @@ -1,10 +1,43 @@ # FIND_PYTHON # ----------- -# Find the version of `python` to use (for the testsuite driver) +# Find a usable Python interpreter and enforce a minimum version. +# Exports: +# - PYTHON: Path to the interpreter for build/test scripts +# - PythonCmd: Canonicalised path used by Hadrian and config files +# - PythonVersion: Detected Python version (X.Y.Z) # AC_DEFUN([FIND_PYTHON],[ dnl Prefer the mingw64 distribution on Windows due to #17483. AC_PATH_PROG([PYTHON], [python3], [], [/mingw64/bin $PATH]) + + dnl Fall back to "python" if python3 isn’t found (version checked below) + AS_IF([test -z "$PYTHON"], [ + AC_PATH_PROG([PYTHON], [python], [], [/mingw64/bin $PATH]) + ]) + + dnl If still not found, hard error: we require Python >= 3.7 + AS_IF([test -z "$PYTHON"], [ + AC_MSG_ERROR([Python 3.7 or later is required but no python interpreter was found. Please install Python >= 3.7 and re-run configure.]) + ]) + + dnl Query the version string (X.Y.Z) of the selected interpreter + AC_CACHE_CHECK([for version of python], [fp_cv_python_version], [ + changequote(, )dnl + fp_cv_python_version=`"$PYTHON" -c "import sys; sys.stdout.write('%d.%d.%d' % sys.version_info[:3])" 2>/dev/null` + changequote([, ])dnl + ]) + PythonVersion=$fp_cv_python_version + AC_SUBST([PythonVersion]) + + dnl Enforce minimum version 3.7.0 + AS_IF([test -z "$PythonVersion"], [ + AC_MSG_ERROR([Failed to determine Python version for $PYTHON]) + ]) + FP_COMPARE_VERSIONS([$PythonVersion], [-lt], [3.7.0], [ + AC_MSG_ERROR([Python 3.7 or later is required, but $PYTHON reports $PythonVersion]) + ]) + + dnl Canonicalise path for Windows if test "$HostOS" = "mingw32" then PythonCmd=$(cygpath -m "$PYTHON") View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91f4faaab4b84676e42a6cef2c54f11… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91f4faaab4b84676e42a6cef2c54f11… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] 2 commits: driver: use UniqSet for hiddenModules in DynFlags/FinderOpts
by Marge Bot (＠marge-bot) 20 Aug '25

20 Aug '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b2914797 by Cheng Shao at 2025-08-20T11:53:00-04:00 driver: use UniqSet for hiddenModules in DynFlags/FinderOpts This patch replaces Set ModuleName with UniqSet ModuleName in DynFlags.hiddenModules and FinderOpts.finder_hiddenModules for improved efficiency. Co-authored-by: Codex <codex(a)openai.com> - - - - - 0335d899 by Cheng Shao at 2025-08-20T11:53:00-04:00 driver: use UniqMap ModuleName in the finder This patch replaces Map ModuleName with UniqMap ModuleName in the finder for improved efficiency. Co-authored-by: Codex <codex(a)openai.com> - - - - - 7 changed files: - compiler/GHC/Driver/Config/Finder.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Unit/Finder.hs - compiler/GHC/Unit/Finder/Types.hs Changes: ===================================== compiler/GHC/Driver/Config/Finder.hs ===================================== @@ -9,7 +9,7 @@ import GHC.Driver.DynFlags import GHC.Unit.Finder.Types import GHC.Data.FastString import GHC.Data.OsPath -import qualified Data.Map as Map +import GHC.Types.Unique.Map -- | Create a new 'FinderOpts' from DynFlags. initFinderOpts :: DynFlags -> FinderOpts @@ -22,7 +22,7 @@ initFinderOpts flags = FinderOpts , finder_workingDirectory = fmap unsafeEncodeUtf $ workingDirectory flags , finder_thisPackageName = mkFastString <$> thisPackageName flags , finder_hiddenModules = hiddenModules flags - , finder_reexportedModules = Map.fromList [(known_as, is_as) | ReexportedModule is_as known_as <- reverse (reexportedModules flags)] + , finder_reexportedModules = listToUniqMap [(known_as, is_as) | ReexportedModule is_as known_as <- reverse (reexportedModules flags)] , finder_hieDir = fmap unsafeEncodeUtf $ hieDir flags , finder_hieSuf = unsafeEncodeUtf $ hieSuf flags , finder_hiDir = fmap unsafeEncodeUtf $ hiDir flags ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -143,6 +143,7 @@ import System.Directory import GHC.Foreign (withCString, peekCString) import qualified Data.Set as Set +import GHC.Types.Unique.Set import qualified GHC.LanguageExtensions as LangExt @@ -261,7 +262,7 @@ data DynFlags = DynFlags { -- Note [Filepaths and Multiple Home Units] workingDirectory :: Maybe FilePath, thisPackageName :: Maybe String, -- ^ What the package is called, use with multiple home units - hiddenModules :: Set.Set ModuleName, + hiddenModules :: !(UniqSet ModuleName), reexportedModules :: [ReexportedModule], -- ways @@ -597,7 +598,7 @@ defaultDynFlags mySettings = workingDirectory = Nothing, thisPackageName = Nothing, - hiddenModules = Set.empty, + hiddenModules = emptyUniqSet, reexportedModules = [], objectDir = Nothing, ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -109,13 +109,14 @@ import GHC.Unit.Module.ModDetails import qualified Data.Map as Map import qualified Data.Set as Set +import GHC.Types.Unique.Set import Control.Concurrent.MVar import Control.Monad import qualified Control.Monad.Catch as MC import Data.IORef import Data.Maybe -import Data.List (sortOn, groupBy, sortBy) +import Data.List (sort, sortOn, groupBy, sortBy) import qualified Data.List as List import System.FilePath @@ -313,14 +314,15 @@ warnUnknownModules hsc_env dflags mod_graph = do where diag_opts = initDiagOpts dflags - unit_mods = Set.fromList (map ms_mod_name + unit_mods :: UniqSet ModuleName + unit_mods = mkUniqSet (map ms_mod_name (filter (\ms -> ms_unitid ms == homeUnitId_ dflags) (mgModSummaries mod_graph))) reexported_mods = reexportedModules dflags hidden_mods = hiddenModules dflags - hidden_warns = hidden_mods `Set.difference` unit_mods + hidden_warns = hidden_mods `minusUniqSet` unit_mods lookupModule mn = findImportedModule hsc_env mn NoPkgQual @@ -337,7 +339,7 @@ warnUnknownModules hsc_env dflags mod_graph = do final_msgs hidden_warns reexported_warns = unionManyMessages $ - [warn (DriverUnknownHiddenModules (homeUnitId_ dflags) (Set.toList hidden_warns)) | not (Set.null hidden_warns)] + [warn (DriverUnknownHiddenModules (homeUnitId_ dflags) (sort $ nonDetEltsUniqSet hidden_warns)) | not (isEmptyUniqSet hidden_warns)] ++ [warn (DriverUnknownReexportedModules (homeUnitId_ dflags) reexported_warns) | not (null reexported_warns)] -- | Describes which modules of the module graph need to be loaded. ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -293,6 +293,7 @@ import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as Set +import GHC.Types.Unique.Set import Data.Word import System.FilePath import Text.ParserCombinators.ReadP hiding (char) @@ -3153,7 +3154,7 @@ setPackageName p d = d { thisPackageName = Just p } addHiddenModule :: String -> DynP () addHiddenModule p = - upd (\s -> s{ hiddenModules = Set.insert (mkModuleName p) (hiddenModules s) }) + upd (\s -> s{ hiddenModules = addOneToUniqSet (hiddenModules s) (mkModuleName p) }) addReexportedModule :: String -> DynP () addReexportedModule p = ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -175,7 +175,7 @@ mkDocStructureFromExportList mdl import_avails export_list = moduleExport alias avails = DsiModExport (nubSortNE orig_names) (sortAvails (nubAvails avails)) where - orig_names = M.findWithDefault aliasErr alias aliasMap + orig_names = fromMaybe aliasErr (lookupUniqMap aliasMap alias) aliasErr = error $ "mkDocStructureFromExportList: " ++ (moduleNameString . moduleName) mdl ++ ": Can't find alias " ++ moduleNameString alias @@ -185,9 +185,9 @@ mkDocStructureFromExportList mdl import_avails export_list = NonEmpty.toList -- Map from aliases to true module names. - aliasMap :: Map ModuleName (NonEmpty ModuleName) + aliasMap :: UniqMap ModuleName (NonEmpty ModuleName) aliasMap = - M.fromListWith (S.<>) $ + listToUniqMap_C (S.<>) $ (this_mdl_name, this_mdl_name :| []) : (flip concatMap (M.toList imported) $ \(mdl, imvs) -> [(imv_name imv, moduleName mdl :| []) | imv <- imvs]) ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -65,9 +65,10 @@ import Control.Applicative ((<|>)) import Control.Monad import Data.Time import qualified Data.Map as M +import GHC.Types.Unique.Map import GHC.Driver.Env import GHC.Driver.Config.Finder -import qualified Data.Set as Set +import GHC.Types.Unique.Set import Data.List.NonEmpty ( NonEmpty (..) ) import qualified System.OsPath as OsPath import qualified Data.List.NonEmpty as NE @@ -194,9 +195,9 @@ findImportedModuleNoHsc fc fopts ue mhome_unit mod_name mb_pkg = home_pkg_import (uid, opts) -- If the module is reexported, then look for it as if it was from the perspective -- of that package which reexports it. - | Just real_mod_name <- mod_name `M.lookup` finder_reexportedModules opts = + | Just real_mod_name <- lookupUniqMap (finder_reexportedModules opts) mod_name = findImportedModuleNoHsc fc opts ue (Just $ DefiniteHomeUnit uid Nothing) real_mod_name NoPkgQual - | mod_name `Set.member` finder_hiddenModules opts = + | elementOfUniqSet mod_name (finder_hiddenModules opts) = return (mkHomeHidden uid) | otherwise = findHomePackageModule fc opts uid mod_name @@ -794,4 +795,3 @@ findObjectLinkable mod obj_fn obj_time = pure (Linkable obj_time mod (NE.singleton (DotO obj_fn ModuleObject))) -- We used to look for _stub.o files here, but that was a bug (#706) -- Now GHC merges the stub.o into the main .o (#3687) - ===================================== compiler/GHC/Unit/Finder/Types.hs ===================================== @@ -12,12 +12,13 @@ import GHC.Prelude import GHC.Unit import GHC.Data.OsPath import qualified Data.Map as M +import GHC.Types.Unique.Map import GHC.Fingerprint import GHC.Platform.Ways import GHC.Unit.Env import GHC.Data.FastString -import qualified Data.Set as Set +import GHC.Types.Unique.Set -- | The 'FinderCache' maps modules to the result of -- searching for that module. It records the results of searching for @@ -101,8 +102,8 @@ data FinderOpts = FinderOpts -- that have a similar name. , finder_workingDirectory :: Maybe OsPath , finder_thisPackageName :: Maybe FastString - , finder_hiddenModules :: Set.Set ModuleName - , finder_reexportedModules :: M.Map ModuleName ModuleName -- Reverse mapping, if you are looking for this name then look for this module. + , finder_hiddenModules :: !(UniqSet ModuleName) + , finder_reexportedModules :: !(UniqMap ModuleName ModuleName) -- Reverse mapping, if you are looking for this name then look for this module. , finder_hieDir :: Maybe OsPath , finder_hieSuf :: OsString , finder_hiDir :: Maybe OsPath View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b9c74374074d907ad9b32f79caf74… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0b9c74374074d907ad9b32f79caf74… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] ci: Teach ci.sh to fetch FreeBSD artifacts from ghcup unofficial bindists and...
by Marge Bot (＠marge-bot) 20 Aug '25

20 Aug '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0b9c7437 by Zubin Duggal at 2025-08-20T11:52:18-04:00 ci: Teach ci.sh to fetch FreeBSD artifacts from ghcup unofficial bindists and bootstrap compiler on FreeBSD to 9.10.1 Also refactor fetch_ghc logic in ci.sh, renaming the GHC_VERSION enviorment configuration variable to FETCH_GHC_VERSION, making it clear that it is intended for use on platforms like Windows and FreeBSD where we don't want to use the GHC excecutable from the platform environment and instead need to download and install GHC-$FETCH_GHC_VERSION from a release bindist. Fixes #26296 - - - - - 3 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/ci.sh ===================================== @@ -96,7 +96,9 @@ Environment variables determining bootstrap toolchain (Linux): Environment variables determining bootstrap toolchain (non-Linux): - GHC_VERSION Which GHC version to fetch for bootstrapping. + FETCH_GHC_VERSION Which GHC version to fetch for bootstrapping. + This should not be set if GHC is already provisioned, i.e. in the + docker image for linux platforms and via nix for darwin platforms CABAL_INSTALL_VERSION Cabal-install version to fetch for bootstrapping. EOF @@ -197,9 +199,6 @@ function set_toolchain_paths() { CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" - if [ "$(uname)" = "FreeBSD" ]; then - GHC=/usr/local/bin/ghc - fi ;; nix) if [[ ! -f toolchain.sh ]]; then @@ -275,29 +274,52 @@ function setup() { } function fetch_ghc() { + local should_fetch=false + if [ ! -e "$GHC" ]; then - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "neither GHC nor GHC_VERSION are not set" + if [ -z "${FETCH_GHC_VERSION:-}" ]; then + fail "GHC not found at '$GHC' and FETCH_GHC_VERSION is not set" + fi + should_fetch=true + fi + + if [ -e "$GHC" ] && [ -n "${FETCH_GHC_VERSION:-}" ]; then + local current_version + if current_version=$($GHC --numeric-version 2>/dev/null); then + if [ "$current_version" != "$FETCH_GHC_VERSION" ]; then + info "GHC version mismatch: found $current_version, expected $FETCH_GHC_VERSION" + should_fetch=true fi + fi + fi + + if [ "$should_fetch" = true ]; then + local v="$FETCH_GHC_VERSION" start_section fetch-ghc "Fetch GHC" - url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot…" + case "$(uname)" in + FreeBSD) + url="https://downloads.haskell.org/ghcup/unofficial-bindists/ghc/${FETCH_GHC_VER…" + ;; + *) + url="https://downloads.haskell.org/~ghc/${FETCH_GHC_VERSION}/ghc-${FETCH_GHC_VER…" + ;; + esac info "Fetching GHC binary distribution from $url..." curl "$url" > ghc.tar.xz || fail "failed to fetch GHC binary distribution" $TAR -xJf ghc.tar.xz || fail "failed to extract GHC binary distribution" case "$(uname)" in MSYS_*|MINGW*) - cp -r ghc-${GHC_VERSION}*/* "$toolchain" + cp -r ghc-${FETCH_GHC_VERSION}*/* "$toolchain" ;; *) - pushd ghc-${GHC_VERSION}* + pushd ghc-${FETCH_GHC_VERSION}* ./configure --prefix="$toolchain" "$MAKE" install popd ;; esac - rm -Rf "ghc-${GHC_VERSION}" ghc.tar.xz + rm -Rf "ghc-${FETCH_GHC_VERSION}" ghc.tar.xz end_section fetch-ghc fi ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -446,7 +446,7 @@ opsysVariables _ FreeBSD14 = mconcat -- Prefer to use the system's clang-based toolchain and not gcc , "CC" =: "cc" , "CXX" =: "c++" - , "GHC_VERSION" =: "9.6.4" + , "FETCH_GHC_VERSION" =: "9.10.1" , "CABAL_INSTALL_VERSION" =: "3.10.3.0" ] opsysVariables arch (Linux distro) = distroVariables arch distro @@ -478,7 +478,7 @@ opsysVariables _ (Windows {}) = mconcat , "LANG" =: "en_US.UTF-8" , "CABAL_INSTALL_VERSION" =: "3.10.2.0" , "HADRIAN_ARGS" =: "--docs=no-sphinx-pdfs" - , "GHC_VERSION" =: "9.10.1" + , "FETCH_GHC_VERSION" =: "9.10.1" ] opsysVariables _ _ = mempty ===================================== .gitlab/jobs.yaml ===================================== @@ -1467,7 +1467,7 @@ "CC": "cc", "CONFIGURE_ARGS": "--with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --with-system-libffi --with-ffi-includes=/usr/local/include --with-ffi-libraries=/usr/local/lib --with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check", "CXX": "c++", - "GHC_VERSION": "9.6.4", + "FETCH_GHC_VERSION": "9.10.1", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd14-validate", @@ -3698,7 +3698,7 @@ "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.10.2.0", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "GHC_VERSION": "9.10.1", + "FETCH_GHC_VERSION": "9.10.1", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LANG": "en_US.UTF-8", @@ -3761,7 +3761,7 @@ "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.10.2.0", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "GHC_VERSION": "9.10.1", + "FETCH_GHC_VERSION": "9.10.1", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LANG": "en_US.UTF-8", @@ -4355,7 +4355,7 @@ "CC": "cc", "CONFIGURE_ARGS": "--with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --with-system-libffi --with-ffi-includes=/usr/local/include --with-ffi-libraries=/usr/local/lib --with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check", "CXX": "c++", - "GHC_VERSION": "9.6.4", + "FETCH_GHC_VERSION": "9.10.1", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", @@ -5579,7 +5579,7 @@ "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.10.2.0", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "GHC_VERSION": "9.10.1", + "FETCH_GHC_VERSION": "9.10.1", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", @@ -5643,7 +5643,7 @@ "BUILD_FLAVOUR": "release", "CABAL_INSTALL_VERSION": "3.10.2.0", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "GHC_VERSION": "9.10.1", + "FETCH_GHC_VERSION": "9.10.1", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", @@ -5782,7 +5782,7 @@ "CC": "cc", "CONFIGURE_ARGS": "--with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib --with-system-libffi --with-ffi-includes=/usr/local/include --with-ffi-libraries=/usr/local/lib --with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --enable-strict-ghc-toolchain-check", "CXX": "c++", - "GHC_VERSION": "9.6.4", + "FETCH_GHC_VERSION": "9.10.1", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd14-validate" @@ -7982,7 +7982,7 @@ "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.10.2.0", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "GHC_VERSION": "9.10.1", + "FETCH_GHC_VERSION": "9.10.1", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LANG": "en_US.UTF-8", @@ -8044,7 +8044,7 @@ "BUILD_FLAVOUR": "validate", "CABAL_INSTALL_VERSION": "3.10.2.0", "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", - "GHC_VERSION": "9.10.1", + "FETCH_GHC_VERSION": "9.10.1", "HADRIAN_ARGS": "--docs=no-sphinx-pdfs", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "LANG": "en_US.UTF-8", View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0b9c74374074d907ad9b32f79caf744… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0b9c74374074d907ad9b32f79caf744… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Bump Cabal dependency
by Marge Bot (＠marge-bot) 20 Aug '25

20 Aug '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 276f8ea8 by Vekhir -- at 2025-08-20T11:51:35-04:00 Bump Cabal dependency - - - - - 1 changed file: - hadrian/hadrian.cabal Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -153,7 +153,7 @@ executable hadrian , TypeOperators other-extensions: MultiParamTypeClasses , TypeFamilies - build-depends: Cabal >= 3.13 && < 3.15 + build-depends: Cabal >= 3.13 && < 3.17 , base >= 4.11 && < 5 , bytestring >= 0.10 && < 0.13 , containers >= 0.5 && < 0.9 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/276f8ea8d369b202549a2e30be9b88a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/276f8ea8d369b202549a2e30be9b88a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] compiler: only use `Name` instead of `Id` in `SptEntry`
by Marge Bot (＠marge-bot) 20 Aug '25

20 Aug '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 39b2e382 by Cheng Shao at 2025-08-20T11:50:40-04:00 compiler: only use `Name` instead of `Id` in `SptEntry` As a part of #26298, this patch refactors `SptEntry` to only carry a `Name` instead of `Id`: we do not care about extra information like caffyness or type at all in any static pointer related codegen logic. This is necessary to make `SptEntry` serializable, as a part of the grand plan of serializable bytecode. Co-authored-by: Codex <codex(a)openai.com> - - - - - 4 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/StgToJS/StaticPtr.hs - compiler/GHC/Types/SptEntry.hs Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2548,9 +2548,9 @@ hscAddSptEntries :: HscEnv -> [SptEntry] -> IO () hscAddSptEntries hsc_env entries = do let interp = hscInterp hsc_env let add_spt_entry :: SptEntry -> IO () - add_spt_entry (SptEntry i fpr) = do + add_spt_entry (SptEntry n fpr) = do -- These are only names from the current module - (val, _, _) <- loadName interp hsc_env (idName i) + (val, _, _) <- loadName interp hsc_env n addSptEntry interp fpr val mapM_ add_spt_entry entries ===================================== compiler/GHC/Iface/Tidy/StaticPtrTable.hs ===================================== @@ -144,6 +144,7 @@ import GHC.Utils.Outputable as Outputable import GHC.Linker.Types import GHC.Types.Id +import GHC.Types.Id.Info ( CafInfo(..) ) import GHC.Types.ForeignStubs import GHC.Data.Maybe import GHC.Data.FastString @@ -205,7 +206,7 @@ sptCreateStaticBinds opts this_mod binds = do Nothing -> return (Nothing, (b, e)) Just (_, t, info, arg) -> do (fp, e') <- mkStaticBind t info arg - return (Just (SptEntry b fp), (b, foldr Lam e' tvs)) + return (Just (SptEntry (idName b) fp), (b, foldr Lam e' tvs)) mkStaticBind :: Type -> CoreExpr -> CoreExpr -> StateT Int IO (Fingerprint, CoreExpr) @@ -256,12 +257,18 @@ sptModuleInitCode platform this_mod entries init_fn_body = vcat [ text "static StgWord64 k" <> int i <> text "[2] = " <> pprFingerprint fp <> semi + -- Here we don't have access to IdInfo, so we make a + -- conservative assumption that the static closure might be + -- CAFfy, hence we pass MayHaveCafRefs when constructing a + -- CLabel. Regardless, MayHaveCafRefs/NoCafRefs wouldn't make + -- any difference here, they would pretty-print to the same + -- foreign stub content. $$ text "extern StgPtr " - <> (pprCLabel platform $ mkClosureLabel (idName n) (idCafInfo n)) <> semi + <> (pprCLabel platform $ mkClosureLabel n MayHaveCafRefs) <> semi $$ text "hs_spt_insert" <> parens (hcat $ punctuate comma [ char 'k' <> int i - , char '&' <> pprCLabel platform (mkClosureLabel (idName n) (idCafInfo n)) + , char '&' <> pprCLabel platform (mkClosureLabel n MayHaveCafRefs) ] ) <> semi ===================================== compiler/GHC/StgToJS/StaticPtr.hs ===================================== @@ -9,20 +9,35 @@ import GHC.Prelude import GHC.Linker.Types (SptEntry(..)) import GHC.Fingerprint.Type import GHC.Types.Literal +import GHC.Types.Name import GHC.JS.JStg.Syntax import GHC.JS.Make +import GHC.JS.Ident (name) import GHC.StgToJS.Symbols -import GHC.StgToJS.Ids import GHC.StgToJS.Literal import GHC.StgToJS.Types +import GHC.Utils.Panic (panic) initStaticPtrs :: [SptEntry] -> G JStgStat initStaticPtrs ptrs = mconcat <$> mapM initStatic ptrs where - initStatic (SptEntry sp_id (Fingerprint w1 w2)) = do - i <- varForId sp_id + -- Build a reference to the closure variable for a top-level Name. + -- Static pointer bindings are exported, so we can construct the symbol + -- directly from the Name's module and OccName. + varForName :: Name -> G JStgExpr + varForName n = do + case nameModule_maybe n of + Just m -> do + let sym = mkJsSymbol True m (occNameMangledFS (nameOccName n)) + pure (ValExpr (JVar (name sym))) + Nothing -> + -- Shouldn't happen for SPT entries + panic "varForName: non-external Name in SptEntry" + + initStatic (SptEntry sp_name (Fingerprint w1 w2)) = do + i <- varForName sp_name fpa <- concat <$> mapM (genLit . mkLitWord64 . fromIntegral) [w1,w2] let sptInsert = ApplStat hdHsSptInsert (fpa ++ [i]) return $ (hdInitStatic .^ "push") `ApplStat` [Func [] sptInsert] ===================================== compiler/GHC/Types/SptEntry.hs ===================================== @@ -3,14 +3,13 @@ module GHC.Types.SptEntry ) where -import GHC.Types.Var ( Id ) +import GHC.Types.Name ( Name ) import GHC.Fingerprint.Type ( Fingerprint ) import GHC.Utils.Outputable -- | An entry to be inserted into a module's static pointer table. -- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable". -data SptEntry = SptEntry Id Fingerprint +data SptEntry = SptEntry !Name !Fingerprint instance Outputable SptEntry where - ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr - + ppr (SptEntry n fpr) = ppr n <> colon <+> ppr fpr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/39b2e3823da3ab168aa2b7365f0f27e… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/39b2e3823da3ab168aa2b7365f0f27e… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] testsuite: Add regression test for #24606
by Marge Bot (＠marge-bot) 20 Aug '25

20 Aug '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fdfa3892 by Ben Gamari at 2025-08-20T11:49:57-04:00 testsuite: Add regression test for #24606 - - - - - 2 changed files: - + testsuite/tests/simplCore/should_compile/T24606.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== testsuite/tests/simplCore/should_compile/T24606.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE CPP #-} + +-- | We expect 'liftA2' to inline into 'f1'. We test this by +-- grepping for occurrences of the 'Applicative' dictionary. +module RWST where + +import Data.Functor.Identity +import Control.Applicative +import Control.Monad + +newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (w, s, a) } + +instance Functor m => Functor (RWST r w s m) where + fmap f (RWST m) = RWST (\r s -> fmap (\ ~(w,s',x) -> (w,s',f x)) (m r s)) + +instance (Monoid w, Monad m) => Applicative (RWST r w s m) where + pure x = RWST (\_ s -> pure (mempty, s, x)) + RWST mf <*> RWST mx = RWST (\r s -> do + ~(w, s', f) <- mf r s + ~(w', s'', x) <- mx r s' + pure (w <> w', s'', f x)) + +type Pairing m a b = m a -> m b -> m (a, b) + +f1 :: Pairing (RWST r [a] s Identity) a b +f1 x y = liftA2 (,) x y + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -535,6 +535,7 @@ test('T25160', normal, compile, ['-O -ddump-rules']) test('T25197', [req_th, extra_files(["T25197_TH.hs"]), only_ways(['optasm'])], multimod_compile, ['T25197', '-O2 -v0']) test('T25389', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds']) test('T24359a', normal, compile, ['-O -ddump-rules']) +test('T24606', [grep_errmsg(r'fAlternativeRWST')], compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-idinfo -dsuppress-coercions -dsuppress-coercion-types']) test('T25713', [grep_errmsg('W:::')], compile, ['-O -ddump-simpl']) test('T25883', normal, compile_grep_core, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fdfa3892cd5c8cb7e89d80ba37acd1c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fdfa3892cd5c8cb7e89d80ba37acd1c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Add primop to annotate the call stack with arbitrary data
by Marge Bot (＠marge-bot) 20 Aug '25

20 Aug '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 774fec37 by Ben Gamari at 2025-08-20T11:49:15-04:00 Add primop to annotate the call stack with arbitrary data We introduce a new primop `annotateStack#` which allows us to push arbitrary data onto the call-stack. This allows us to extract the data later when decoding the stack, for example when an exception is thrown, showing more information to the user without having to annotate the full call-stack with `HasCallStack` constraints. A new stack frame value is introduced `AnnFrame`, which consists of nothing but a generic payload. The primop has a small wrapper API that allows users to annotate their call-stack in programs. There is a pure API and an IO-based one. The former is a little bit dubious, as it affects the evaluation of a program, so use with care. The latter is "safe", as it doesn't change the evaluation of the program. The stack annotation mechanism is similarly implemented to the `ExceptionAnnotation` and `Exception`, there is a typeclass to indicate something can be pushed onto the call-stack and all values are wrapped in the existential `SomeStackAnnotation`, which recover the type of the annotation payload. There is currently no builtin way to show the stack annotations when `Backtraces` are displayed (i.e., when showing stack traces to the user), which we will address in a follow-up MR. ------------------------- Metric Increase: ghc_experimental_so ------------------------- We increase the size of the package, so this is not unreasonable. Co-Authored-By: fendor <fendor(a)posteo.de> Co-Authored-By: Ben Gamari <bgamari.foss(a)gmail.com> - - - - - 47 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - libraries/ghc-experimental/ghc-experimental.cabal.in - + libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs - libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/ghc-heap/GHC/Exts/Stack.hs - libraries/ghc-heap/GHC/Exts/Stack/Constants.hsc - libraries/ghc-heap/GHC/Exts/Stack/Decode.hs - + libraries/ghc-heap/tests/stack-annotation/Makefile - + libraries/ghc-heap/tests/stack-annotation/TestUtils.hs - + libraries/ghc-heap/tests/stack-annotation/all.T - + libraries/ghc-heap/tests/stack-annotation/ann_frame001.hs - + libraries/ghc-heap/tests/stack-annotation/ann_frame001.stdout - + libraries/ghc-heap/tests/stack-annotation/ann_frame002.hs - + libraries/ghc-heap/tests/stack-annotation/ann_frame002.stdout - + libraries/ghc-heap/tests/stack-annotation/ann_frame003.hs - + libraries/ghc-heap/tests/stack-annotation/ann_frame003.stdout - + libraries/ghc-heap/tests/stack-annotation/ann_frame004.hs - + libraries/ghc-heap/tests/stack-annotation/ann_frame004.stdout - libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs - rts/ClosureFlags.c - rts/LdvProfile.c - rts/PrimOps.cmm - rts/Printer.c - rts/RetainerProfile.c - rts/RtsSymbols.c - rts/TraverseHeap.c - rts/include/rts/storage/ClosureTypes.h - rts/include/rts/storage/Closures.h - rts/include/stg/MiscClosures.h - rts/js/profiling.js - rts/sm/Compact.c - rts/sm/Evac.c - rts/sm/NonMovingMark.c - rts/sm/Sanity.c - rts/sm/Scav.c - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 - testsuite/tests/interface-stability/ghc-prim-exports.stdout - testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32 - utils/deriveConstants/Main.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/774fec37d37fd9f31a3742f684b2b56… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/774fec37d37fd9f31a3742f684b2b56… You're receiving this email because of your account on gitlab.haskell.org.

1 0