- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/fendor/linkable-usage] 2 commits: Add bytecode linkable regression test
by Hannes Siebenhandl (＠fendor) 16 Feb '26

16 Feb '26

Hannes Siebenhandl pushed to branch wip/fendor/linkable-usage at Glasgow Haskell Compiler / GHC Commits: 74f436e1 by fendor at 2026-02-16T14:45:42+01:00 Add bytecode linkable regression test - - - - - 0831be2f by fendor at 2026-02-16T14:45:42+01:00 WIP: LinkableUsage - - - - - 23 changed files: - compiler/GHC/ByteCode/Serialize.hs - compiler/GHC/Driver/Hooks.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Recomp/Types.hs - compiler/GHC/Linker/ByteCode.hs - compiler/GHC/Linker/Deps.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Unit/Home/ModInfo.hs - compiler/GHC/Unit/Module/Deps.hs - compiler/GHC/Unit/Module/Status.hs - compiler/GHC/Utils/Binary.hs - ghc/GHCi/Leak.hs - + testsuite/tests/bytecode/TLinkable/Makefile - + testsuite/tests/bytecode/TLinkable/all.T - + testsuite/tests/bytecode/TLinkable/genSplices Changes: ===================================== compiler/GHC/ByteCode/Serialize.hs ===================================== @@ -14,6 +14,7 @@ module GHC.ByteCode.Serialize , InterpreterLibraryContents(..) , writeBytecodeLib , readBytecodeLib + , fingerprintModuleByteCodeContents , decodeOnDiskModuleByteCode , decodeOnDiskBytecodeLib ) @@ -48,6 +49,7 @@ import GHC.Utils.Logger import GHC.Linker.Types import System.IO.Unsafe (unsafeInterleaveIO) import GHC.Utils.Outputable +import GHC.Utils.Fingerprint (Fingerprint, fingerprintByteString) {- Note [Overview of persistent bytecode] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -94,6 +96,7 @@ See Note [Recompilation avoidance with bytecode objects] -- contained by 'ModuleByteCode' are stored in-memory rather than as file paths to -- temporary files. data OnDiskModuleByteCode = OnDiskModuleByteCode { odgbc_module :: Module + , odgbc_hash :: Fingerprint , odgbc_compiled_byte_code :: CompiledByteCode , odgbc_foreign :: [ByteString] -- ^ Contents of object files } @@ -154,7 +157,6 @@ instance Binary OnDiskBytecodeLib where put_ bh bytecodeLibForeign - writeBytecodeLib :: BytecodeLib -> FilePath -> IO () writeBytecodeLib lib path = do odbco <- encodeBytecodeLib lib @@ -174,12 +176,14 @@ readBytecodeLib hsc_env path = do instance Binary OnDiskModuleByteCode where get bh = do odgbc_module <- get bh + odgbc_hash <- get bh odgbc_compiled_byte_code <- get bh odgbc_foreign <- get bh pure OnDiskModuleByteCode {..} put_ bh OnDiskModuleByteCode {..} = do put_ bh odgbc_module + put_ bh odgbc_hash put_ bh odgbc_compiled_byte_code put_ bh odgbc_foreign @@ -197,7 +201,8 @@ decodeOnDiskModuleByteCode hsc_env odbco = do pure $ ModuleByteCode { gbc_module = odgbc_module odbco, gbc_compiled_byte_code = odgbc_compiled_byte_code odbco, - gbc_foreign_files = foreign_files + gbc_foreign_files = foreign_files, + gbc_hash = odgbc_hash odbco } decodeOnDiskBytecodeLib :: HscEnv -> OnDiskBytecodeLib -> IO BytecodeLib @@ -256,7 +261,8 @@ encodeOnDiskModuleByteCode bco = do pure $ OnDiskModuleByteCode { odgbc_module = gbc_module bco, odgbc_compiled_byte_code = gbc_compiled_byte_code bco, - odgbc_foreign = foreign_contents + odgbc_foreign = foreign_contents, + odgbc_hash = gbc_hash bco } -- | Read a 'ModuleByteCode' from a file. @@ -281,6 +287,15 @@ writeBinByteCode f cbc = do putWithUserData QuietBinIFace NormalCompression bh odbco writeBinMem bh f +fingerprintModuleByteCodeContents :: Module -> CompiledByteCode -> [FilePath] -> IO Fingerprint +fingerprintModuleByteCodeContents modl cbc foreign_files = do + bh' <- openBinMem (1024 * 1024) + bh <- addBinNameWriter bh' + foreign_contents <- readObjectFiles foreign_files + putWithUserData QuietBinIFace NormalCompression bh + (modl, cbc, foreign_contents) + withBinBuffer bh (pure . fingerprintByteString) + instance Binary CompiledByteCode where get bh = do bc_bcos <- get bh ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -137,7 +137,7 @@ data Hooks = Hooks , tcForeignExportsHook :: !(Maybe ([LForeignDecl GhcRn] -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt))) , hscFrontendHook :: !(Maybe (ModSummary -> Hsc FrontendResult)) - , hscCompileCoreExprHook :: !(Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded))) + , hscCompileCoreExprHook :: !(Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [LinkableWithUsage], PkgsLoaded))) , ghcPrimIfaceHook :: !(Maybe ModIface) , runPhaseHook :: !(Maybe PhaseHook) , runMetaHook :: !(Maybe (MetaHook TcM)) @@ -145,7 +145,7 @@ data Hooks = Hooks -> HomePackageTable -> IO SuccessFlag)) , runRnSpliceHook :: !(Maybe (HsUntypedSplice GhcRn -> RnM (HsUntypedSplice GhcRn))) , getValueSafelyHook :: !(Maybe (HscEnv -> Name -> Type - -> IO (Either Type (HValue, [Linkable], PkgsLoaded)))) + -> IO (Either Type (HValue, [LinkableWithUsage], PkgsLoaded)))) , createIservProcessHook :: !(Maybe (CreateProcess -> IO ProcessHandle)) , stgToCmmHook :: !(Maybe (StgToCmmConfig -> InfoTableProvMap -> [TyCon] -> CollectedCCs -> [CgStgTopBinding] -> CgStream CmmGroup ModuleLFInfos)) ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -866,7 +866,7 @@ hscRecompStatus | otherwise -> do -- Check the status of all the linkable types we might need. -- 1. The in-memory linkable we had at hand. - bc_in_memory_linkable <- checkByteCodeInMemory hsc_env mod_summary (homeMod_bytecode old_linkable) + bc_in_memory_linkable <- checkByteCodeInMemory hsc_env mod_summary (homeModLinkableByteCode old_linkable) -- 2. The bytecode object file bc_obj_linkable <- checkByteCodeFromObject hsc_env mod_summary -- 3. Bytecode from an interface's whole core bindings. @@ -1098,7 +1098,7 @@ loadIfaceByteCodeLazy :: ModIface -> ModLocation -> TypeEnv -> - IO (Maybe Linkable) + IO (Maybe (LinkableWith ModuleByteCode)) loadIfaceByteCodeLazy hsc_env iface location type_env = case iface_core_bindings iface location of Nothing -> return Nothing @@ -1106,8 +1106,9 @@ loadIfaceByteCodeLazy hsc_env iface location type_env = Just <$> compile wcb where compile decls = do - bco <- unsafeInterleaveIO $ compileWholeCoreBindings hsc_env type_env decls - linkable $ NE.singleton (DotGBC bco) + bco <- unsafeInterleaveIO $ do + compileWholeCoreBindings hsc_env type_env decls + linkable bco linkable parts = do if_time <- modificationTimeIfExists (ml_hi_file_ospath location) @@ -1148,14 +1149,14 @@ initWholeCoreBindings hsc_env iface details (RecompLinkables bc o) = do where type_env = md_types details - go :: RecompBytecodeLinkable -> IO (Maybe Linkable) + go :: RecompBytecodeLinkable -> IO (Maybe (LinkableWith ModuleByteCode)) go (NormalLinkable l) = pure l go (WholeCoreBindingsLinkable wcbl) = fmap Just $ for wcbl $ \wcb -> do add_iface_to_hpt iface details hsc_env - bco <- unsafeInterleaveIO $ - compileWholeCoreBindings hsc_env type_env wcb - pure $ NE.singleton (DotGBC bco) + bco <- unsafeInterleaveIO $ do + compileWholeCoreBindings hsc_env type_env wcb + pure bco -- | Hydrate interface Core bindings and compile them to bytecode. -- @@ -2232,20 +2233,21 @@ make user's opt into writing the files. -} -- | Generate a 'ModuleByteCode' and write it to disk if `-fwrite-byte-code` is enabled. -generateAndWriteByteCodeLinkable :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO Linkable +generateAndWriteByteCodeLinkable :: HscEnv -> CgInteractiveGuts -> ModLocation -> IO (LinkableWith ModuleByteCode) generateAndWriteByteCodeLinkable hsc_env cgguts mod_location = do bco_object <- generateAndWriteByteCode hsc_env cgguts mod_location -- Either, get the same time as the .gbc file if it exists, or just the current time. -- It's important the time of the linkable matches the time of the .gbc file for recompilation -- checking. bco_time <- maybe getCurrentTime pure =<< modificationTimeIfExists (ml_bytecode_file_ospath mod_location) - return $ mkModuleByteCodeLinkable bco_time bco_object + return $ mkOnlyModuleByteCodeLinkable bco_time bco_object mkModuleByteCode :: HscEnv -> Module -> ModLocation -> CgInteractiveGuts -> IO ModuleByteCode mkModuleByteCode hsc_env mod mod_location cgguts = do bcos <- hscGenerateByteCode hsc_env cgguts mod_location objs <- outputAndCompileForeign hsc_env mod mod_location (cgi_foreign_files cgguts) (cgi_foreign cgguts) - return $! ModuleByteCode mod bcos objs + !bcos_hash <- fingerprintModuleByteCodeContents mod bcos objs + return $! ModuleByteCode mod bcos objs bcos_hash -- | Generate a fresh 'ModuleByteCode' for a given module but do not write it to disk. generateFreshByteCodeLinkable :: HscEnv @@ -2767,13 +2769,13 @@ hscTidy hsc_env guts = do %* * %********************************************************************* -} -hscCompileCoreExpr :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded) +hscCompileCoreExpr :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [LinkableWithUsage], PkgsLoaded) hscCompileCoreExpr hsc_env loc expr = case hscCompileCoreExprHook (hsc_hooks hsc_env) of Nothing -> hscCompileCoreExpr' hsc_env loc expr Just h -> h hsc_env loc expr -hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded) +hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [LinkableWithUsage], PkgsLoaded) hscCompileCoreExpr' hsc_env srcspan ds_expr = do {- Simplify it -} -- Question: should we call SimpleOpt.simpleOptExpr here instead? @@ -2859,8 +2861,10 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr = do {- load it -} bco_time <- getCurrentTime + !bco_hash <- fingerprintModuleByteCodeContents this_mod bcos [] + let mbc = ModuleByteCode this_mod bcos [] bco_hash (mods_needed, units_needed) <- loadDecls interp hsc_env srcspan $ - Linkable bco_time this_mod $ NE.singleton $ DotGBC (ModuleByteCode this_mod bcos []) + Linkable bco_time this_mod $ NE.singleton (DotGBC mbc) -- Get the foreign reference to the name we should have just loaded. mhvs <- lookupFromLoadedEnv interp (idName binding_id) {- Get the HValue for the root -} @@ -2876,7 +2880,7 @@ jsCodeGen -> Module -> [(CgStgTopBinding,IdSet)] -> Id - -> IO (ForeignHValue, [Linkable], PkgsLoaded) + -> IO (ForeignHValue, [LinkableWithUsage], PkgsLoaded) jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id = do let logger = hsc_logger hsc_env tmpfs = hsc_tmpfs hsc_env ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -430,7 +430,7 @@ link' hsc_env batch_attempt_linking mHscMessager hpt let obj_files = concatMap linkableObjs linkables in action obj_files linkBytecodeLinkable action = - checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink checkBytecodeLibraryLinkingNeeded homeMod_bytecode $ \linkables -> + checkLinkablesUpToDate hsc_env mHscMessager home_mods pkg_deps staticLink checkBytecodeLibraryLinkingNeeded homeModLinkableByteCode $ \linkables -> let bytecode = concatMap linkableModuleByteCodes linkables in action bytecode ===================================== compiler/GHC/Driver/Plugins.hs ===================================== @@ -342,7 +342,7 @@ data Plugins = Plugins -- The purpose of this field is to cache the plugins so they -- don't have to be loaded each time they are needed. See -- 'GHC.Runtime.Loader.initializePlugins'. - , loadedPluginDeps :: !([Linkable], PkgsLoaded) + , loadedPluginDeps :: !([LinkableWithUsage], PkgsLoaded) -- ^ The object files required by the loaded plugins -- See Note [Plugin dependencies] } ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -7,8 +7,6 @@ module GHC.HsToCore.Usage ( import GHC.Prelude -import GHC.Driver.Env - import GHC.Tc.Types import GHC.Iface.Load @@ -27,7 +25,6 @@ import GHC.Types.Unique.Set import GHC.Unit import GHC.Unit.Env -import GHC.Unit.External import GHC.Unit.Module.Imported import GHC.Unit.Module.ModIface import GHC.Unit.Module.Deps @@ -35,18 +32,17 @@ import GHC.Unit.Module.Deps import GHC.Data.Maybe import GHC.Data.FastString -import Data.IORef import Data.List (sortBy) import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Set as Set -import qualified Data.List.NonEmpty as NE import GHC.Linker.Types import GHC.Unit.Finder import GHC.Types.Unique.DFM import GHC.Driver.Plugins import qualified GHC.Unit.Home.Graph as HUG +import qualified Data.List.NonEmpty as NE {- Note [Module self-dependency] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -75,19 +71,17 @@ data UsageConfig = UsageConfig mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv -> Module -> ImportedMods -> [ImportUserSpec] -> NameSet - -> [FilePath] -> [FilePath] -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded + -> [FilePath] -> [FilePath] -> [(Module, Fingerprint)] -> [LinkableWithUsage] -> PkgsLoaded -> IfG [Usage] mkUsageInfo uc plugins fc unit_env this_mod dir_imp_mods imp_decls used_names dependent_files dependent_dirs merged needed_links needed_pkgs = do - eps <- liftIO $ readIORef (euc_eps (ue_eps unit_env)) file_hashes <- liftIO $ mapM getFileHash dependent_files dirs_hashes <- liftIO $ mapM getDirHash dependent_dirs let hu = ue_unsafeHomeUnit unit_env - hug = ue_home_unit_graph unit_env -- Dependencies on object files due to TH and plugins - object_usages <- liftIO $ mkObjectUsage (eps_PIT eps) plugins fc hug needed_links needed_pkgs + object_usages <- liftIO $ mkObjectUsage plugins fc needed_links needed_pkgs let all_home_ids = HUG.allUnits (ue_home_unit_graph unit_env) mod_usages <- mk_mod_usage_info uc hu all_home_ids this_mod dir_imp_mods imp_decls used_names @@ -190,31 +184,31 @@ for a module or not. This is similar to how the recompilation checking for the l -- | Find object files corresponding to the transitive closure of given home -- modules and direct object files for pkg dependencies -mkObjectUsage :: PackageIfaceTable -> Plugins -> FinderCache -> HomeUnitGraph-> [Linkable] -> PkgsLoaded -> IO [Usage] -mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do - let ls = ordNubOn linkableModule (th_links_needed ++ plugins_links_needed) +mkObjectUsage :: Plugins -> FinderCache -> [LinkableWithUsage] -> PkgsLoaded -> IO [Usage] +mkObjectUsage plugins fc th_links_needed th_pkgs_needed = do + let ls = th_links_needed ++ plugins_links_needed ds = concatMap loaded_pkg_hs_objs $ eltsUDFM (plusUDFM th_pkgs_needed plugin_pkgs_needed) -- TODO possibly record loaded_pkg_non_hs_objs as well (plugins_links_needed, plugin_pkgs_needed) = loadedPluginDeps plugins concat <$> sequence (map linkableToUsage ls ++ map librarySpecToUsage ds) where - linkableToUsage (Linkable _ m uls) = mapM (partToUsage m) (NE.toList uls) - - msg m = moduleNameString (moduleName m) ++ "[TH] changed" + linkableToUsage :: LinkableWithUsage -> IO [Usage] + linkableToUsage (Linkable _ _m parts) = traverse partToUsage (NE.toList parts) + + partToUsage link_usage = + case link_usage of + FileLinkableUsage{flu_file, flu_message} -> do + fing flu_message flu_file + + ByteCodeLinkableUsage{bclu_module, bclu_hash} -> + pure $ + UsageHomeModuleBytecode + { usg_mod_name = moduleName bclu_module + , usg_unit_id = toUnitId $ moduleUnit bclu_module + , usg_bytecode_hash = bclu_hash + } fing mmsg fn = UsageFile (mkFastString fn) <$> lookupFileCache fc fn <*> pure mmsg - partToUsage m part = - case linkablePartPath part of - Just fn -> fing (Just (msg m)) fn - Nothing -> do - -- This should only happen for home package things but oneshot puts - -- home package ifaces in the PIT. - miface <- lookupIfaceByModule hug pit m - case miface of - Nothing -> pprPanic "linkableToUsage" (ppr m) - Just iface -> - return $ UsageHomeModuleInterface (moduleName m) (toUnitId $ moduleUnit m) (mi_iface_hash iface) - librarySpecToUsage :: LibrarySpec -> IO [Usage] librarySpecToUsage (Objects os) = traverse (fing Nothing) os librarySpecToUsage (Archive fn) = traverse (fing Nothing) [fn] ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -88,6 +88,10 @@ import GHC.Iface.Errors.Ppr import Data.Functor import Data.Bifunctor (first) import GHC.Types.PkgQual +import GHC.ByteCode.Serialize (ModuleByteCode, gbc_hash) +import GHC.Unit.Home.Graph (lookupHugByModule) +import GHC.Unit.Home.ModInfo (HomeModLinkable(..), HomeModInfo (..)) +import GHC.Linker.Types (linkableParts) {- ----------------------------------------------- @@ -190,6 +194,7 @@ data RecompReason | ModuleAdded (ImportLevel, UnitId, ModuleName) | ModuleChangedRaw ModuleName | ModuleChangedIface ModuleName + | ModuleChangedBytecode ModuleName | FileChanged FilePath | DirChanged FilePath | CustomReason String @@ -224,7 +229,8 @@ instance Outputable RecompReason where SigsMergeChanged -> text "Signatures to merge in changed" ModuleChanged m -> ppr m <+> text "changed" ModuleChangedRaw m -> ppr m <+> text "changed (raw)" - ModuleChangedIface m -> ppr m <+> text "changed (interface)" + ModuleChangedIface m -> ppr m <+> text "changed (bytecode)" + ModuleChangedBytecode m -> ppr m <+> text "changed (interface)" ModuleRemoved (_st, _uid, m) -> ppr m <+> text "removed" ModuleAdded (_st, _uid, m) -> ppr m <+> text "added" FileChanged fp -> text fp <+> text "changed" @@ -718,6 +724,15 @@ needInterface mod continue Nothing -> return $ NeedsRecompile MustCompile Just iface -> liftIO $ continue iface +needBytecode :: Module -> (ModuleByteCode -> IO RecompileRequired) + -> IfG RecompileRequired +needBytecode mod continue + = do + mb_recomp <- tryGetBytecode mod + case mb_recomp of + Nothing -> return $ NeedsRecompile MustCompile + Just mbc -> liftIO $ continue mbc + tryGetModIface :: String -> Module -> IfG (Maybe ModIface) tryGetModIface doc_msg mod = do -- Load the imported interface if possible @@ -739,6 +754,27 @@ tryGetModIface doc_msg mod -- import and it's been deleted Succeeded iface -> pure $ Just iface +tryGetBytecode :: Module -> IfG (Maybe ModuleByteCode) +tryGetBytecode mod + = do -- Load the imported bytecode if possible + logger <- getLogger + liftIO $ trace_hi_diffs logger (text "Checking bytecode hash for module" <+> ppr mod <+> ppr (moduleUnit mod)) + + mb_module_bytecode <- do + env <- getTopEnv + liftIO (lookupHugByModule mod (hsc_HUG env)) >>= \ case + Nothing -> pure Nothing + Just hmi -> + case homeMod_bytecode (hm_linkable hmi) of + Nothing -> pure Nothing + Just gbc_linkable -> pure $ Just $ linkableParts gbc_linkable + + case mb_module_bytecode of + Nothing -> do + liftIO $ trace_hi_diffs logger (sep [text "Couldn't find bytecode for module", ppr mod]) + return Nothing + Just module_bytecode -> pure $ Just module_bytecode + -- | Given the usage information extracted from the old -- M.hi file for the module being compiled, figure out -- whether M needs to be recompiled. @@ -760,14 +796,14 @@ checkModUsage _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_ha needInterface mod $ \iface -> do let reason = ModuleChangedRaw (moduleName mod) checkModuleFingerprint logger reason old_mod_hash (mi_mod_hash iface) -checkModUsage _ UsageHomeModuleInterface{ usg_mod_name = mod_name +checkModUsage _ UsageHomeModuleBytecode{ usg_mod_name = mod_name , usg_unit_id = uid - , usg_iface_hash = old_mod_hash } = do + , usg_bytecode_hash = old_bytecode_hash } = do let mod = mkModule (RealUnit (Definite uid)) mod_name logger <- getLogger - needInterface mod $ \iface -> do - let reason = ModuleChangedIface mod_name - checkIfaceFingerprint logger reason old_mod_hash (mi_iface_hash iface) + needBytecode mod $ \cbc -> do + let reason = ModuleChangedBytecode mod_name + checkBytecodeFingerprint logger reason old_bytecode_hash (gbc_hash cbc) checkModUsage _ UsageHomeModule{ usg_mod_name = mod_name, @@ -1032,19 +1068,18 @@ checkModuleFingerprint logger reason old_mod_hash new_mod_hash = out_of_date_hash logger reason (text " Module fingerprint has changed") old_mod_hash new_mod_hash -checkIfaceFingerprint +checkBytecodeFingerprint :: Logger -> RecompReason -> Fingerprint -> Fingerprint -> IO RecompileRequired -checkIfaceFingerprint logger reason old_mod_hash new_mod_hash - | new_mod_hash == old_mod_hash - = up_to_date logger (text "Iface fingerprint unchanged") - +checkBytecodeFingerprint logger reason old_bytecode_hash new_bytecode_hash + | old_bytecode_hash == new_bytecode_hash + = up_to_date logger (text "Bytecode fingerprint unchanged") | otherwise - = out_of_date_hash logger reason (text " Iface fingerprint has changed") - old_mod_hash new_mod_hash + = out_of_date_hash logger reason (text " Bytecode fingerprint has changed") + old_bytecode_hash new_bytecode_hash ------------------------ checkEntityUsage :: Logger ===================================== compiler/GHC/Iface/Recomp/Types.hs ===================================== @@ -146,10 +146,10 @@ pprUsage usage@UsageDirectory{} ppr (usg_dir_hash usage)] pprUsage usage@UsageMergedRequirement{} = hsep [text "merged", ppr (usg_mod usage), ppr (usg_mod_hash usage)] -pprUsage usage@UsageHomeModuleInterface{} - = hsep [text "implementation", ppr (usg_mod_name usage) +pprUsage usage@UsageHomeModuleBytecode{} + = hsep [text "Bytecode", ppr (usg_mod_name usage) , ppr (usg_unit_id usage) - , ppr (usg_iface_hash usage)] + , ppr (usg_bytecode_hash usage)] pprUsageImport :: Outputable mod => mod -> Fingerprint -> IsSafeImport -> SDoc pprUsageImport mod hash safe @@ -157,4 +157,4 @@ pprUsageImport mod hash safe , ppr hash ] where pp_safe | safe = text "safe" - | otherwise = text " -/ " \ No newline at end of file + | otherwise = text " -/ " ===================================== compiler/GHC/Linker/ByteCode.hs ===================================== @@ -31,7 +31,7 @@ linkBytecodeLib hsc_env gbcs = do on_disk_bcos <- mapM (readBinByteCode hsc_env) bytecodeObjects - let (all_cbcs, foreign_stubs) = unzip [ (bs, fs) | ModuleByteCode _m bs fs <- on_disk_bcos ++ gbcs] + let (all_cbcs, foreign_stubs) = unzip [ (bs, fs) | ModuleByteCode _m bs fs _hash <- on_disk_bcos ++ gbcs] interpreter_foreign_lib <- mkInterpreterLib hsc_env (concat foreign_stubs ++ objectFiles) @@ -67,4 +67,4 @@ mkInterpreterLib hsc_env files = return $ Just (InterpreterSharedObject foreign_stub_lib_path foreign_stub_lib_dir foreign_stub_lib_name) Nothing -> pure Nothing False -> do - pure $ Just (InterpreterStaticObjects files) \ No newline at end of file + pure $ Just (InterpreterStaticObjects files) ===================================== compiler/GHC/Linker/Deps.hs ===================================== @@ -63,7 +63,7 @@ data LinkDepsOpts = LinkDepsOpts data LinkDeps = LinkDeps { ldNeededLinkables :: [Linkable] - , ldAllLinkables :: [Linkable] + , ldAllLinkables :: [LinkableWithUsage] , ldUnits :: [UnitId] , ldNeededUnits :: UniqDSet UnitId } @@ -126,7 +126,7 @@ get_link_deps opts pls maybe_normal_osuf span mods = do return $ LinkDeps { ldNeededLinkables = lnks_needed - , ldAllLinkables = links_got ++ lnks_needed + , ldAllLinkables = links_got ++ mkLinkablesUsage lnks_needed , ldUnits = pkgs_needed , ldNeededUnits = pkgs_s } ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -228,7 +228,7 @@ lookupFromLoadedEnv interp name = do -- | Load the module containing the given Name and get its associated 'HValue'. -- -- Throws a 'ProgramError' if loading fails or the name cannot be found. -loadName :: Interp -> HscEnv -> Name -> IO (ForeignHValue, [Linkable], PkgsLoaded) +loadName :: Interp -> HscEnv -> Name -> IO (ForeignHValue, [LinkableWithUsage], PkgsLoaded) loadName interp hsc_env name = do initLoaderState interp hsc_env modifyLoaderState interp $ \pls0 -> do @@ -258,7 +258,7 @@ loadDependencies -> LoaderState -> SrcSpan -> [Module] - -> IO (LoaderState, SuccessFlag, [Linkable], PkgsLoaded) -- ^ returns the set of linkables required + -> IO (LoaderState, SuccessFlag, [LinkableWithUsage], PkgsLoaded) -- ^ returns the set of linkables required -- When called, the loader state must have been initialized (see `initLoaderState`) loadDependencies interp hsc_env pls span needed_mods = do let opts = initLinkDepsOpts hsc_env @@ -667,6 +667,7 @@ findBytecodeLinkableMaybe hsc_env mod locn = do case maybe_bytecode_time of Nothing -> return Nothing Just bytecode_time -> do + -- TODO: @fendor This must go -- Also load the interface, for reasons to do with recompilation avoidance. -- See Note [Recompilation avoidance with bytecode objects] _ <- initIfaceLoad hsc_env $ @@ -723,7 +724,7 @@ get_reachable_nodes hsc_env mods ********************************************************************* -} -- | Load the dependencies of a linkable, and then load the linkable itself. -loadDecls :: Interp -> HscEnv -> SrcSpan -> Linkable -> IO ([Linkable], PkgsLoaded) +loadDecls :: Interp -> HscEnv -> SrcSpan -> Linkable -> IO ([LinkableWithUsage], PkgsLoaded) loadDecls interp hsc_env span linkable = do -- Initialise the linker (if it's not been done already) initLoaderState interp hsc_env @@ -823,7 +824,7 @@ loadModuleLinkables interp hsc_env pls keep_spec linkables (objs, bcos) = partitionLinkables linkables -linkableInSet :: Linkable -> LinkableSet -> Bool +linkableInSet :: Linkable -> LinkableSet LinkableWithUsage -> Bool linkableInSet l objs_loaded = case lookupModuleEnv objs_loaded (linkableModule l) of Nothing -> False @@ -952,9 +953,9 @@ dynLoadObjs interp hsc_env pls objs = do then addWay WayProf else id -rmDupLinkables :: LinkableSet -- Already loaded +rmDupLinkables :: LinkableSet LinkableWithUsage -- Already loaded -> [Linkable] -- New linkables - -> (LinkableSet, -- New loaded set (including new ones) + -> (LinkableSet LinkableWithUsage, -- New loaded set (including new ones) [Linkable]) -- New linkables (excluding dups) rmDupLinkables already ls = go already [] ls @@ -962,7 +963,7 @@ rmDupLinkables already ls go already extras [] = (already, extras) go already extras (l:ls) | linkableInSet l already = go already extras ls - | otherwise = go (extendModuleEnv already (linkableModule l) l) (l:extras) ls + | otherwise = go (extendModuleEnv already (linkableModule l) (mkLinkableUsage l)) (l:extras) ls {- ********************************************************************** @@ -974,7 +975,7 @@ rmDupLinkables already ls dynLinkBCOs :: Interp -> LoaderState -> KeepModuleLinkableDefinitions -> [Linkable] -> IO LoaderState dynLinkBCOs interp pls keep_spec bcos = - let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos + let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos -- TODO: @fendor, convert to linkable usage here? pls1 = pls { bcos_loaded = bcos_loaded' } cbcs :: [CompiledByteCode] @@ -1109,13 +1110,13 @@ unload_wkr interp pls@LoaderState{..} = do -- we're unloading some code. -fghci-leak-check with the tests in -- testsuite/ghci can detect space leaks here. - let linkables_to_unload = moduleEnvElts objs_loaded ++ moduleEnvElts bcos_loaded + let linkables_to_unload = moduleEnvElts objs_loaded ++ moduleEnvElts bcos_loaded -- TODO: @fendor LinkableUsage here already? mapM_ unloadObjs linkables_to_unload -- If we unloaded any object files at all, we need to purge the cache -- of lookupSymbol results. - when (not (null (filter (not . null . linkableObjs) linkables_to_unload))) $ + when (not (null (filter (not . null . linkableUsageObjs) linkables_to_unload))) $ purgeLookupSymbolCache interp let !new_pls = pls { bco_loader_state = modifyHomePackageBytecodeState bco_loader_state $ \_ -> emptyBytecodeState, @@ -1125,7 +1126,7 @@ unload_wkr interp pls@LoaderState{..} = do return new_pls where - unloadObjs :: Linkable -> IO () + unloadObjs :: LinkableWithUsage -> IO () unloadObjs lnk | interpreterDynamic interp = return () -- We don't do any cleanup when linking objects with the @@ -1133,7 +1134,7 @@ unload_wkr interp pls@LoaderState{..} = do -- not much benefit. | otherwise - = mapM_ (unloadObj interp) (linkableObjs lnk) + = mapM_ (unloadObj interp) (linkableUsageObjs lnk) -- The components of a BCO linkable may contain -- dot-o files (generated from C stubs). -- ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -49,6 +49,7 @@ module GHC.Linker.Types , WholeCoreBindingsLinkable , LinkableWith(..) , mkModuleByteCodeLinkable + , mkOnlyModuleByteCodeLinkable , LinkablePart(..) , LinkableObjectSort (..) , linkableIsNativeCodeOnly @@ -67,12 +68,17 @@ module GHC.Linker.Types , linkableFilterNative , partitionLinkables + , LinkableWithUsage + , linkableUsageObjs + , mkLinkablesUsage + , mkLinkableUsage + , ModuleByteCode(..) ) where import GHC.Prelude -import GHC.Unit ( UnitId, Module ) +import GHC.Unit ( UnitId, Module, moduleNameString, moduleName ) import GHC.ByteCode.Types import GHCi.BreakArray import GHCi.RemoteTypes @@ -97,6 +103,10 @@ import Data.List.NonEmpty (NonEmpty, nonEmpty) import qualified Data.List.NonEmpty as NE import Control.Applicative ((<|>)) import Data.Functor.Identity +import GHC.Unit.Module.Deps (LinkableUsage (..), linkableUsageObjectPaths) +import GHC.Fingerprint (Fingerprint) +import qualified GHC.Data.OsPath as OsPath +import qualified GHC.Data.FlatBag as FlatBag {- ********************************************************************** @@ -172,10 +182,10 @@ data LoaderState = LoaderState -- ^ Information about bytecode objects we have loaded into the -- interpreter. - , bcos_loaded :: !LinkableSet + , bcos_loaded :: !(LinkableSet LinkableWithUsage) -- ^ The currently loaded interpreted modules (home package) - , objs_loaded :: !LinkableSet + , objs_loaded :: !(LinkableSet LinkableWithUsage) -- ^ And the currently-loaded compiled modules (home package) , pkgs_loaded :: !PkgsLoaded @@ -384,15 +394,17 @@ type Linkable = LinkableWith (NonEmpty LinkablePart) type WholeCoreBindingsLinkable = LinkableWith WholeCoreBindings -type LinkableSet = ModuleEnv Linkable +type LinkableWithUsage = LinkableWith (NonEmpty LinkableUsage) + +type LinkableSet = ModuleEnv -mkLinkableSet :: [Linkable] -> LinkableSet +mkLinkableSet :: [Linkable] -> LinkableSet Linkable mkLinkableSet ls = mkModuleEnv [(linkableModule l, l) | l <- ls] -- | Union of LinkableSets. -- -- In case of conflict, keep the most recent Linkable (as per linkableTime) -unionLinkableSet :: LinkableSet -> LinkableSet -> LinkableSet +unionLinkableSet :: LinkableSet (LinkableWith a) -> LinkableSet (LinkableWith a) -> LinkableSet (LinkableWith a) unionLinkableSet = plusModuleEnv_C go where go l1 l2 @@ -435,8 +447,9 @@ data LinkablePart | DotDLL FilePath -- ^ Dynamically linked library file (.so, .dll, .dylib) - | DotGBC ModuleByteCode - -- ^ A byte-code object, lives only in memory. + | DotGBC + -- ^ A byte-code object, lives only in memory. + ModuleByteCode -- | The in-memory representation of a bytecode object @@ -444,14 +457,19 @@ data LinkablePart data ModuleByteCode = ModuleByteCode { gbc_module :: Module , gbc_compiled_byte_code :: CompiledByteCode , gbc_foreign_files :: [FilePath] -- ^ Path to object files + , gbc_hash :: !Fingerprint } mkModuleByteCodeLinkable :: UTCTime -> ModuleByteCode -> Linkable -mkModuleByteCodeLinkable linkable_time bco = +mkModuleByteCodeLinkable linkable_time bco = do Linkable linkable_time (gbc_module bco) (pure (DotGBC bco)) +mkOnlyModuleByteCodeLinkable :: UTCTime -> ModuleByteCode -> LinkableWith ModuleByteCode +mkOnlyModuleByteCodeLinkable linkable_time bco = do + Linkable linkable_time (gbc_module bco) bco + instance Outputable ModuleByteCode where - ppr (ModuleByteCode mod _cbc _fos) = text "ModuleByteCode" <+> ppr mod + ppr (ModuleByteCode mod _cbc _fos _) = text "ModuleByteCode" <+> ppr mod instance Outputable LinkablePart where ppr (DotO path sort) = text "DotO" <+> text path <+> pprSort sort @@ -544,8 +562,8 @@ linkablePartObjectPaths = \case -- Contrary to linkableBCOs, this includes byte-code from LazyBCOs. linkablePartBCOs :: LinkablePart -> [CompiledByteCode] linkablePartBCOs = \case - DotGBC bco -> [gbc_compiled_byte_code bco] - _ -> [] + DotGBC bco -> [gbc_compiled_byte_code bco] + _ -> [] linkableFilter :: (LinkablePart -> [LinkablePart]) -> Linkable -> Maybe Linkable linkableFilter f linkable = do @@ -586,6 +604,48 @@ partitionLinkables linkables = mapMaybe linkableFilterByteCode linkables ) + +mkLinkableUsage :: Linkable -> LinkableWithUsage +mkLinkableUsage linkables = do + linkableUsage linkables + where + msg m = moduleNameString (moduleName m) ++ "[TH] changed" + + linkableUsage lnk@Linkable{linkableParts} = + setLinkableParts lnk linkableParts + + mkFileLinkableUsage m fp objs = + FileLinkableUsage + { flu_file = fp + , flu_message = Just $ msg m + , flu_linkable_objs = FlatBag.fromList (strictGenericLength objs) [ OsPath.unsafeEncodeUtf obj | obj <- objs ] + } + + mkByteCodeLinkableUsage m fp objs = + ByteCodeLinkableUsage + { bclu_module = m + , bclu_hash = fp + , bclu_linkable_objs = FlatBag.fromList (strictGenericLength objs) [ OsPath.unsafeEncodeUtf obj | obj <- objs ] + } + + setLinkableParts lnk@(Linkable{linkableModule}) parts = + lnk + { linkableParts = fmap (go linkableModule) parts + } + + go :: Module -> LinkablePart -> LinkableUsage + go m lnkPart = case lnkPart of + DotO fn _ -> mkFileLinkableUsage m fn (linkablePartObjectPaths lnkPart) + DotA fn -> mkFileLinkableUsage m fn (linkablePartObjectPaths lnkPart) + DotDLL fn -> mkFileLinkableUsage m fn (linkablePartObjectPaths lnkPart) + DotGBC mbc -> mkByteCodeLinkableUsage m (gbc_hash mbc) (linkablePartObjectPaths lnkPart) + +mkLinkablesUsage :: [Linkable] -> [LinkableWithUsage] +mkLinkablesUsage linkables = map mkLinkableUsage linkables + +linkableUsageObjs :: LinkableWithUsage -> [FilePath] +linkableUsageObjs lnkWithUsage = concatMap linkableUsageObjectPaths (linkableParts lnkWithUsage) + {- ********************************************************************** Loading packages ===================================== compiler/GHC/Runtime/Loader.hs ===================================== @@ -153,7 +153,7 @@ initializePlugins hsc_env ([] , _ ) -> False -- some external plugin added (p:ps,s:ss) -> check_external_plugin p s && check_external_plugins ps ss -loadPlugins :: HscEnv -> IO ([LoadedPlugin], [Linkable], PkgsLoaded) +loadPlugins :: HscEnv -> IO ([LoadedPlugin], [LinkableWithUsage], PkgsLoaded) loadPlugins hsc_env = do { unless (null to_load) $ checkExternalInterpreter hsc_env @@ -173,7 +173,7 @@ loadPlugins hsc_env loadPlugin = loadPlugin' (mkVarOccFS (fsLit "plugin")) pluginTyConName hsc_env -loadFrontendPlugin :: HscEnv -> ModuleName -> IO (FrontendPlugin, [Linkable], PkgsLoaded) +loadFrontendPlugin :: HscEnv -> ModuleName -> IO (FrontendPlugin, [LinkableWithUsage], PkgsLoaded) loadFrontendPlugin hsc_env mod_name = do checkExternalInterpreter hsc_env (plugin, _iface, links, pkgs) @@ -188,7 +188,7 @@ checkExternalInterpreter hsc_env = case interpInstance <$> hsc_interp hsc_env of -> throwIO (InstallationError "Plugins require -fno-external-interpreter") _ -> pure () -loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, ModIface, [Linkable], PkgsLoaded) +loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, ModIface, [LinkableWithUsage], PkgsLoaded) loadPlugin' occ_name plugin_name hsc_env mod_name = do { let plugin_rdr_name = mkRdrQual mod_name occ_name dflags = hsc_dflags hsc_env @@ -266,7 +266,7 @@ forceLoadTyCon hsc_env con_name = do -- * If the Name does not exist in the module -- * If the link failed -getValueSafely :: HscEnv -> Name -> Type -> IO (Either Type (a, [Linkable], PkgsLoaded)) +getValueSafely :: HscEnv -> Name -> Type -> IO (Either Type (a, [LinkableWithUsage], PkgsLoaded)) getValueSafely hsc_env val_name expected_type = do eith_hval <- case getValueSafelyHook hooks of Nothing -> getHValueSafely interp hsc_env val_name expected_type @@ -281,7 +281,7 @@ getValueSafely hsc_env val_name expected_type = do logger = hsc_logger hsc_env hooks = hsc_hooks hsc_env -getHValueSafely :: Interp -> HscEnv -> Name -> Type -> IO (Either Type (HValue, [Linkable], PkgsLoaded)) +getHValueSafely :: Interp -> HscEnv -> Name -> Type -> IO (Either Type (HValue, [LinkableWithUsage], PkgsLoaded)) getHValueSafely interp hsc_env val_name expected_type = do forceLoadNameModuleInterface hsc_env (text "contains a name used in an invocation of getHValueSafely") val_name -- Now look up the names for the value and type constructor in the type environment ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -563,7 +563,7 @@ data TcGblEnv -- is implicit rather than explicit, so we have to zap a -- mutable variable. - tcg_th_needed_deps :: TcRef ([Linkable], PkgsLoaded), + tcg_th_needed_deps :: TcRef ([LinkableWithUsage], PkgsLoaded), -- ^ The set of runtime dependencies required by this module -- See Note [Object File Dependencies] ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -2266,7 +2266,7 @@ fillCoercionHole (CH { ch_ref = ref, ch_co_var = cv }) co recordThUse :: TcM () recordThUse = do { env <- getGblEnv; writeTcRef (tcg_th_used env) True } -recordThNeededRuntimeDeps :: [Linkable] -> PkgsLoaded -> TcM () +recordThNeededRuntimeDeps :: [LinkableWithUsage] -> PkgsLoaded -> TcM () recordThNeededRuntimeDeps new_links new_pkgs = do { env <- getGblEnv ; updTcRef (tcg_th_needed_deps env) $ \(needed_links, needed_pkgs) -> ===================================== compiler/GHC/Unit/Home/ModInfo.hs ===================================== @@ -3,9 +3,11 @@ module GHC.Unit.Home.ModInfo ( HomeModInfo (..) - , HomeModLinkable (..) , homeModInfoObject , homeModInfoByteCode + , HomeModLinkable (..) + , homeModLinkableByteCode + , homeModLinkableObject , emptyHomeModInfoLinkable ) where @@ -15,9 +17,10 @@ import GHC.Prelude import GHC.Unit.Module.ModIface import GHC.Unit.Module.ModDetails -import GHC.Linker.Types ( Linkable ) +import GHC.Linker.Types ( Linkable, LinkableWith, ModuleByteCode, LinkablePart (..) ) import GHC.Utils.Outputable +import qualified Data.List.NonEmpty as NE -- | Information about modules in the package being compiled data HomeModInfo = HomeModInfo @@ -48,18 +51,24 @@ data HomeModInfo = HomeModInfo } homeModInfoByteCode :: HomeModInfo -> Maybe Linkable -homeModInfoByteCode = homeMod_bytecode . hm_linkable +homeModInfoByteCode = homeModLinkableByteCode . hm_linkable homeModInfoObject :: HomeModInfo -> Maybe Linkable -homeModInfoObject = homeMod_object . hm_linkable +homeModInfoObject = homeModLinkableObject . hm_linkable emptyHomeModInfoLinkable :: HomeModLinkable emptyHomeModInfoLinkable = HomeModLinkable Nothing Nothing -- See Note [Home module build products] -data HomeModLinkable = HomeModLinkable { homeMod_bytecode :: !(Maybe Linkable) +data HomeModLinkable = HomeModLinkable { homeMod_bytecode :: !(Maybe (LinkableWith ModuleByteCode)) , homeMod_object :: !(Maybe Linkable) } +homeModLinkableByteCode :: HomeModLinkable -> Maybe Linkable +homeModLinkableByteCode = fmap (fmap (NE.singleton . DotGBC)) . homeMod_bytecode + +homeModLinkableObject :: HomeModLinkable -> Maybe Linkable +homeModLinkableObject = homeMod_object + instance Outputable HomeModLinkable where ppr (HomeModLinkable l1 l2) = ppr l1 $$ ppr l2 ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -22,6 +22,10 @@ module GHC.Unit.Module.Deps , ImportAvails (..) , IfaceImportLevel(..) , tcImportLevel + , LinkableUsage(..) + , linkableUsageObjectPaths + , noLinkableUsage + , combineLinkableUsage ) where @@ -49,7 +53,10 @@ import qualified Data.Set as Set import Data.Bifunctor import Control.DeepSeq import GHC.Types.Name.Set - +import GHC.ByteCode.Types (FlatBag) +import GHC.Data.OsPath +import qualified Data.Foldable as Foldable +import qualified GHC.Data.OsPath as OsPath -- | Dependency information about ALL modules and packages below this one @@ -372,12 +379,12 @@ data Usage -- we won't spot it here. If you do want to spot that, the caller -- should recursively add them to their useage. } - | UsageHomeModuleInterface { + | UsageHomeModuleBytecode { usg_mod_name :: ModuleName -- ^ Name of the module , usg_unit_id :: UnitId -- ^ UnitId of the HomeUnit the module is from - , usg_iface_hash :: Fingerprint + , usg_bytecode_hash :: Fingerprint -- ^ The *interface* hash of the module, not the ABI hash. -- This changes when anything about the interface (and hence the -- module) has changed. @@ -412,7 +419,7 @@ instance NFData Usage where rnf (UsageFile file hash label) = rnf file `seq` rnf hash `seq` rnf label `seq` () rnf (UsageDirectory dir hash label) = rnf dir `seq` rnf hash `seq` rnf label `seq` () rnf (UsageMergedRequirement mod hash) = rnf mod `seq` rnf hash `seq` () - rnf (UsageHomeModuleInterface mod uid hash) = rnf mod `seq` rnf uid `seq` rnf hash `seq` () + rnf (UsageHomeModuleBytecode mod uid hash) = rnf mod `seq` rnf uid `seq` rnf hash `seq` () instance Binary Usage where put_ bh usg@UsagePackageModule{} = do @@ -441,11 +448,11 @@ instance Binary Usage where put_ bh (usg_mod usg) put_ bh (usg_mod_hash usg) - put_ bh usg@UsageHomeModuleInterface{} = do + put_ bh usg@UsageHomeModuleBytecode{} = do putByte bh 4 put_ bh (usg_mod_name usg) put_ bh (usg_unit_id usg) - put_ bh (usg_iface_hash usg) + put_ bh (usg_bytecode_hash usg) put_ bh usg@UsageDirectory{} = do putByte bh 5 @@ -483,7 +490,7 @@ instance Binary Usage where mod <- get bh uid <- get bh hash <- get bh - return UsageHomeModuleInterface { usg_mod_name = mod, usg_unit_id = uid, usg_iface_hash = hash } + return UsageHomeModuleBytecode { usg_mod_name = mod, usg_unit_id = uid, usg_bytecode_hash = hash } 5 -> do dp <- get bh hash <- get bh @@ -695,3 +702,38 @@ data ImportAvails -- ^ Family instance modules below us in the import tree (and maybe -- including us for imported modules) } + +data LinkableUsage + = FileLinkableUsage + { flu_file :: !FilePath + , flu_message :: !(Maybe String) + , flu_linkable_objs :: !(FlatBag OsPath) + } + | ByteCodeLinkableUsage + { bclu_module :: !Module + , bclu_hash :: !Fingerprint + , bclu_linkable_objs :: !(FlatBag OsPath) + } + +instance Outputable LinkableUsage where + ppr = \ case + FileLinkableUsage fp mmsg _objs -> + text "FileLinkableUsage" <+> text fp <> maybe empty (\ msg -> text " " <> text msg) mmsg + ByteCodeLinkableUsage modl hash _objs -> + text "ByteCodeLinkableUsage" <+> ppr modl <+> ppr hash + + +linkableUsageObjectPaths :: LinkableUsage -> [FilePath] +linkableUsageObjectPaths lnkUsage = + map OsPath.unsafeDecodeUtf . Foldable.toList $ linkableUsageObjectOsPaths lnkUsage + +linkableUsageObjectOsPaths :: LinkableUsage -> FlatBag OsPath +linkableUsageObjectOsPaths lnkUsage = case lnkUsage of + FileLinkableUsage{flu_linkable_objs} -> flu_linkable_objs + ByteCodeLinkableUsage{bclu_linkable_objs} -> bclu_linkable_objs + +noLinkableUsage :: [LinkableUsage] +noLinkableUsage = [] + +combineLinkableUsage :: [LinkableUsage] -> [LinkableUsage] -> [LinkableUsage] +combineLinkableUsage a b = a ++ b ===================================== compiler/GHC/Unit/Module/Status.hs ===================================== @@ -18,7 +18,7 @@ import GHC.Unit.Home.ModInfo import GHC.Unit.Module.ModGuts import GHC.Unit.Module.ModIface -import GHC.Linker.Types ( Linkable, WholeCoreBindingsLinkable, linkableIsNativeCodeOnly ) +import GHC.Linker.Types ( Linkable, WholeCoreBindingsLinkable, linkableIsNativeCodeOnly, ModuleByteCode, LinkableWith, linkableBCOs, linkableModuleByteCodes ) import GHC.Utils.Fingerprint import GHC.Utils.Outputable @@ -59,7 +59,7 @@ data RecompLinkables = RecompLinkables { recompLinkables_bytecode :: !RecompByte , recompLinkables_object :: !(Maybe Linkable) } data RecompBytecodeLinkable - = NormalLinkable !(Maybe Linkable) + = NormalLinkable !(Maybe (LinkableWith ModuleByteCode)) | WholeCoreBindingsLinkable !WholeCoreBindingsLinkable instance Outputable HscRecompStatus where @@ -87,7 +87,8 @@ justBytecode :: Either Linkable WholeCoreBindingsLinkable -> RecompLinkables justBytecode = \case Left lm -> assertPpr (not (linkableIsNativeCodeOnly lm)) (ppr lm) - $ emptyRecompLinkables { recompLinkables_bytecode = NormalLinkable (Just lm) } + $ assertPpr (length (linkableBCOs lm) == 1) (text "Expected 1 DotGBC linkable" $$ ppr lm ) + $ emptyRecompLinkables { recompLinkables_bytecode = NormalLinkable (Just (head (linkableModuleByteCodes lm) <$ lm)) } Right lm -> emptyRecompLinkables { recompLinkables_bytecode = WholeCoreBindingsLinkable lm } justObjects :: Linkable -> RecompLinkables @@ -99,7 +100,8 @@ bytecodeAndObjects :: Either Linkable WholeCoreBindingsLinkable -> Linkable -> R bytecodeAndObjects either_bc o = case either_bc of Left bc -> assertPpr (not (linkableIsNativeCodeOnly bc) && linkableIsNativeCodeOnly o) (ppr bc $$ ppr o) - $ RecompLinkables (NormalLinkable (Just bc)) (Just o) + $ assertPpr (length (linkableBCOs bc) == 1) (text "Expected 1 DotGBC linkable" $$ ppr bc ) + $ RecompLinkables (NormalLinkable (Just (head (linkableModuleByteCodes bc) <$ bc))) (Just o) Right bc -> assertPpr (linkableIsNativeCodeOnly o) (ppr o) $ RecompLinkables (WholeCoreBindingsLinkable bc) (Just o) ===================================== compiler/GHC/Utils/Binary.hs ===================================== @@ -37,6 +37,7 @@ module GHC.Utils.Binary tellBinWriter, castBin, withBinBuffer, + withReadBinBuffer, freezeWriteHandle, shrinkBinBuffer, thawReadHandle, @@ -348,6 +349,12 @@ withBinBuffer (WriteBinMem _ ix_r _ arr_r) action = do arr <- readIORef arr_r action $ BS.fromForeignPtr arr 0 ix +-- | Get access to the underlying buffer. +withReadBinBuffer :: ReadBinHandle -> (ByteString -> IO a) -> IO a +withReadBinBuffer (ReadBinMem _ ix_r _ arr) action = do + ix <- readFastMutInt ix_r + action $ BS.fromForeignPtr arr 0 ix + unsafeUnpackBinBuffer :: ByteString -> IO ReadBinHandle unsafeUnpackBinBuffer (BS.BS arr len) = do ix_r <- newFastMutInt 0 ===================================== ghc/GHCi/Leak.hs ===================================== @@ -52,8 +52,11 @@ getLeakIndicators hsc_env = return $ LeakModIndicators{..} where mkWeakLinkables :: HomeModLinkable -> IO [Maybe (Weak Linkable)] - mkWeakLinkables (HomeModLinkable mbc mo) = - mapM (\ln -> traverse (flip mkWeakPtr Nothing <=< evaluate) ln) [mbc, mo] + mkWeakLinkables hml = + mapM (\ln -> traverse (flip mkWeakPtr Nothing <=< evaluate) ln) + [ homeModLinkableByteCode hml + , homeModLinkableObject hml + ] -- | Look at the LeakIndicators collected by an earlier call to -- `getLeakIndicators`, and print messasges if any of them are still ===================================== testsuite/tests/bytecode/TLinkable/Makefile ===================================== @@ -0,0 +1,17 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +.PHONY: TLinkable_Prep +TLinkable_Prep: + ./genSplices + '$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) --make -fprefer-byte-code -v0 TLinkable.hs + +.PHONY: TLinkable2Pre +TLinkable2Pre: + ./genSplices + '$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) --make -fprefer-byte-code -fwrite-byte-code -v0 THMain.hs + +.PHONY: TLinkable2 +TLinkable2: + '$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) -c -fprefer-byte-code -fwrite-byte-code -v0 THMain.hs ===================================== testsuite/tests/bytecode/TLinkable/all.T ===================================== @@ -0,0 +1,22 @@ +# Test ideas +# Bytecode libraries +# Depend on that bytecode, look at the bytecode library tests to make sure this ends up in the EPS + +# test('TLinkable', +# [ collect_compiler_stats('bytes allocated',2), +# pre_cmd('$MAKE -s --no-print-directory TLinkablePre'), +# extra_files(['genSplices']), +# ], +# makefile_test, +# ['TLinkable']) + +# A performance test for calculating link dependencies in -c mode. +test('TLinkable', + [ collect_compiler_stats('bytes allocated',2), + pre_cmd('$MAKE -s --no-print-directory TLinkable_Prep'), + extra_files(['genSplices']), + compile_timeout_multiplier(5), + when(arch('wasm32'), fragile(25336)), + ], + compile, + ['-fforce-recomp ' + config.ghc_th_way_flags]) ===================================== testsuite/tests/bytecode/TLinkable/genSplices ===================================== @@ -0,0 +1,69 @@ +#!/bin/bash + +# Generate NMOD Haskell modules, each with NDEF NOINLINE functions +# Usage: ./genSplices <NMOD> <NDEF> + +NMOD=${1:-20} # Default 20 modules +NDEF=${2:-50} # Default 50 functions per module + +# Generate the modules +for ((i=1; i<=NMOD; i++)); do + module_name="Module$(printf "%03d" $i)" + file_path="${module_name}.hs" + + cat > "$file_path" << EOF +module ${module_name} where + +EOF + + for ((j=1; j<=NDEF; j++)); do + func_name="func$(printf "%03d" $j)" + cat >> "$file_path" << EOF +{-# NOINLINE ${func_name} #-} +${func_name} :: Int -> Int +${func_name} x = x + ${j} + +EOF + done +done + +# Generate imports section +imports="" +for ((i=1; i<=NMOD; i++)); do + imports="${imports}import Module$(printf "%03d" $i) +" +done + +# Generate the hard-coded TH expression +# Build: Module001.func001 1 + Module001.func002 2 + ... + Module{NMOD}.func{NDEF} {NMOD*NDEF} +expression="" +count=1 +for ((i=1; i<=NMOD; i++)); do + mod_name="Module$(printf "%03d" $i)" + for ((j=1; j<=NDEF; j++)); do + func_name="func$(printf "%03d" $j)" + if [ $count -gt 1 ]; then + expression="${expression} + " + fi + expression="${expression}${mod_name}.${func_name} ${count}" + ((count++)) + done +done + +# Generate the TH splice file +cat > TLinkable.hs << EOF +{-# LANGUAGE TemplateHaskell #-} + +module TLinkable where +import Language.Haskell.TH.Syntax (Lift(..)) + +-- Import all generated modules +${imports} +-- Hard-coded splice that references ALL functions from ALL modules +result :: Int +result = \$(lift \$ ${expression}) + +main :: IO () +main = do + putStrLn \$ "Result: " ++ show result +EOF View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/88863e7fc8022ef334542ccb572f26… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/88863e7fc8022ef334542ccb572f26… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/stack-annotation-ty] Add optional `SrcLoc` to `StackAnnotation` class
by Hannes Siebenhandl (＠fendor) 16 Feb '26

16 Feb '26

Hannes Siebenhandl pushed to branch wip/fendor/stack-annotation-ty at Glasgow Haskell Compiler / GHC Commits: d40ddcc0 by fendor at 2026-02-16T12:05:15+01:00 Add optional `SrcLoc` to `StackAnnotation` class `StackAnnotation` give access to an optional `SrcLoc` field that stack annotations can use to provide better backtraces in both error messages and when decoding the callstack. We update builtin stack annotations such as `StringAnnotation` and `ShowAnnotation` to also capture the `SrcLoc` of the current `CallStack` to improve backtraces by default (if stack annotations are used). This change is backwards compatible with GHC 9.14.1. - - - - - 20 changed files: - libraries/ghc-experimental/CHANGELOG.md - libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs - + libraries/ghc-experimental/tests/Makefile - + libraries/ghc-experimental/tests/all.T - + libraries/ghc-experimental/tests/backtraces/Makefile - + libraries/ghc-experimental/tests/backtraces/T26806a.hs - + libraries/ghc-experimental/tests/backtraces/T26806a.stderr - + libraries/ghc-experimental/tests/backtraces/T26806b.hs - + libraries/ghc-experimental/tests/backtraces/T26806b.stderr - + libraries/ghc-experimental/tests/backtraces/T26806c.hs - + libraries/ghc-experimental/tests/backtraces/T26806c.stderr - + libraries/ghc-experimental/tests/backtraces/all.T - libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs - libraries/ghc-internal/tests/stack-annotation/ann_frame001.stdout - libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout - libraries/ghc-internal/tests/stack-annotation/ann_frame003.stdout - libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout - libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 Changes: ===================================== libraries/ghc-experimental/CHANGELOG.md ===================================== @@ -5,12 +5,17 @@ - New and/or/xor SIMD primops for bitwise logical operations, such as andDoubleX4#, orWord32X4#, xorInt8X16#, etc. These are supported by the LLVM backend and by the X86_64 NCG backend (for the latter, only for 128-wide vectors). -## ghc-experimental-9.1401.0, +## ghc-experimental-9.1402.0 + +- Add optional `SrcLoc` to `StackAnnotation` class in `GHC.Stack.Annotation.Experimental` + +## ghc-experimental-9.1401.0 - Expose access to RTS flags via `GHC.RTS.Flags.Experimental` - Expose access to era profiling interface via `GHC.Profiling.Eras` - Expose access to runtime stack annotations via `GHC.Stack.Annotation.Experimental` - Expose custom allocation limit handler via `System.Mem.Experimental` +- Expose access to Stack Annotations via `GHC.Stack.Annotation.Experimental` - Expose module Prelude.Experimental, which reexports some modules from ghc-experimental for convenience, like Prelude does for base. ## ghc-experimental-9.1201.0 ===================================== libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs ===================================== @@ -82,9 +82,6 @@ import GHC.Internal.Stack.Annotation -- the pure variations can behave in ways that are hard to predict. -- -- See Note [Stack annotations in pure code] for more details. --- --- At last, stack annotations are tricky to use with 'error'. --- See Note [Pushing annotation frames on 'error'] for why this is the case. -- Note [Stack annotations in pure code] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -96,57 +93,50 @@ import GHC.Internal.Stack.Annotation -- For example: -- -- @ --- annotateStackShow (5 @Int) (fib 20 + throw (ErrorCall "Oh no!")) +-- annotateStackShow (5 @Int) (fib 20 + error "Oh no!") -- @ -- --- Without forcing the result of @(fib 20 + throw (ErrorCall "Oh no!"))@, the computation +-- Without forcing the result of @(fib 20 + error "Oh no!")@, the computation -- will simply return a thunk, and the stack annotation would be popped off the stack. -- Once the thunk is evaluated, the exception is raised, but no stack annotation will be found! --- If we force the result of @(fib 20 + throw (ErrorCall "Oh no!"))@, then the stack +-- If we force the result of @(fib 20 + error "Oh no!")@, then the stack -- annotations remain on the stack, and are displayed in the stack trace. -- -- Naturally, this only holds if no imprecise exceptions are thrown during evaluation of any -- nested value, for example in 'annotateStackShow 5 (Just $ throw (ErrorCall "Oh no!"))', the -- stack trace will not include the value @5@. -- --- See how we preferred @throw (ErrorCall ...)@ over @error@? --- See Note [Pushing annotation frames on 'error'] for why we do this. - --- Note [Pushing annotation frames on 'error'] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Examples so far have not been using 'error' at all. --- The reason is that 'error' is extraordinarily difficult to use correctly with stack annotation frames. --- See Note [Capturing the backtrace in throw] for a detailed discussion of how 'throw' --- manages to capture 'Backtraces'. --- --- Long story short, 'error' does not do the same thing as 'throw' and is subtly different --- in terms of evaluation, cause it to bypass the stack annotation frames, especially in --- pure code. --- --- However, even in 'IO' code, it is difficult to use 'error' and obtain stack annotation frames --- close to the call site due to the same issue of laziness and backtrace collection. --- --- This means, right now, if you want to reliably capture stack frame annotations, --- in both pure and impure code, prefer 'throw' and 'throwIO' variants over 'error'. -- ---------------------------------------------------------------------------- -- Annotations -- ---------------------------------------------------------------------------- + +-- | A 'String' only annotation with an optional source location. data StringAnnotation where - StringAnnotation :: String -> StringAnnotation + StringAnnotation :: !(Maybe SrcLoc) -> String -> StringAnnotation instance StackAnnotation StringAnnotation where - displayStackAnnotation (StringAnnotation str) = str + displayStackAnnotationShort (StringAnnotation _srcLoc str) = + str + + stackAnnotationSourceLocation (StringAnnotation srcLoc _str) = + srcLoc -- | Use the 'Show' instance of a type to display as the 'StackAnnotation'. data ShowAnnotation where - ShowAnnotation :: forall a . Show a => a -> ShowAnnotation + ShowAnnotation :: forall a . Show a => !(Maybe SrcLoc) -> a -> ShowAnnotation instance StackAnnotation ShowAnnotation where - displayStackAnnotation (ShowAnnotation showAnno) = show showAnno + displayStackAnnotationShort (ShowAnnotation _srcLoc showAnno) = + show showAnno + + stackAnnotationSourceLocation (ShowAnnotation srcLoc _showAnno) = + srcLoc -- | A 'CallStack' stack annotation. +-- +-- Captures the whole 'CallStack'. newtype CallStackAnnotation = CallStackAnnotation CallStack instance Show CallStackAnnotation where @@ -154,9 +144,23 @@ instance Show CallStackAnnotation where -- | Displays the first entry of the 'CallStack' instance StackAnnotation CallStackAnnotation where - displayStackAnnotation (CallStackAnnotation cs) = case getCallStack cs of + stackAnnotationSourceLocation (CallStackAnnotation cs) = + callStackHeadSrcLoc cs + + displayStackAnnotationShort (CallStackAnnotation cs) = + callStackHeadFunctionName cs + +callStackHeadSrcLoc :: CallStack -> Maybe SrcLoc +callStackHeadSrcLoc cs = + case getCallStack cs of + [] -> Nothing + (_, srcLoc):_ -> Just srcLoc + +callStackHeadFunctionName :: CallStack -> String +callStackHeadFunctionName cs = + case getCallStack cs of [] -> "<unknown source location>" - ((fnName,srcLoc):_) -> fnName ++ ", called at " ++ prettySrcLoc srcLoc + (fnName, _):_ -> fnName -- ---------------------------------------------------------------------------- -- Annotate the CallStack with custom data @@ -172,7 +176,7 @@ instance StackAnnotation CallStackAnnotation where -- -- WARNING: forces the evaluation of @b@ to WHNF. {-# NOINLINE annotateStack #-} -annotateStack :: forall a b. (Typeable a, StackAnnotation a) => a -> b -> b +annotateStack :: forall a b. (HasCallStack, Typeable a, StackAnnotation a) => a -> b -> b annotateStack ann b = unsafePerformIO $ annotateStackIO ann (evaluate b) @@ -196,9 +200,9 @@ annotateCallStack b = unsafePerformIO $ withFrozenCallStack $ -- information to stack traces. -- -- WARNING: forces the evaluation of @b@ to WHNF. -annotateStackString :: forall b . String -> b -> b +annotateStackString :: forall b . HasCallStack => String -> b -> b annotateStackString ann = - annotateStack (StringAnnotation ann) + annotateStack (StringAnnotation (callStackHeadSrcLoc ?callStack) ann) -- | @'annotateStackShow' showable b@ annotates the evaluation stack of @b@ -- with the value @showable@. @@ -207,37 +211,36 @@ annotateStackString ann = -- information to stack traces. -- -- WARNING: forces the evaluation of @b@ to WHNF. -annotateStackShow :: forall a b . (Typeable a, Show a) => a -> b -> b +annotateStackShow :: forall a b . (HasCallStack, Typeable a, Show a) => a -> b -> b annotateStackShow ann = - annotateStack (ShowAnnotation ann) + annotateStack (ShowAnnotation (callStackHeadSrcLoc ?callStack) ann) -- | @'annotateStackIO' showable b@ annotates the evaluation stack of @b@ -- with the value @showable@. -- -- When decoding the call stack, the annotation frames can be used to add more -- information to stack traces. -annotateStackIO :: forall a b . (Typeable a, StackAnnotation a) => a -> IO b -> IO b +annotateStackIO :: forall a b . (HasCallStack, Typeable a, StackAnnotation a) => a -> IO b -> IO b annotateStackIO ann (IO act) = IO $ \s -> annotateStack# (SomeStackAnnotation ann) act s -{-# NOINLINE annotateStackIO #-} -- | @'annotateStackStringIO' msg b@ annotates the evaluation stack of @b@ -- with the value @msg@. -- -- When decoding the call stack, the annotation frames can be used to add more -- information to stack traces. -annotateStackStringIO :: forall b . String -> IO b -> IO b +annotateStackStringIO :: forall b . HasCallStack => String -> IO b -> IO b annotateStackStringIO ann = - annotateStackIO (StringAnnotation ann) + annotateStackIO (StringAnnotation (callStackHeadSrcLoc ?callStack) ann) -- | @'annotateStackShowIO' msg b@ annotates the evaluation stack of @b@ -- with the value @msg@. -- -- When decoding the call stack, the annotation frames can be used to add more -- information to stack traces. -annotateStackShowIO :: forall a b . (Show a) => a -> IO b -> IO b +annotateStackShowIO :: forall a b . (HasCallStack, Show a) => a -> IO b -> IO b annotateStackShowIO ann = - annotateStackIO (ShowAnnotation ann) + annotateStackIO (ShowAnnotation (callStackHeadSrcLoc ?callStack) ann) -- | @'annotateCallStackIO' b@ annotates the evaluation stack of @b@ with the -- current 'callstack'. ===================================== libraries/ghc-experimental/tests/Makefile ===================================== @@ -0,0 +1,7 @@ +# This Makefile runs the tests using GHC's testsuite framework. It +# assumes the package is part of a GHC build tree with the testsuite +# installed in ../../../testsuite. + +TOP=../../../testsuite +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk ===================================== libraries/ghc-experimental/tests/all.T ===================================== ===================================== libraries/ghc-experimental/tests/backtraces/Makefile ===================================== @@ -0,0 +1,7 @@ +# This Makefile runs the tests using GHC's testsuite framework. It +# assumes the package is part of a GHC build tree with the testsuite +# installed in ../../../testsuite. + +TOP=../../../../testsuite +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk ===================================== libraries/ghc-experimental/tests/backtraces/T26806a.hs ===================================== @@ -0,0 +1,14 @@ +module Main where + +import GHC.Stack.Annotation.Experimental +import Control.Exception +import Control.Exception.Backtrace + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + annotateCallStackIO $ do + annotateStackShowIO ([1..4] :: [Int]) $ do + annotateStackStringIO "Lovely annotation" $ do + throwIO $ ErrorCall "Backtrace Test" + ===================================== libraries/ghc-experimental/tests/backtraces/T26806a.stderr ===================================== @@ -0,0 +1,11 @@ +T26806a: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: + +Backtrace Test + +IPE backtrace: + Lovely annotation, called at T26806a.hs:12:7 in main:Main + [1,2,3,4], called at T26806a.hs:11:5 in main:Main + annotateCallStackIO, called at T26806a.hs:10:3 in main:Main +HasCallStack backtrace: + throwIO, called at T26806a.hs:13:9 in main:Main + ===================================== libraries/ghc-experimental/tests/backtraces/T26806b.hs ===================================== @@ -0,0 +1,18 @@ +module Main where + +import GHC.Stack.Annotation.Experimental +import Control.Exception +import Control.Exception.Backtrace + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + print $ foo 500 + +foo :: Int -> Int +foo n = + annotateCallStack $ + annotateStackShow ([1..4] :: [Int]) $ + annotateStackString "Lovely annotation" $ + throw $ ErrorCall $ "Backtrace Test: " ++ show (n * n * n) + ===================================== libraries/ghc-experimental/tests/backtraces/T26806b.stderr ===================================== @@ -0,0 +1,13 @@ +T26806b: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: + +Backtrace Test: 125000000 + +IPE backtrace: + Lovely annotation, called at T26806b.hs:16:7 in main:Main + [1,2,3,4], called at T26806b.hs:15:5 in main:Main + annotateCallStack, called at T26806b.hs:14:3 in main:Main +HasCallStack backtrace: + collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:170:37 in ghc-internal:GHC.Internal.Exception + toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:90:42 in ghc-internal:GHC.Internal.Exception + throw, called at T26806b.hs:17:9 in main:Main + ===================================== libraries/ghc-experimental/tests/backtraces/T26806c.hs ===================================== @@ -0,0 +1,18 @@ +module Main where + +import GHC.Stack.Annotation.Experimental +import Control.Exception +import Control.Exception.Backtrace + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + print $ foo 500 + +foo :: Int -> Int +foo n = + annotateCallStack $ + annotateStackShow ([1..4] :: [Int]) $ + annotateStackString "Lovely annotation" $ + error $ "Backtrace Test: " ++ show (n * n * n) + ===================================== libraries/ghc-experimental/tests/backtraces/T26806c.stderr ===================================== @@ -0,0 +1,11 @@ +T26806c: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: + +Backtrace Test: 125000000 + +IPE backtrace: + Lovely annotation, called at T26806c.hs:16:7 in main:Main + [1,2,3,4], called at T26806c.hs:15:5 in main:Main + annotateCallStack, called at T26806c.hs:14:3 in main:Main +HasCallStack backtrace: + error, called at T26806c.hs:17:9 in main:Main + ===================================== libraries/ghc-experimental/tests/backtraces/all.T ===================================== @@ -0,0 +1,5 @@ +stack_annotation_backtrace_opts = [ when(have_profiling(), extra_ways(['prof'])) , when(js_arch(), skip) , exit_code(1) ] + +test('T26806a', stack_annotation_backtrace_opts, compile_and_run, ['']) +test('T26806b', stack_annotation_backtrace_opts, compile_and_run, ['']) +test('T26806c', stack_annotation_backtrace_opts, compile_and_run, ['']) ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs ===================================== @@ -4,6 +4,7 @@ module GHC.Internal.Stack.Annotation where import GHC.Internal.Base import GHC.Internal.Data.Typeable +import GHC.Internal.Stack (SrcLoc, prettySrcLoc) -- ---------------------------------------------------------------------------- -- StackAnnotation @@ -13,8 +14,38 @@ import GHC.Internal.Data.Typeable -- as the payload of 'AnnFrame' stack frames. -- class StackAnnotation a where + -- | Display a human readable string for the 'StackAnnotation'. + -- + -- This is supposed to be the long version of 'displayStackAnnotationShort' + -- and may contain a source location. + -- + -- If not provided, 'displayStackAnnotation' is derived from 'stackAnnotationSourceLocation' + -- and 'displayStackAnnotationShort'. displayStackAnnotation :: a -> String + -- | Get the 'SrcLoc' of the given 'StackAnnotation'. + -- + -- This is optional, 'SrcLoc' are not strictly required for 'StackAnnotation', but + -- it is still heavily encouarged to provide a 'SrcLoc' for better IPE backtraces. + stackAnnotationSourceLocation :: a -> Maybe SrcLoc + + -- | The description of the StackAnnotation without any metadata such as source locations. + -- + -- Pefer implementing 'displayStackAnnotationShort' over 'displayStackAnnotation'. + displayStackAnnotationShort :: a -> String + + {-# MINIMAL displayStackAnnotation | displayStackAnnotationShort #-} + + displayStackAnnotation ann = + displayStackAnnotationShort ann + ++ case stackAnnotationSourceLocation ann of + Nothing -> "" + Just srcLoc -> ", called at " ++ prettySrcLoc srcLoc + + stackAnnotationSourceLocation _ann = Nothing + + displayStackAnnotationShort = displayStackAnnotation + -- ---------------------------------------------------------------------------- -- Annotations -- ---------------------------------------------------------------------------- @@ -28,4 +59,11 @@ data SomeStackAnnotation where SomeStackAnnotation :: forall a. (Typeable a, StackAnnotation a) => a -> SomeStackAnnotation instance StackAnnotation SomeStackAnnotation where - displayStackAnnotation (SomeStackAnnotation a) = displayStackAnnotation a + displayStackAnnotation (SomeStackAnnotation a) = + displayStackAnnotation a + + stackAnnotationSourceLocation (SomeStackAnnotation a) = + stackAnnotationSourceLocation a + + displayStackAnnotationShort (SomeStackAnnotation a) = + displayStackAnnotationShort a ===================================== libraries/ghc-internal/tests/stack-annotation/ann_frame001.stdout ===================================== @@ -1,12 +1,12 @@ Stack annotations: -- (2,3) +- (2,3), called at ann_frame001.hs:5:13 in main:Main 47 Stack annotations: -- "bar" -- "foo" -- "tailCallEx" +- "bar", called at ann_frame001.hs:23:9 in main:Main +- "foo", called at ann_frame001.hs:21:11 in main:Main +- "tailCallEx", called at ann_frame001.hs:17:18 in main:Main Stack annotations: -- "bar" -- "foo" -- "tailCallEx" +- "bar", called at ann_frame001.hs:23:9 in main:Main +- "foo", called at ann_frame001.hs:21:11 in main:Main +- "tailCallEx", called at ann_frame001.hs:17:18 in main:Main 40 ===================================== libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout ===================================== @@ -7,5 +7,5 @@ Finish some work Some more work in bar 17711 Stack annotations: -- bar +- bar, called at ann_frame002.hs:23:29 in main:Main - annotateCallStackIO, called at ann_frame002.hs:23:7 in main:Main ===================================== libraries/ghc-internal/tests/stack-annotation/ann_frame003.stdout ===================================== @@ -1,6 +1,6 @@ 47 Stack annotations: -- "bar" -- "foo" -- "tailCallEx" +- "bar", called at ann_frame003.hs:25:9 in main:Main +- "foo", called at ann_frame003.hs:21:11 in main:Main +- "tailCallEx", called at ann_frame003.hs:16:18 in main:Main 40 ===================================== libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout ===================================== @@ -13,5 +13,5 @@ Stack annotations: - annotateCallStack, called at ann_frame004.hs:21:17 in main:Main - annotateCallStack, called at ann_frame004.hs:21:17 in main:Main - annotateCallStack, called at ann_frame004.hs:13:10 in main:Main -- bar +- bar, called at ann_frame004.hs:12:29 in main:Main - annotateCallStackIO, called at ann_frame004.hs:12:7 in main:Main ===================================== libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout ===================================== @@ -2,9 +2,9 @@ Caught exception: SimpleBoom Exception context: - IPE backtrace: -- throwIO SimpleBoom -- raising action -- catch site for throwIO SimpleBoom +- throwIO SimpleBoom, called at ann_frame005.hs:33:5 in main:Main +- raising action, called at ann_frame005.hs:32:3 in main:Main +- catch site for throwIO SimpleBoom, called at ann_frame005.hs:27:5 in main:Main - annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main - HasCallStack backtrace: - throwIO, called at ann_frame005.hs:34:7 in main:Main @@ -13,9 +13,9 @@ Handler annotation not present in context Caught exception: Prelude.undefined Exception context: - IPE backtrace: -- undefined thunk -- raising undefined action -- catch site for undefined +- undefined thunk, called at ann_frame005.hs:41:9 in main:Main +- raising undefined action, called at ann_frame005.hs:38:3 in main:Main +- catch site for undefined, called at ann_frame005.hs:27:5 in main:Main - annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main - HasCallStack backtrace: - undefined, called at ann_frame005.hs:41:48 in main:Main @@ -24,9 +24,9 @@ Handler annotation not present in context Caught exception: error from annotateStackString Exception context: - IPE backtrace: -- error thunk -- raising error action -- catch site for error +- error thunk, called at ann_frame005.hs:48:9 in main:Main +- raising error action, called at ann_frame005.hs:45:3 in main:Main +- catch site for error, called at ann_frame005.hs:27:5 in main:Main - annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main - HasCallStack backtrace: - error, called at ann_frame005.hs:48:44 in main:Main @@ -35,8 +35,8 @@ Handler annotation not present in context Caught exception: SimpleBoom Exception context: - IPE backtrace: -- raising throwSTM action -- catch site for throwSTM +- raising throwSTM action, called at ann_frame005.hs:52:3 in main:Main +- catch site for throwSTM, called at ann_frame005.hs:27:5 in main:Main - annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main - HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:170:37 in ghc-internal:GHC.Internal.Exception ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout ===================================== @@ -6499,25 +6499,27 @@ module GHC.Stack.Annotation.Experimental where newtype CallStackAnnotation = CallStackAnnotation GHC.Internal.Stack.Types.CallStack type ShowAnnotation :: * data ShowAnnotation where - ShowAnnotation :: forall a. GHC.Internal.Show.Show a => a -> ShowAnnotation + ShowAnnotation :: forall a. GHC.Internal.Show.Show a => !(GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc) -> a -> ShowAnnotation type SomeStackAnnotation :: * data SomeStackAnnotation where SomeStackAnnotation :: forall a. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> SomeStackAnnotation type StackAnnotation :: * -> Constraint class StackAnnotation a where displayStackAnnotation :: a -> GHC.Internal.Base.String - {-# MINIMAL displayStackAnnotation #-} + stackAnnotationSourceLocation :: a -> GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc + displayStackAnnotationShort :: a -> GHC.Internal.Base.String + {-# MINIMAL displayStackAnnotation | displayStackAnnotationShort #-} type StringAnnotation :: * data StringAnnotation where - StringAnnotation :: GHC.Internal.Base.String -> StringAnnotation + StringAnnotation :: !(GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc) -> GHC.Internal.Base.String -> StringAnnotation annotateCallStack :: forall b. GHC.Internal.Stack.Types.HasCallStack => b -> b annotateCallStackIO :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO a -> GHC.Internal.Types.IO a - annotateStack :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> b -> b - annotateStackIO :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b - annotateStackShow :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Show.Show a) => a -> b -> b - annotateStackShowIO :: forall a b. GHC.Internal.Show.Show a => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b - annotateStackString :: forall b. GHC.Internal.Base.String -> b -> b - annotateStackStringIO :: forall b. GHC.Internal.Base.String -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b + annotateStack :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> b -> b + annotateStackIO :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b + annotateStackShow :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Show.Show a) => a -> b -> b + annotateStackShowIO :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Show.Show a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b + annotateStackString :: forall b. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> b -> b + annotateStackStringIO :: forall b. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b module GHC.Stats.Experimental where -- Safety: Safe ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 ===================================== @@ -6502,25 +6502,27 @@ module GHC.Stack.Annotation.Experimental where newtype CallStackAnnotation = CallStackAnnotation GHC.Internal.Stack.Types.CallStack type ShowAnnotation :: * data ShowAnnotation where - ShowAnnotation :: forall a. GHC.Internal.Show.Show a => a -> ShowAnnotation + ShowAnnotation :: forall a. GHC.Internal.Show.Show a => !(GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc) -> a -> ShowAnnotation type SomeStackAnnotation :: * data SomeStackAnnotation where SomeStackAnnotation :: forall a. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> SomeStackAnnotation type StackAnnotation :: * -> Constraint class StackAnnotation a where displayStackAnnotation :: a -> GHC.Internal.Base.String - {-# MINIMAL displayStackAnnotation #-} + stackAnnotationSourceLocation :: a -> GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc + displayStackAnnotationShort :: a -> GHC.Internal.Base.String + {-# MINIMAL displayStackAnnotation | displayStackAnnotationShort #-} type StringAnnotation :: * data StringAnnotation where - StringAnnotation :: GHC.Internal.Base.String -> StringAnnotation + StringAnnotation :: !(GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc) -> GHC.Internal.Base.String -> StringAnnotation annotateCallStack :: forall b. GHC.Internal.Stack.Types.HasCallStack => b -> b annotateCallStackIO :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO a -> GHC.Internal.Types.IO a - annotateStack :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> b -> b - annotateStackIO :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b - annotateStackShow :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Show.Show a) => a -> b -> b - annotateStackShowIO :: forall a b. GHC.Internal.Show.Show a => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b - annotateStackString :: forall b. GHC.Internal.Base.String -> b -> b - annotateStackStringIO :: forall b. GHC.Internal.Base.String -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b + annotateStack :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> b -> b + annotateStackIO :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b + annotateStackShow :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Show.Show a) => a -> b -> b + annotateStackShowIO :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Show.Show a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b + annotateStackString :: forall b. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> b -> b + annotateStackStringIO :: forall b. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b module GHC.Stats.Experimental where -- Safety: Safe View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d40ddcc09a573c99485ee110c7db123… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d40ddcc09a573c99485ee110c7db123… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/freeze-throw] Hide implementation details from base exception stack traces
by Hannes Siebenhandl (＠fendor) 16 Feb '26

16 Feb '26

Hannes Siebenhandl pushed to branch wip/fendor/freeze-throw at Glasgow Haskell Compiler / GHC Commits: a9df4831 by fendor at 2026-02-16T11:58:39+01:00 Hide implementation details from base exception stack traces Ensure we hide the implementation details of the exception throwing mechanisms: * `undefined` * `throwSTM` * `throw` * `throwIO` * `error` The `HasCallStackBacktrace` should always have a length of exactly 1, not showing internal implementation details in the stack trace, as these are vastly distracting to end users. CLC proposal [#387](https://github.com/haskell/core-libraries-committee/issues/387) - - - - - 27 changed files: - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Exception.hs - libraries/ghc-internal/src/GHC/Internal/STM.hs - + libraries/ghc-internal/tests/backtraces/T15395.hs - + libraries/ghc-internal/tests/backtraces/T15395.stdout - libraries/ghc-internal/tests/backtraces/all.T - libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout - testsuite/tests/arrows/should_compile/T21301.stderr - testsuite/tests/deSugar/should_fail/DsStrictFail.stderr - testsuite/tests/deSugar/should_run/T20024.stderr - testsuite/tests/deSugar/should_run/dsrun005.stderr - testsuite/tests/deSugar/should_run/dsrun007.stderr - testsuite/tests/deSugar/should_run/dsrun008.stderr - testsuite/tests/deriving/should_run/T9576.stderr - testsuite/tests/ghci/scripts/Defer02.stderr - testsuite/tests/ghci/scripts/T15325.stderr - testsuite/tests/patsyn/should_run/ghci.stderr - testsuite/tests/quotes/LiftErrMsgDefer.stderr - testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr - testsuite/tests/type-data/should_run/T22332a.stderr - testsuite/tests/typecheck/should_run/T10284.stderr - testsuite/tests/typecheck/should_run/T13838.stderr - testsuite/tests/typecheck/should_run/T9497a-run.stderr - testsuite/tests/typecheck/should_run/T9497b-run.stderr - testsuite/tests/typecheck/should_run/T9497c-run.stderr - testsuite/tests/unsatisfiable/T23816.stderr - testsuite/tests/unsatisfiable/UnsatDefer.stderr Changes: ===================================== libraries/base/changelog.md ===================================== @@ -25,6 +25,7 @@ * Export `labelThread` from `Control.Concurrent`.([CLC proposal #376](https://github.com/haskell/core-libraries-committee/issues/376)) * Add a new module `System.IO.OS` with operations for obtaining operating-system handles (file descriptors, Windows handles). ([CLC proposal #369](https://github.com/haskell/core-libraries-committee/issues/369)) * Evaluate backtraces for "error" exceptions at the moment they are thrown. ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383)) + * Hide implementation details when throwing exceptions in throw and throwSTM. ([CLC proposal #387](https://github.com/haskell/core-libraries-committee/issues/387)) ## 4.22.0.0 *TBA* * Shipped with GHC 9.14.1 ===================================== libraries/ghc-internal/src/GHC/Internal/Exception.hs ===================================== @@ -87,7 +87,7 @@ throw e = -- Note also the absolutely crucial `noinine` in the RHS! -- See Note [Hiding precise exception signature in throw] let se :: SomeException - !se = noinline (unsafePerformIO (toExceptionWithBacktrace e)) + !se = noinline (unsafePerformIO (withFrozenCallStack $ toExceptionWithBacktrace e)) in raise# se -- Note [Capturing the backtrace in throw] @@ -162,7 +162,12 @@ throw e = -- primops which allow more precise guidance of the demand analyser's heuristic -- (e.g. #23847). --- | @since base-4.20.0.0 +-- | Collect a Backtrace and attach it to the 'Exception'. +-- +-- It is recommended to use 'withFrozenCallStack' when calling this function +-- in order to avoid leaking implementation details of 'toExceptionWithBacktrace'. +-- +-- @since base-4.20.0.0 toExceptionWithBacktrace :: (HasCallStack, Exception e) => e -> IO SomeException toExceptionWithBacktrace e ===================================== libraries/ghc-internal/src/GHC/Internal/STM.hs ===================================== @@ -28,7 +28,7 @@ import GHC.Internal.Base import GHC.Internal.Exception (Exception, toExceptionWithBacktrace, fromException, addExceptionContext) import GHC.Internal.Exception.Context (ExceptionAnnotation) import GHC.Internal.Exception.Type (WhileHandling(..)) -import GHC.Internal.Stack (HasCallStack) +import GHC.Internal.Stack (HasCallStack, withFrozenCallStack) -- TVars are shared memory locations which support atomic memory -- transactions. @@ -187,7 +187,7 @@ throwSTM e = do -- N.B. Typically use of unsafeIOToSTM is very much frowned upon as this -- is an easy way to end up with nested transactions. However, we can be -- certain that toExceptionWithBacktrace will not initiate a transaction. - se <- unsafeIOToSTM (toExceptionWithBacktrace e) + se <- unsafeIOToSTM (withFrozenCallStack $ toExceptionWithBacktrace e) STM $ raiseIO# se -- | Exception handling within STM actions. ===================================== libraries/ghc-internal/tests/backtraces/T15395.hs ===================================== @@ -0,0 +1,85 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeApplications #-} + +import GHC.Internal.Control.Exception +import GHC.Internal.Data.Foldable (traverse_) +import GHC.Internal.Exception.Backtrace +import GHC.Internal.Exception.Context +import GHC.Internal.Exception.Type +import GHC.Internal.STM (atomically, throwSTM) +import qualified GHC.Internal.Stack as HCS +import qualified GHC.Internal.Stack.Types as HCS +import Control.Monad (when) +import qualified Data.List as List +import System.Exit (exitFailure) + +main :: IO () +main = do + -- Make sure there are HasCallStackBacktraces + setBacktraceMechanismState HasCallStackBacktrace True + mapM_ (uncurry runCase) + [ ("throw", throwAction) + , ("throwIO", throwIOAction) + , ("error", errorAction) + , ("throwSTM", throwSTMAction) + , ("undefined", undefinedAction) + ] + +runCase :: String -> IO () -> IO () +runCase name act = do + putStrLn $ "=== Validate stack size of '" ++ name ++ "' has length 1" + catchAndVerifyStackTraceLength name act + putStrLn "" + +throwAction :: IO () +throwAction = evaluate $ throw $ ErrorCall "my throw error" + +throwIOAction :: IO () +throwIOAction = throwIO $ ErrorCall "my throwIO error" + +errorAction :: IO () +errorAction = error "plain error" + +throwSTMAction :: IO () +throwSTMAction = atomically $ throwSTM $ ErrorCall "my throwSTM error" + +undefinedAction :: IO () +undefinedAction = evaluate undefined + +catchAndVerifyStackTraceLength :: String -> IO () -> IO () +catchAndVerifyStackTraceLength name act = do + try act >>= \ case + Right _ -> do + putStrLn $ "Exception expected but got a result for '" ++ name ++ "'" + exitFailure + Left exc -> + verifyBacktraceSize name exc + +verifyBacktraceSize :: String -> SomeException -> IO () +verifyBacktraceSize label se = do + message <- evaluate (displayException se) + putStrLn "==== Caught exception:" + putStrLn message + putStrLn "==== Exception Backtraces:" + let backtraces = getExceptionAnnotations @Backtraces $ someExceptionContext se + traverse_ validateBacktrace backtraces + +validateBacktrace :: Backtraces -> IO () +validateBacktrace bt = + case btrHasCallStack bt of + Nothing -> pure () + Just cs -> do + let stack = HCS.getCallStack cs + + traverse_ mustNotReferenceInternalPackages stack + traverse_ (putStrLn . prettyCallSite) stack + where + prettyCallSite (f, loc) = "- " ++ f ++ ", called at " ++ HCS.prettySrcLoc loc + + mustNotReferenceInternalPackages (_, loc) = + case List.find (HCS.srcLocPackage loc ==) internalPackages of + Just val -> fail $ "Stack trace must not reference '" ++ val ++ "' package." + Nothing -> pure () + +internalPackages :: [String] +internalPackages = ["base", "ghc", "ghc-internal", "ghc-experimental"] ===================================== libraries/ghc-internal/tests/backtraces/T15395.stdout ===================================== @@ -0,0 +1,30 @@ +=== Validate stack size of 'throw' has length 1 +==== Caught exception: +my throw error +==== Exception Backtraces: +- throw, called at T15395.hs:35:26 in main:Main + +=== Validate stack size of 'throwIO' has length 1 +==== Caught exception: +my throwIO error +==== Exception Backtraces: +- throwIO, called at T15395.hs:38:17 in main:Main + +=== Validate stack size of 'error' has length 1 +==== Caught exception: +plain error +==== Exception Backtraces: +- error, called at T15395.hs:41:15 in main:Main + +=== Validate stack size of 'throwSTM' has length 1 +==== Caught exception: +my throwSTM error +==== Exception Backtraces: +- throwSTM, called at T15395.hs:44:31 in main:Main + +=== Validate stack size of 'undefined' has length 1 +==== Caught exception: +Prelude.undefined +==== Exception Backtraces: +- undefined, called at T15395.hs:47:28 in main:Main + ===================================== libraries/ghc-internal/tests/backtraces/all.T ===================================== @@ -4,3 +4,7 @@ test('T26507', [ when(have_profiling(), extra_ways(['prof'])) , when(js_arch(), skip) , when(ghc_with_ipe(), skip) # IPE builds include an IPE backtrace section on stderr. , exit_code(1)], compile_and_run, ['']) + +# Stack traces shouldn't expose implementation details +test('T15395', [ when(have_profiling(), extra_ways(['prof'])) + , when(js_arch(), skip)], compile_and_run, ['']) ===================================== libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout ===================================== @@ -39,7 +39,5 @@ Exception context: - catch site for throwSTM - annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main - HasCallStack backtrace: -- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:170:37 in ghc-internal:GHC.Internal.Exception -- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/STM.hs:190:26 in ghc-internal:GHC.Internal.STM - throwSTM, called at ann_frame005.hs:55:9 in main:Main Handler annotation not present in context ===================================== testsuite/tests/arrows/should_compile/T21301.stderr ===================================== @@ -4,7 +4,5 @@ T21301.hs:(8,7)-(10,6): Non-exhaustive patterns in case HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:434:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/deSugar/should_fail/DsStrictFail.stderr ===================================== @@ -4,7 +4,5 @@ DsStrictFail.hs:4:12-23: Non-exhaustive patterns in False HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:434:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/deSugar/should_run/T20024.stderr ===================================== @@ -4,7 +4,5 @@ T20024.hs:2:12-32: Non-exhaustive guards in pattern binding HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:431:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/deSugar/should_run/dsrun005.stderr ===================================== @@ -4,7 +4,5 @@ dsrun005.hs:42:1-18: Non-exhaustive patterns in function f HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:434:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/deSugar/should_run/dsrun007.stderr ===================================== @@ -4,7 +4,5 @@ dsrun007.hs:5:23-25: Missing field in record construction HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:432:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/deSugar/should_run/dsrun008.stderr ===================================== @@ -4,7 +4,5 @@ dsrun008.hs:2:32-36: Non-exhaustive patterns in (2, x) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:434:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/deriving/should_run/T9576.stderr ===================================== @@ -13,7 +13,5 @@ T9576.hs:6:31: error: [GHC-39999] (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/ghci/scripts/Defer02.stderr ===================================== @@ -71,8 +71,6 @@ Defer01.hs:49:5: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base *** Exception: Defer01.hs:13:5: error: [GHC-83865] @@ -82,8 +80,6 @@ HasCallStack backtrace: (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base *** Exception: Defer01.hs:17:9: error: [GHC-39999] @@ -93,8 +89,6 @@ HasCallStack backtrace: (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base <interactive>:10:11: error: [GHC-83865] @@ -113,8 +107,6 @@ HasCallStack backtrace: (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base *** Exception: Defer01.hs:30:5: error: [GHC-83865] @@ -127,8 +119,6 @@ HasCallStack backtrace: (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base *** Exception: Defer01.hs:33:8: error: [GHC-25897] @@ -146,8 +136,6 @@ HasCallStack backtrace: (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base *** Exception: Defer01.hs:38:17: error: [GHC-83865] @@ -161,8 +149,6 @@ HasCallStack backtrace: (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base *** Exception: Defer01.hs:42:5: error: [GHC-39999] @@ -172,8 +158,6 @@ HasCallStack backtrace: (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base <interactive>:16:8: error: [GHC-18872] @@ -192,7 +176,5 @@ HasCallStack backtrace: (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/ghci/scripts/T15325.stderr ===================================== @@ -24,7 +24,5 @@ T15325.hs:11:9: warning: [GHC-39999] [-Wdeferred-type-errors (in -Wdefault)] (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/patsyn/should_run/ghci.stderr ===================================== @@ -2,7 +2,5 @@ HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:434:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/quotes/LiftErrMsgDefer.stderr ===================================== @@ -11,7 +11,5 @@ LiftErrMsgDefer.hs:14:12: warning: [GHC-28914] [-Wdeferred-type-errors (in -Wdef (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr ===================================== @@ -4,7 +4,5 @@ SafeLang15.hs:22:9-37: Non-exhaustive patterns in Just p' HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:434:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/type-data/should_run/T22332a.stderr ===================================== @@ -4,7 +4,5 @@ T22332a.hs:18:1-35: Non-exhaustive patterns in Just eq HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:434:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/typecheck/should_run/T10284.stderr ===================================== @@ -7,7 +7,5 @@ T10284.hs:7:5: error: [GHC-83865] (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/typecheck/should_run/T13838.stderr ===================================== @@ -9,7 +9,5 @@ T13838.hs:6:1: error: [GHC-83865] (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/typecheck/should_run/T9497a-run.stderr ===================================== @@ -19,7 +19,5 @@ T9497a-run.hs:2:8: error: [GHC-88464] (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/typecheck/should_run/T9497b-run.stderr ===================================== @@ -19,7 +19,5 @@ T9497b-run.hs:2:8: error: [GHC-88464] (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/typecheck/should_run/T9497c-run.stderr ===================================== @@ -19,7 +19,5 @@ T9497c-run.hs:2:8: error: [GHC-88464] (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/unsatisfiable/T23816.stderr ===================================== @@ -8,7 +8,5 @@ T23816.hs:18:15: error: [GHC-22250] (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base ===================================== testsuite/tests/unsatisfiable/UnsatDefer.stderr ===================================== @@ -7,7 +7,5 @@ UnsatDefer.hs:20:7: error: [GHC-22250] (deferred type error) HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception - toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:89:42 in ghc-internal:GHC.Internal.Exception throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9df4831e13acc9461193f144061f62… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9df4831e13acc9461193f144061f62… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/supersven/hadrian-cross-stage3] Increase generate-ci happyness
by Sven Tennie (＠supersven) 15 Feb '26

15 Feb '26

Sven Tennie pushed to branch wip/supersven/hadrian-cross-stage3 at Glasgow Haskell Compiler / GHC Commits: 3a1e1c2b by Sven Tennie at 2026-02-15T10:37:31+01:00 Increase generate-ci happyness Pass its checks by adding some metadata. - - - - - 1 changed file: - .gitlab/generate-ci/gen_ci.hs Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -1444,6 +1444,11 @@ platform_mapping = Map.map go combined_result , "release-x86_64-linux-deb12-release" , "release-x86_64-linux-fedora43-release" , "release-x86_64-windows-release" + , "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage3-validate" + , "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage2-validate" + -- TODO: Added those here for now, but do we really need RISC-V nightlies? Weekly should be fine. + , "nightly-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage3-validate" + , "nightly-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage2-validate" ] process sel = View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a1e1c2b56d150d95d51e54a2e5cf4b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a1e1c2b56d150d95d51e54a2e5cf4b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/supersven/hadrian-cross-stage3] Bindist name must start with ghc*
by Sven Tennie (＠supersven) 15 Feb '26

15 Feb '26

Sven Tennie pushed to branch wip/supersven/hadrian-cross-stage3 at Glasgow Haskell Compiler / GHC Commits: 768cd178 by Sven Tennie at 2026-02-15T09:52:04+01:00 Bindist name must start with ghc* - - - - - 3 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - hadrian/src/Rules/BinaryDist.hs Changes: ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -383,7 +383,7 @@ testEnv arch opsys bc = , ["no_tntc" | not (tablesNextToCode bc) ] , ["cross_"++triple | Just triple <- pure $ crossTarget bc ] -- TODO: Is there something better than `show` for this? - , ["stage_" ++ show stage | Just stage <- pure (crossStage bc), Just triple <- pure (crossTarget bc), "riscv" `isInfixOf` triple ] + , ["stage" ++ show stage | Just stage <- pure (crossStage bc), Just triple <- pure (crossTarget bc), "riscv" `isInfixOf` triple ] , [flavourString (mkJobFlavour bc)] ] ===================================== .gitlab/jobs.yaml ===================================== @@ -2442,7 +2442,7 @@ "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_2-validate": { + "nightly-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage2-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -2453,7 +2453,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_2-validate.tar.xz", + "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage2-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -2496,7 +2496,7 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_2-validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage2-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-riscv64 -L /usr/riscv64-linux-gnu", @@ -2504,11 +2504,11 @@ "CROSS_TARGET": "riscv64-linux-gnu", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", - "TEST_ENV": "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_2-validate", + "TEST_ENV": "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage2-validate", "XZ_OPT": "-9" } }, - "nightly-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_3-validate": { + "nightly-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage3-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -2519,7 +2519,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_3-validate.tar.xz", + "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage3-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -2562,7 +2562,7 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_3-validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage3-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-riscv64 -L /usr/riscv64-linux-gnu", @@ -2570,7 +2570,7 @@ "CROSS_TARGET": "riscv64-linux-gnu", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", - "TEST_ENV": "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_3-validate", + "TEST_ENV": "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage3-validate", "XZ_OPT": "-9" } }, @@ -6676,7 +6676,7 @@ "TEST_ENV": "x86_64-linux-deb12-release" } }, - "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_2-validate": { + "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage2-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -6687,7 +6687,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_2-validate.tar.xz", + "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage2-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -6713,7 +6713,7 @@ ], "rules": [ { - "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_2-validate(\\s|$).*/)) || (($ONLY_JOBS == null) && ((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*RISC-V.*/)))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage2-validate(\\s|$).*/)) || (($ONLY_JOBS == null) && ((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*RISC-V.*/)))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -6730,7 +6730,7 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_2-validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage2-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-riscv64 -L /usr/riscv64-linux-gnu", @@ -6738,10 +6738,10 @@ "CROSS_TARGET": "riscv64-linux-gnu", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", - "TEST_ENV": "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_2-validate" + "TEST_ENV": "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage2-validate" } }, - "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_3-validate": { + "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage3-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh save_test_output", @@ -6752,7 +6752,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_3-validate.tar.xz", + "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage3-validate.tar.xz", "junit.xml", "unexpected-test-output.tar.gz" ], @@ -6778,7 +6778,7 @@ ], "rules": [ { - "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_3-validate(\\s|$).*/)) || (($ONLY_JOBS == null) && ((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*RISC-V.*/)))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", + "if": "((($ONLY_JOBS) && ($ONLY_JOBS =~ /.*\\bx86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage3-validate(\\s|$).*/)) || (($ONLY_JOBS == null) && ((($CI_MERGE_REQUEST_LABELS =~ /.*full-ci.*/) || ($CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/) || ($CI_COMMIT_BRANCH == \"master\") || ($CI_COMMIT_BRANCH =~ /ghc-[0-9]+\\.[0-9]+/)) || ($CI_MERGE_REQUEST_LABELS =~ /.*RISC-V.*/)))) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null)", "when": "on_success" } ], @@ -6795,7 +6795,7 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "stage3-ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-validate", + "BIN_DIST_NAME": "ghc-x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage3-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--with-intree-gmp --enable-strict-ghc-toolchain-check", "CROSS_EMULATOR": "qemu-riscv64 -L /usr/riscv64-linux-gnu", @@ -6803,7 +6803,7 @@ "CROSS_TARGET": "riscv64-linux-gnu", "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check", "RUNTEST_ARGS": "-e config.timeout=900", - "TEST_ENV": "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage_3-validate" + "TEST_ENV": "x86_64-linux-deb12-riscv-cross_riscv64-linux-gnu-stage3-validate" } }, "x86_64-linux-deb12-unreg-validate": { ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -123,7 +123,7 @@ installTo relocatable prefix = do buildBinDistDir :: FilePath -> FilePath -> BindistConfig -> Action () -buildBinDistDir dirPrefix root conf@BindistConfig{..} = do +buildBinDistDir dirSuffix root conf@BindistConfig{..} = do verbosity <- getVerbosity -- We 'need' all binaries and libraries @@ -153,7 +153,7 @@ buildBinDistDir dirPrefix root conf@BindistConfig{..} = do distDir <- Context.distDir (vanillaContext library_stage rts) let ghcBuildDir = root -/- stageString library_stage - bindistFilesDir = root -/- "bindist" -/- dirPrefix <> ghcVersionPretty + bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty <> dirSuffix ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform rtsIncludeDir = distDir -/- "include" @@ -326,7 +326,7 @@ bindistRules = do phony "binary-dist-dir-cross" $ buildBinDistDir "" root crossBindist - phony "binary-dist-dir-stage3" $ buildBinDistDir "stage3-" root targetBindist + phony "binary-dist-dir-stage3" $ buildBinDistDir "-stage3" root targetBindist let buildBinDist compressor = do win_host <- isWinHost @@ -336,13 +336,13 @@ bindistRules = do buildBinDistReloc = buildBinDistX "reloc-binary-dist-dir" "reloc-bindist" "" buildBinDistX :: String -> FilePath -> FilePath -> Compressor -> Action () - buildBinDistX target bindist_folder dirPrefix compressor = do + buildBinDistX target bindist_folder dirSuffix compressor = do need [target] version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull - let ghcVersionPretty = dirPrefix <> "ghc-" ++ version ++ "-" ++ targetPlatform + let ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform <> dirSuffix -- Finally, we create the archive <root>/bindist/ghc-X.Y.Z-platform.tar.xz tarPath <- builderPath (Tar Create) @@ -359,7 +359,7 @@ bindistRules = do -- TODO: Generate these targets as well phony "binary-dist-cross" $ buildBinDistX "binary-dist-dir-cross" "bindist" "" Xz - phony "binary-dist-stage3" $ buildBinDistX "binary-dist-dir-stage3" "bindist" "stage3-" Xz + phony "binary-dist-stage3" $ buildBinDistX "binary-dist-dir-stage3" "bindist" "-stage3" Xz -- Prepare binary distribution configure script -- (generated under <ghc root>/distrib/configure by 'autoreconf') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/768cd178a9b13c6779bc62bffca1df2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/768cd178a9b13c6779bc62bffca1df2… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] determinism: Sort Usages by fingerprint to ensure consistent ordering
by Marge Bot (＠marge-bot) 15 Feb '26

15 Feb '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d8969991 by Ian-Woo Kim at 2026-02-15T02:45:30-05:00 determinism: Sort Usages by fingerprint to ensure consistent ordering In some situations it has been observed that the ordering of usages can be non-determinstic in parallel builds. Therefore to be on the safe side we perform a sort on the usages field before writing them to the interface. Fixes #26877 - - - - - 3 changed files: - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/Unit/Module/Deps.hs - testsuite/tests/driver/recomp016/recomp016.stdout Changes: ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Data.Maybe import GHC.Data.FastString import Data.IORef -import Data.List (sortBy) +import Data.List (sortBy, sortOn) import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Set as Set @@ -73,6 +73,8 @@ data UsageConfig = UsageConfig { uc_safe_implicit_imps_req :: !Bool -- ^ Are all implicit imports required to be safe for this Safe Haskell mode? } +-- | Build the list of 'Usage's that drives recompilation checking. +-- The resulting list is deterministically sorted (see 'usageFingerprint'). mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv -> Module -> ImportedMods -> [ImportUserSpec] -> NameSet -> [FilePath] -> [FilePath] -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded @@ -105,7 +107,10 @@ mkUsageInfo uc plugins fc unit_env } | (mod, hash) <- merged ] ++ object_usages - usages `seqList` return usages + + -- Sort all the Usages to ensure a deterministic ordering. + let sorted_usages = sortOn usageFingerprint usages + sorted_usages `seqList` return sorted_usages -- seq the list of Usages returned: occasionally these -- don't get evaluated for a while and we can end up hanging on to -- the entire collection of Ifaces. ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -17,6 +17,7 @@ module GHC.Unit.Module.Deps , noDependencies , pprDeps , Usage (..) + , usageFingerprint , HomeModImport (..) , HomeModImportedAvails (..) , ImportAvails (..) @@ -492,6 +493,17 @@ instance Binary Usage where i -> error ("Binary.get(Usage): " ++ show i) +-- | Extract the distinguishing fingerprint carried by a particular 'Usage' +-- constructor. Every constructor stores a hash capturing the bit of state +-- that drives recompilation decisions, so we can sort on it directly. +usageFingerprint :: Usage -> Fingerprint +usageFingerprint UsagePackageModule{ usg_mod_hash = fp } = fp +usageFingerprint UsageHomeModule{ usg_mod_hash = fp } = fp +usageFingerprint UsageFile{ usg_file_hash = fp } = fp +usageFingerprint UsageDirectory{ usg_dir_hash = fp } = fp +usageFingerprint UsageHomeModuleInterface{ usg_iface_hash = fp } = fp +usageFingerprint UsageMergedRequirement{ usg_mod_hash = fp } = fp + -- | Records the imports that we depend on from a home module, -- for recompilation checking. -- ===================================== testsuite/tests/driver/recomp016/recomp016.stdout ===================================== @@ -9,4 +9,4 @@ second run [2 of 5] Compiling B ( B.hs, B.o ) [Source file changed] [3 of 5] Compiling C ( C.hs, C.o ) [B changed] [4 of 5] Compiling D ( D.hs, D.o ) [C changed] -[5 of 5] Compiling E ( E.hs, E.o ) [B changed] +[5 of 5] Compiling E ( E.hs, E.o ) [D changed] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d8969991260109a3d858d8e2735f455… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d8969991260109a3d858d8e2735f455… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: ci: remove unused hlint-ghc-and-base job definition
by Marge Bot (＠marge-bot) 15 Feb '26

15 Feb '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4157160f by Cheng Shao at 2026-02-13T06:27:04-05:00 ci: remove unused hlint-ghc-and-base job definition This patch removes the unused `hlint-ghc-and-base` job definition, it's never run since !9806. Note that hadrian lint rules still work locally, so anyone that wishes to run hlint on the codebase can continue to do so in their local worktree. - - - - - 039f1977 by Cheng Shao at 2026-02-13T06:27:47-05:00 wasm: use import.meta.main for proper distinction of nodejs main modules This patch uses `import.meta.main` for proper distinction of nodejs main modules, especially when the main module might be installed as a symlink. Fixes #26916. - - - - - e110ac41 by ARATA Mizuki at 2026-02-14T22:26:42+09:00 Support more x86 extensions: AVX-512 {BW,DQ,VL} and GFNI Also, mark AVX-512 ER and PF as deprecated. AVX-512 instructions can be used for certain 64-bit integer vector operations. GFNI can be used to implement bitReverse (currently not used by NCG, but LLVM may use it). Closes #26406 Addresses #26509 - - - - - c43a02ff by Ian-Woo Kim at 2026-02-14T20:52:28-05:00 determinism: Sort Usages by fingerprint to ensure consistent ordering In some situations it has been observed that the ordering of usages can be non-determinstic in parallel builds. Therefore to be on the safe side we perform a sort on the usages field before writing them to the interface. Fixes #26877 - - - - - 27 changed files: - .gitlab-ci.yml - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Usage.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/Unit/Module/Deps.hs - docs/users_guide/9.16.1-notes.rst - docs/users_guide/phases.rst - docs/users_guide/using.rst - testsuite/driver/cpu_features.py - testsuite/tests/codeGen/should_gen_asm/all.T - + testsuite/tests/codeGen/should_gen_asm/avx512-int64-minmax.asm - + testsuite/tests/codeGen/should_gen_asm/avx512-int64-minmax.hs - + testsuite/tests/codeGen/should_gen_asm/avx512-int64-mul.asm - + testsuite/tests/codeGen/should_gen_asm/avx512-int64-mul.hs - + testsuite/tests/codeGen/should_gen_asm/avx512-word64-minmax.asm - + testsuite/tests/codeGen/should_gen_asm/avx512-word64-minmax.hs - testsuite/tests/driver/recomp016/recomp016.stdout - testsuite/tests/simd/should_run/all.T - utils/jsffi/dyld.mjs - utils/jsffi/post-link.mjs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -387,20 +387,6 @@ lint-submods-branch: paths: - cabal-cache -# Disabled due to #22830 -.hlint-ghc-and-base: - extends: .lint-params - image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV" - variables: - BUILD_FLAVOUR: default - script: - - .gitlab/ci.sh setup - - .gitlab/ci.sh configure - - .gitlab/ci.sh run_hadrian lint:ghc-internal - - .gitlab/ci.sh run_hadrian lint:ghc-experimental - - .gitlab/ci.sh run_hadrian lint:base - - .gitlab/ci.sh run_hadrian lint:compiler - ############################################################ # GHC-in-GHCi (Hadrian) ############################################################ ===================================== compiler/GHC/CmmToAsm/Config.hs ===================================== @@ -31,6 +31,9 @@ data NCGConfig = NCGConfig , ncgDoConstantFolding :: !Bool -- ^ Perform CMM constant folding , ncgSseAvxVersion :: Maybe SseAvxVersion -- ^ (x86) SSE and AVX instructions , ncgAvx512fEnabled :: !Bool + , ncgAvx512vlEnabled :: !Bool + , ncgAvx512bwEnabled :: !Bool + , ncgAvx512dqEnabled :: !Bool , ncgBmiVersion :: Maybe BmiVersion -- ^ (x86) BMI instructions , ncgDumpRegAllocStages :: !Bool , ncgDumpAsmStats :: !Bool ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -134,6 +134,12 @@ avx2Enabled = do config <- getConfig return (ncgSseAvxVersion config >= Just AVX2) +avx512vlEnabled :: NatM Bool +avx512vlEnabled = ncgAvx512vlEnabled <$> getConfig + +avx512dqEnabled :: NatM Bool +avx512dqEnabled = ncgAvx512dqEnabled <$> getConfig + cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr] @@ -1314,6 +1320,8 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps sse4_1 <- sse4_1Enabled sse4_2 <- sse4_2Enabled avx <- avxEnabled + avx512vl <- avx512vlEnabled + avx512dq <- avx512dqEnabled case mop of MO_F_Eq _ -> condFltReg is32Bit EQQ x y MO_F_Ne _ -> condFltReg is32Bit NE x y @@ -1432,57 +1440,76 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps MO_V_Sub l w | l * widthInBits w == 128 -> vector_int_op_sse PSUB l w x y | otherwise -> needLlvm mop MO_V_Mul 16 W8 -> vector_int8x16_mul_sse2 x y - MO_V_Mul l@8 w@W16 -> vector_int_op_sse PMULL l w x y -- PMULLW (SSE2) - MO_V_Mul l@4 w@W32 | sse4_1 -> vector_int_op_sse PMULL l w x y -- PMULLD (SSE4.1) + MO_V_Mul l@8 w@W16 | avx -> vector_int_op_avx VPMULL l w x y -- VPMULLW (AVX) + | otherwise -> vector_int_op_sse PMULL l w x y -- PMULLW (SSE2) + MO_V_Mul l@4 w@W32 | avx -> vector_int_op_avx VPMULL l w x y -- VPMULLD (AVX) + | sse4_1 -> vector_int_op_sse PMULL l w x y -- PMULLD (SSE4.1) | otherwise -> vector_int32x4_mul_sse2 x y - MO_V_Mul 2 W64 -> vector_int64x2_mul_sse2 x y + MO_V_Mul l@2 w@W64 | avx512dq && avx512vl -> vector_int_op_avx VPMULL l w x y -- VPMULLQ (AVX512DQ+VL) + | otherwise -> vector_int64x2_mul_sse2 x y MO_V_Mul {} -> needLlvm mop MO_VU_Min l@16 w@W8 - -> vector_int_op_sse (MINMAX Min (IntVecMinMax False)) l w x y -- PMINUB (SSE2) + | avx -> vector_int_op_avx (VMINMAX Min (IntVecMinMax False)) l w x y -- VPMINUB (AVX) + | otherwise -> vector_int_op_sse (MINMAX Min (IntVecMinMax False)) l w x y -- PMINUB (SSE2) MO_VU_Min l@8 w@W16 + | avx -> vector_int_op_avx (VMINMAX Min (IntVecMinMax False)) l w x y -- VPMINUW (AVX) | sse4_1 -> vector_int_op_sse (MINMAX Min (IntVecMinMax False)) l w x y -- PMINUW (SSE4.1) | otherwise -> vector_word_minmax_sse Min l w x y MO_VU_Min l@4 w@W32 + | avx -> vector_int_op_avx (VMINMAX Min (IntVecMinMax False)) l w x y -- VPMINUD (AVX) | sse4_1 -> vector_int_op_sse (MINMAX Min (IntVecMinMax False)) l w x y -- PMINUD (SSE4.1) | otherwise -> vector_word_minmax_sse Min l w x y MO_VU_Min l@2 w@W64 + | avx512vl -> vector_int_op_avx (VMINMAX Min (IntVecMinMax False)) l w x y -- VPMINUQ (AVX512F+VL) | sse4_2 -> vector_word_minmax_sse Min l w x y -- PCMPGTQ requires SSE4.2 -- The SSE2 version is implemented as a C call (MO_W64X2_Min) MO_VU_Min {} -> needLlvm mop MO_VU_Max l@16 w@W8 - -> vector_int_op_sse (MINMAX Max (IntVecMinMax False)) l w x y -- PMAXUB (SSE2) + | avx -> vector_int_op_avx (VMINMAX Max (IntVecMinMax False)) l w x y -- VPMAXUB (AVX) + | otherwise -> vector_int_op_sse (MINMAX Max (IntVecMinMax False)) l w x y -- PMAXUB (SSE2) MO_VU_Max l@8 w@W16 + | avx -> vector_int_op_avx (VMINMAX Max (IntVecMinMax False)) l w x y -- VPMAXUW (AVX) | sse4_1 -> vector_int_op_sse (MINMAX Max (IntVecMinMax False)) l w x y -- PMAXUW (SSE4.1) | otherwise -> vector_word_minmax_sse Max l w x y MO_VU_Max l@4 w@W32 + | avx -> vector_int_op_avx (VMINMAX Max (IntVecMinMax False)) l w x y -- VPMAXUD (AVX) | sse4_1 -> vector_int_op_sse (MINMAX Max (IntVecMinMax False)) l w x y -- PMAXUD (SSE4.1) | otherwise -> vector_word_minmax_sse Max l w x y MO_VU_Max l@2 w@W64 + | avx512vl -> vector_int_op_avx (VMINMAX Max (IntVecMinMax False)) l w x y -- VPMAXUQ (AVX512F+VL) | sse4_2 -> vector_word_minmax_sse Max l w x y -- PCMPGTQ requires SSE4.2 -- The SSE2 version is implemented as a C call (MO_W64X2_Max) MO_VU_Max {} -> needLlvm mop MO_VS_Min l@16 w@W8 + | avx -> vector_int_op_avx (VMINMAX Min (IntVecMinMax True)) l w x y -- VPMINSB (AVX) | sse4_1 -> vector_int_op_sse (MINMAX Min (IntVecMinMax True)) l w x y -- PMINSB (SSE4.1) | otherwise -> vector_int_minmax_sse Min l w x y MO_VS_Min l@8 w@W16 - -> vector_int_op_sse (MINMAX Min (IntVecMinMax True)) l w x y -- PMINSW (SSE2) + | avx -> vector_int_op_avx (VMINMAX Min (IntVecMinMax True)) l w x y -- VPMINSW (AVX) + | otherwise -> vector_int_op_sse (MINMAX Min (IntVecMinMax True)) l w x y -- PMINSW (SSE2) MO_VS_Min l@4 w@W32 + | avx -> vector_int_op_avx (VMINMAX Min (IntVecMinMax True)) l w x y -- VPMINSD (AVX) | sse4_1 -> vector_int_op_sse (MINMAX Min (IntVecMinMax True)) l w x y -- PMINSD (SSE4.1) | otherwise -> vector_int_minmax_sse Min l w x y MO_VS_Min l@2 w@W64 + | avx512vl -> vector_int_op_avx (VMINMAX Min (IntVecMinMax True)) l w x y -- VPMINSQ (AVX512F+VL) | sse4_2 -> vector_int_minmax_sse Min l w x y -- PCMPGTQ requires SSE4.2 -- The SSE2 version is implemented as a C call (MO_I64X2_Min) MO_VS_Min {} -> needLlvm mop MO_VS_Max l@16 w@W8 + | avx -> vector_int_op_avx (VMINMAX Max (IntVecMinMax True)) l w x y -- VPMAXSB (AVX) | sse4_1 -> vector_int_op_sse (MINMAX Max (IntVecMinMax True)) l w x y -- PMAXSB (SSE4.1) | otherwise -> vector_int_minmax_sse Max l w x y MO_VS_Max l@8 w@W16 - -> vector_int_op_sse (MINMAX Max (IntVecMinMax True)) l w x y -- PMAXSW (SSE2) + | avx -> vector_int_op_avx (VMINMAX Max (IntVecMinMax True)) l w x y -- VPMAXSW (AVX) + | otherwise -> vector_int_op_sse (MINMAX Max (IntVecMinMax True)) l w x y -- PMAXSW (SSE2) MO_VS_Max l@4 w@W32 + | avx -> vector_int_op_avx (VMINMAX Max (IntVecMinMax True)) l w x y -- VPMAXSD (AVX) | sse4_1 -> vector_int_op_sse (MINMAX Max (IntVecMinMax True)) l w x y -- PMAXSD (SSE4.1) | otherwise -> vector_int_minmax_sse Max l w x y MO_VS_Max l@2 w@W64 + | avx512vl -> vector_int_op_avx (VMINMAX Max (IntVecMinMax True)) l w x y -- VPMAXSQ (AVX512F+VL) | sse4_2 -> vector_int_minmax_sse Max l w x y -- PCMPGTQ requires SSE4.2 -- The SSE2 version is implemented as a C call (MO_I64X2_Max) MO_VS_Max {} -> needLlvm mop @@ -1975,7 +2002,6 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps (PUNPCKLDQ format (OpReg tmpOdd1) dst) -- dst <- (dst[0],tmpOdd1[0],dst[1],tmpOdd1[1]) return (Any format code) - -- TODO: We could use `VPMULLQ` if AVX-512 or AVX10.1 is available. vector_int64x2_mul_sse2 :: CmmExpr -> CmmExpr -> NatM Register vector_int64x2_mul_sse2 expr1 expr2 = do -- implement 64 bit multiplication using 32-bit PMULUDQ multiplication instructions ===================================== compiler/GHC/CmmToAsm/X86/Instr.hs ===================================== @@ -338,6 +338,7 @@ data Instr | PADD Format Operand Reg | PSUB Format Operand Reg | PMULL Format Operand Reg + | VPMULL Format Operand Reg Reg | PMULUDQ Format Operand Reg -- SIMD compare @@ -601,6 +602,7 @@ regUsageOfInstr platform instr PADD fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] PSUB fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] PMULL fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] + VPMULL fmt s1 s2 dst -> mkRU (use_R fmt s1 [mk fmt s2]) [mk fmt dst] PMULUDQ fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] PCMPGT fmt src dst -> mkRU (use_R fmt src [mk fmt dst]) [mk fmt dst] @@ -912,6 +914,7 @@ patchRegsOfInstr platform instr env PADD fmt src dst -> PADD fmt (patchOp src) (env dst) PSUB fmt src dst -> PSUB fmt (patchOp src) (env dst) PMULL fmt src dst -> PMULL fmt (patchOp src) (env dst) + VPMULL fmt s1 s2 dst -> VPMULL fmt (patchOp s1) (env s2) (env dst) PMULUDQ fmt src dst -> PMULUDQ fmt (patchOp src) (env dst) PCMPGT fmt src dst -> PCMPGT fmt (patchOp src) (env dst) ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -1012,6 +1012,8 @@ pprInstr platform i = case i of -> pprFormatOpReg (text "psub") format src dst PMULL format src dst -> pprFormatOpReg (text "pmull") format src dst + VPMULL format s1 s2 dst + -> pprFormatOpRegReg (text "vpmull") format s1 s2 dst PMULUDQ format src dst -> pprOpReg (text "pmuludq") format src dst PCMPGT format src dst @@ -1574,7 +1576,8 @@ pprInstr platform i = case i of pprMinMax wantV minOrMax mmTy fmt regs = line $ hcat ( instr : intersperse comma ( map ( pprOperand platform fmt ) regs ) ) where - instr = (if wantV then text "v" else empty) + instr = char '\t' + <> (if wantV then text "v" else empty) <> (case mmTy of { IntVecMinMax {} -> text "p"; FloatMinMax -> empty }) <> (case minOrMax of { Min -> text "min"; Max -> text "max" }) <> (case mmTy of { IntVecMinMax wantSigned -> if wantSigned then text "s" else text "u"; FloatMinMax -> empty }) ===================================== compiler/GHC/Driver/Config/CmmToAsm.hs ===================================== @@ -65,6 +65,9 @@ initNCGConfig dflags this_mod = NCGConfig ArchX86 -> v _ -> Nothing , ncgAvx512fEnabled = isAvx512fEnabled dflags + , ncgAvx512vlEnabled = isAvx512vlEnabled dflags + , ncgAvx512bwEnabled = isAvx512bwEnabled dflags + , ncgAvx512dqEnabled = isAvx512dqEnabled dflags , ncgLa664Enabled = isLa664Enabled dflags ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -83,11 +83,15 @@ module GHC.Driver.DynFlags ( isSse4_2Enabled, isAvxEnabled, isAvx2Enabled, + isAvx512bwEnabled, isAvx512cdEnabled, + isAvx512dqEnabled, isAvx512erEnabled, isAvx512fEnabled, isAvx512pfEnabled, + isAvx512vlEnabled, isFmaEnabled, + isGfniEnabled, isBmiEnabled, isBmi2Enabled, -- For LoongArch platform @@ -454,12 +458,16 @@ data DynFlags = DynFlags { -- | Machine dependent flags (-m\<blah> stuff) sseAvxVersion :: Maybe SseAvxVersion, bmiVersion :: Maybe BmiVersion, - avx512cd :: Bool, -- Enable AVX-512 Conflict Detection Instructions. - avx512er :: Bool, -- Enable AVX-512 Exponential and Reciprocal Instructions. - avx512f :: Bool, -- Enable AVX-512 instructions. - avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. + avx512bw :: Bool, -- ^ Enable AVX-512BW Instructions. + avx512cd :: Bool, -- ^ Enable AVX-512 Conflict Detection Instructions. + avx512dq :: Bool, -- ^ Enable AVX-512DQ Instructions. + avx512er :: Bool, -- ^ Enable AVX-512 Exponential and Reciprocal Instructions. + avx512f :: Bool, -- ^ Enable AVX-512 instructions. + avx512pf :: Bool, -- ^ Enable AVX-512 PreFetch Instructions. + avx512vl :: Bool, -- ^ Enable AVX-512VL Instructions. fma :: Bool, -- ^ Enable FMA instructions. - la664 :: Bool, -- Enable LA664 instructions + gfni :: Bool, -- ^ Enable GFNI Instructions. + la664 :: Bool, -- ^ Enable LA664 instructions -- Constants used to control the amount of optimization done. @@ -737,12 +745,16 @@ defaultDynFlags mySettings = interactivePrint = Nothing, sseAvxVersion = Nothing, bmiVersion = Nothing, + avx512bw = False, avx512cd = False, + avx512dq = False, avx512er = False, avx512f = False, avx512pf = False, + avx512vl = False, -- Use FMA by default on AArch64 fma = (platformArch . sTargetPlatform $ mySettings) == ArchAArch64, + gfni = False, -- For LoongArch, la464 is used by default. la664 = False, @@ -1616,18 +1628,27 @@ isAvxEnabled dflags = sseAvxVersion dflags >= Just AVX1 || (isX86 && fma dflags) isAvx2Enabled :: DynFlags -> Bool isAvx2Enabled dflags = sseAvxVersion dflags >= Just AVX2 || isAvx512fEnabled dflags +isAvx512bwEnabled :: DynFlags -> Bool +isAvx512bwEnabled dflags = avx512bw dflags + isAvx512cdEnabled :: DynFlags -> Bool isAvx512cdEnabled dflags = avx512cd dflags +isAvx512dqEnabled :: DynFlags -> Bool +isAvx512dqEnabled dflags = avx512dq dflags + isAvx512erEnabled :: DynFlags -> Bool isAvx512erEnabled dflags = avx512er dflags isAvx512fEnabled :: DynFlags -> Bool -isAvx512fEnabled dflags = avx512f dflags || avx512cd dflags || avx512er dflags || avx512pf dflags +isAvx512fEnabled dflags = avx512f dflags || avx512bw dflags || avx512cd dflags || avx512dq dflags || avx512er dflags || avx512pf dflags || avx512vl dflags isAvx512pfEnabled :: DynFlags -> Bool isAvx512pfEnabled dflags = avx512pf dflags +isAvx512vlEnabled :: DynFlags -> Bool +isAvx512vlEnabled dflags = avx512vl dflags + isFmaEnabled :: DynFlags -> Bool isFmaEnabled dflags = fma dflags || (isX86 && isAvx512fEnabled dflags) where @@ -1637,6 +1658,9 @@ isFmaEnabled dflags = fma dflags || (isX86 && isAvx512fEnabled dflags) ArchX86 -> True _ -> False +isGfniEnabled :: DynFlags -> Bool +isGfniEnabled dflags = gfni dflags + {- Note [Implications between X86 CPU feature flags] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Many X86 CPU feature flags (such as -mavx, -mfma or -msse4) imply other @@ -1649,7 +1673,7 @@ structures: together with other implications such as 3. FMA -> AVX - 4. AVX512{CD,ED,PF} -> AVX512F -> AVX2 + 4. AVX512{BW,CD,DQ,ER,PF,VL} -> AVX512F -> AVX2 We handle this as follows: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -984,13 +984,17 @@ llvmOptions llvm_config llvm_version dflags = -- It may become deprecated in a future LLVM version, though. ++ ["+avx2" | isAvx2Enabled dflags ] ++ ["+avx" | isAvxEnabled dflags ] + ++ ["+avx512bw"| isAvx512bwEnabled dflags ] ++ ["+avx512cd"| isAvx512cdEnabled dflags ] + ++ ["+avx512dq"| isAvx512dqEnabled dflags ] ++ ["+avx512er"| isAvx512erEnabled dflags ] ++ ["+avx512pf"| isAvx512pfEnabled dflags ] - -- For Arch64 +fma is not a option (it's unconditionally available). + ++ ["+avx512vl"| isAvx512vlEnabled dflags ] + -- For AArch64 +fma is not a option (it's unconditionally available). ++ ["+fma" | isFmaEnabled dflags && (arch /= ArchAArch64) ] ++ ["+bmi" | isBmiEnabled dflags ] ++ ["+bmi2" | isBmi2Enabled dflags ] + ++ ["+gfni" | isGfniEnabled dflags ] abi :: String abi = case platformArch (targetPlatform dflags) of ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -212,11 +212,15 @@ module GHC.Driver.Session ( isBmi2Enabled, isAvxEnabled, isAvx2Enabled, + isAvx512bwEnabled, isAvx512cdEnabled, + isAvx512dqEnabled, isAvx512erEnabled, isAvx512fEnabled, isAvx512pfEnabled, + isAvx512vlEnabled, isFmaEnabled, + isGfniEnabled, -- LoongArch: ISA version: la664, la464(default) isLa664Enabled, @@ -1723,14 +1727,17 @@ dynamic_flags_deps = [ d { sseAvxVersion = max (Just AVX1) (sseAvxVersion d) })) , make_ord_flag defGhcFlag "mavx2" (noArg (\d -> d { sseAvxVersion = max (Just AVX2) (sseAvxVersion d) })) - , make_ord_flag defGhcFlag "mavx512cd" (noArg (\d -> - d { avx512cd = True })) - , make_ord_flag defGhcFlag "mavx512er" (noArg (\d -> - d { avx512er = True })) + , make_ord_flag defGhcFlag "mavx512bw" (noArg (\d -> d { avx512bw = True })) + , make_ord_flag defGhcFlag "mavx512cd" (noArg (\d -> d { avx512cd = True })) + , make_ord_flag defGhcFlag "mavx512dq" (noArg (\d -> d { avx512dq = True })) + , make_dep_flag defGhcFlag "mavx512er" (noArg (\d -> d { avx512er = True })) + "AVX-512ER was only available on Xeon Phi" , make_ord_flag defGhcFlag "mavx512f" (noArg (\d -> d { avx512f = True })) - , make_ord_flag defGhcFlag "mavx512pf" (noArg (\d -> - d { avx512pf = True })) + , make_dep_flag defGhcFlag "mavx512pf" (noArg (\d -> d { avx512pf = True })) + "AVX-512PF was only available on Xeon Phi" + , make_ord_flag defGhcFlag "mavx512vl" (noArg (\d -> d { avx512vl = True })) , make_ord_flag defGhcFlag "mfma" (noArg (\d -> d { fma = True })) + , make_ord_flag defGhcFlag "mgfni" (noArg (\d -> d { gfni = True })) , make_ord_flag defGhcFlag "mla664" (noArg (\d -> d { la664 = True })) ===================================== compiler/GHC/HsToCore/Usage.hs ===================================== @@ -36,7 +36,7 @@ import GHC.Data.Maybe import GHC.Data.FastString import Data.IORef -import Data.List (sortBy) +import Data.List (sortBy, sortOn) import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Set as Set @@ -73,6 +73,8 @@ data UsageConfig = UsageConfig { uc_safe_implicit_imps_req :: !Bool -- ^ Are all implicit imports required to be safe for this Safe Haskell mode? } +-- | Build the list of 'Usage's that drives recompilation checking. +-- The resulting list is deterministically sorted (see 'usageFingerprint'). mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv -> Module -> ImportedMods -> [ImportUserSpec] -> NameSet -> [FilePath] -> [FilePath] -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded @@ -105,7 +107,10 @@ mkUsageInfo uc plugins fc unit_env } | (mod, hash) <- merged ] ++ object_usages - usages `seqList` return usages + + -- Sort all the Usages to ensure a deterministic ordering. + let sorted_usages = sortOn usageFingerprint usages + sorted_usages `seqList` return sorted_usages -- seq the list of Usages returned: occasionally these -- don't get evaluated for a while and we can end up hanging on to -- the entire collection of Ifaces. ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -165,10 +165,16 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let avx_defs = [ "-D__AVX__" | isAvxEnabled dflags ] ++ [ "-D__AVX2__" | isAvx2Enabled dflags ] ++ + [ "-D__AVX512BW__" | isAvx512bwEnabled dflags ] ++ [ "-D__AVX512CD__" | isAvx512cdEnabled dflags ] ++ + [ "-D__AVX512DQ__" | isAvx512dqEnabled dflags ] ++ [ "-D__AVX512ER__" | isAvx512erEnabled dflags ] ++ [ "-D__AVX512F__" | isAvx512fEnabled dflags ] ++ - [ "-D__AVX512PF__" | isAvx512pfEnabled dflags ] + [ "-D__AVX512PF__" | isAvx512pfEnabled dflags ] ++ + [ "-D__AVX512VL__" | isAvx512vlEnabled dflags ] + + let gfni_def = + [ "-D__GFNI__" | isGfniEnabled dflags ] backend_defs <- applyCDefs (backendCDefs $ backend dflags) logger dflags @@ -209,6 +215,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do ++ map GHC.SysTools.Option sse_defs ++ map GHC.SysTools.Option fma_def ++ map GHC.SysTools.Option avx_defs + ++ map GHC.SysTools.Option gfni_def ++ map GHC.SysTools.Option io_manager_defs ++ mb_macro_include ++ line_pragmas ===================================== compiler/GHC/Unit/Module/Deps.hs ===================================== @@ -17,6 +17,7 @@ module GHC.Unit.Module.Deps , noDependencies , pprDeps , Usage (..) + , usageFingerprint , HomeModImport (..) , HomeModImportedAvails (..) , ImportAvails (..) @@ -492,6 +493,17 @@ instance Binary Usage where i -> error ("Binary.get(Usage): " ++ show i) +-- | Extract the distinguishing fingerprint carried by a particular 'Usage' +-- constructor. Every constructor stores a hash capturing the bit of state +-- that drives recompilation decisions, so we can sort on it directly. +usageFingerprint :: Usage -> Fingerprint +usageFingerprint UsagePackageModule{ usg_mod_hash = fp } = fp +usageFingerprint UsageHomeModule{ usg_mod_hash = fp } = fp +usageFingerprint UsageFile{ usg_file_hash = fp } = fp +usageFingerprint UsageDirectory{ usg_dir_hash = fp } = fp +usageFingerprint UsageHomeModuleInterface{ usg_iface_hash = fp } = fp +usageFingerprint UsageMergedRequirement{ usg_mod_hash = fp } = fp + -- | Records the imports that we depend on from a home module, -- for recompilation checking. -- ===================================== docs/users_guide/9.16.1-notes.rst ===================================== @@ -101,6 +101,9 @@ to See :ghc-ticket:`25345`. +- Add several options for x86 extensions: :ghc-flag:`-mavx512bw`, + :ghc-flag:`-mavx512dq`, :ghc-flag:`-mavx512vl`, and :ghc-flag:`-mgfni`. + GHCi ~~~~ ===================================== docs/users_guide/phases.rst ===================================== @@ -553,8 +553,10 @@ SIMD macros These are defined conditionally based on the SIMD flags used for compilation: - ``__SSE__``, ``__SSE2__``, ``__SSE4_2__``, ``__FMA__``, - ``__AVX__``, ``__AVX2__``, ``__AVX512CD__``, ``__AVX512ER__``, ``__AVX512F__``, ``__AVX512PF__``, + ``__SSE__``, ``__SSE2__``, ``__SSE3__``, ``__SSSE3__``, + ``__SSE4_1__``, ``__SSE4_2__``, ``__FMA__``, ``__AVX__``, ``__AVX2__``, + ``__AVX512BW__``, ``__AVX512CD__``, ``__AVX512DQ__``, ``__AVX512ER__``, + ``__AVX512F__``, ``__AVX512PF__``, ``__AVX512VL__``, ``__GFNI__`` .. _cpp-string-gaps: ===================================== docs/users_guide/using.rst ===================================== @@ -1601,7 +1601,7 @@ Some flags only make sense for particular target platforms. :implies: :ghc-flag:`-msse4.2` (x86 only) This flag allows the code generator (whether the :ref:`native code generator <native-code-gen>` - or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86_64 AVX instructions. + or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86 AVX instructions. .. ghc-flag:: -mavx2 :shortdesc: (x86 only) Enable support for AVX2 SIMD extensions @@ -1611,47 +1611,84 @@ Some flags only make sense for particular target platforms. :implies: :ghc-flag:`-mavx` (x86 only) This flag allows the code generator (whether the :ref:`native code generator <native-code-gen>` - or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86_64 AVX2 instructions. + or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86 AVX2 instructions. + +.. ghc-flag:: -mavx512bw + :shortdesc: (x86 only) Enable support for AVX-512BW SIMD extensions + :type: dynamic + :category: platform-options + + :since: 9.16.1 + :implies: :ghc-flag:`-mavx512f` + + (x86 only) This flag allows the code generator (whether the :ref:`native code generator <native-code-gen>` + or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86 AVX-512BW instructions. .. ghc-flag:: -mavx512cd - :shortdesc: (x86 only) Enable support for AVX512-CD SIMD extensions + :shortdesc: (x86 only) Enable support for AVX-512CD SIMD extensions :type: dynamic :category: platform-options :implies: :ghc-flag:`-mavx512f` (x86 only) This flag allows the code generator (whether the :ref:`native code generator <native-code-gen>` - or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86_64 AVX512-CD instructions. + or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86 AVX-512CD instructions. + +.. ghc-flag:: -mavx512dq + :shortdesc: (x86 only) Enable support for AVX-512DQ SIMD extensions + :type: dynamic + :category: platform-options + + :since: 9.16.1 + :implies: :ghc-flag:`-mavx512f` + + (x86 only) This flag allows the code generator (whether the :ref:`native code generator <native-code-gen>` + or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86 AVX-512DQ instructions. .. ghc-flag:: -mavx512er - :shortdesc: (x86 only) Enable support for AVX512-ER SIMD extensions + :shortdesc: (x86 only, deprecated) Enable support for AVX-512ER SIMD extensions :type: dynamic :category: platform-options :implies: :ghc-flag:`-mavx512f` (x86 only) This flag allows the code generator (whether the :ref:`native code generator <native-code-gen>` - or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86_64 AVX512-ER instructions. + or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86 AVX-512ER instructions. + + The AVX-512ER extension is deprecated and not supported by newer LLVM versions. .. ghc-flag:: -mavx512f - :shortdesc: (x86 only) Enable support for AVX512-F SIMD extensions + :shortdesc: (x86 only) Enable support for AVX-512F SIMD extensions :type: dynamic :category: platform-options :implies: :ghc-flag:`-mavx2`, :ghc-flag:`-mfma` (x86 only) This flag allows the code generator (whether the :ref:`native code generator <native-code-gen>` - or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86_64 AVX512-F instructions. + or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86 AVX-512F instructions. .. ghc-flag:: -mavx512pf - :shortdesc: (x86 only) Enable support for AVX512-PF SIMD extensions + :shortdesc: (x86 only, deprecated) Enable support for AVX-512PF SIMD extensions :type: dynamic :category: platform-options :implies: :ghc-flag:`-mavx512f` (x86 only) This flag allows the code generator (whether the :ref:`native code generator <native-code-gen>` - or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86_64 AVX512-PF instructions. + or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86 AVX-512PF instructions. + + The AVX-512PF extension is deprecated and not supported by newer LLVM versions. + +.. ghc-flag:: -mavx512vl + :shortdesc: (x86 only) Enable support for AVX-512VL SIMD extensions + :type: dynamic + :category: platform-options + + :since: 9.16.1 + :implies: :ghc-flag:`-mavx512f` + + (x86 only) This flag allows the code generator (whether the :ref:`native code generator <native-code-gen>` + or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86 AVX-512VL instructions. .. ghc-flag:: -msse :shortdesc: (x86 only) Use SSE for floating-point operations @@ -1714,13 +1751,13 @@ Some flags only make sense for particular target platforms. or the :ref:`LLVM backend <llvm-code-gen>`). .. ghc-flag:: -msse4 - :shortdesc: (x86 only) Use SSE4 for floating-point operations + :shortdesc: (x86 only) Use SSE4.1 for floating-point operations :type: dynamic :category: platform-options :implies: :ghc-flag:`-mssse3` - (x86 only) Use the SSE4 instruction set to + (x86 only) Use the SSE4.1 instruction set to implement some floating point and bit operations(whether using the :ref:`native code generator <native-code-gen>` or the :ref:`LLVM backend <llvm-code-gen>`). @@ -1781,6 +1818,16 @@ Some flags only make sense for particular target platforms. multiply-add, which might perform non-IEEE-compliant software emulation on some platforms (depending on the implementation of the C standard library). +.. ghc-flag:: -mgfni + :shortdesc: (x86 only) Use GFNI for advanced bit manipulations + :type: dynamic + :category: platform-options + + :since: 9.16.1 + + (x86 only) This flag allows the code generator (whether the :ref:`native code generator <native-code-gen>` + or the :ref:`LLVM backend <llvm-code-gen>`) to emit x86 GFNI instructions. + .. ghc-flag:: -mla664 :shortdesc: (LoongArch only) Used for new instructions for la664 uarch :type: dynamic ===================================== testsuite/driver/cpu_features.py ===================================== @@ -9,9 +9,9 @@ SUPPORTED_CPU_FEATURES = { # x86: 'sse', 'sse2', 'sse3', 'pni', 'ssse3', 'sse4_1', 'sse4_2', - 'avx', 'avx2', 'avx512f', + 'avx', 'avx2', 'avx512f', 'avx512vl', 'avx512bw', 'avx512dq', 'fma', - 'popcnt', 'bmi1', 'bmi2' + 'popcnt', 'bmi1', 'bmi2', 'gfni', } cpu_feature_cache = None ===================================== testsuite/tests/codeGen/should_gen_asm/all.T ===================================== @@ -17,3 +17,9 @@ test('msse-option-order', [unless(arch('x86_64') or arch('i386'), skip), when(unregisterised(), skip)], compile_grep_asm, ['hs', False, '-msse4.2 -msse2']) test('mavx-should-enable-popcnt', [unless(arch('x86_64') or arch('i386'), skip), when(unregisterised(), skip)], compile_grep_asm, ['hs', False, '-mavx']) +test('avx512-int64-mul', [unless(arch('x86_64') or arch('i386'), skip), + when(unregisterised(), skip)], compile_grep_asm, ['hs', True, '-mavx512dq -mavx512vl']) +test('avx512-int64-minmax', [unless(arch('x86_64') or arch('i386'), skip), + when(unregisterised(), skip)], compile_grep_asm, ['hs', True, '-mavx512vl']) +test('avx512-word64-minmax', [unless(arch('x86_64') or arch('i386'), skip), + when(unregisterised(), skip)], compile_grep_asm, ['hs', True, '-mavx512vl']) ===================================== testsuite/tests/codeGen/should_gen_asm/avx512-int64-minmax.asm ===================================== @@ -0,0 +1,2 @@ +vpminsq +vpmaxsq ===================================== testsuite/tests/codeGen/should_gen_asm/avx512-int64-minmax.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ExtendedLiterals #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +import GHC.Exts +import GHC.Prim +import GHC.Int + +{-# NOINLINE f #-} +f :: Int64X2# -> Int64X2# -> Int64X2# -> Int64X2# +f x y z = minInt64X2# x (plusInt64X2# y z) + +{-# NOINLINE g #-} +g :: Int64X2# -> Int64X2# -> Int64X2# -> Int64X2# +g x y z = maxInt64X2# x (plusInt64X2# y z) + +main :: IO () +main = do + let !x = packInt64X2# (# 1#Int64, 10#Int64 #) + !y = packInt64X2# (# 4#Int64, 2#Int64 #) + !z = broadcastInt64X2# 5#Int64 + !w = f x y z + (# w0, w1 #) = unpackInt64X2# w + !v = g x y z + (# v0, v1 #) = unpackInt64X2# v + print (I64# w0, I64# w1) + print (I64# v0, I64# v1) ===================================== testsuite/tests/codeGen/should_gen_asm/avx512-int64-mul.asm ===================================== @@ -0,0 +1 @@ +vpmullq ===================================== testsuite/tests/codeGen/should_gen_asm/avx512-int64-mul.hs ===================================== @@ -0,0 +1,19 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ExtendedLiterals #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +import GHC.Exts +import GHC.Int + +{-# NOINLINE f #-} +f :: Int64X2# -> Int64X2# -> Int64X2# -> Int64X2# +f x y z = timesInt64X2# x (plusInt64X2# y z) + +main :: IO () +main = do + let !x = packInt64X2# (# 1#Int64, 3#Int64 #) + !y = packInt64X2# (# 4#Int64, 2#Int64 #) + !z = broadcastInt64X2# 5#Int64 + !w = f x y z + (# w0, w1 #) = unpackInt64X2# w + print (I64# w0, I64# w1) ===================================== testsuite/tests/codeGen/should_gen_asm/avx512-word64-minmax.asm ===================================== @@ -0,0 +1,2 @@ +vpminuq +vpmaxuq ===================================== testsuite/tests/codeGen/should_gen_asm/avx512-word64-minmax.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ExtendedLiterals #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +import GHC.Exts +import GHC.Prim +import GHC.Word + +{-# NOINLINE f #-} +f :: Word64X2# -> Word64X2# -> Word64X2# -> Word64X2# +f x y z = minWord64X2# x (plusWord64X2# y z) + +{-# NOINLINE g #-} +g :: Word64X2# -> Word64X2# -> Word64X2# -> Word64X2# +g x y z = maxWord64X2# x (plusWord64X2# y z) + +main :: IO () +main = do + let !x = packWord64X2# (# 1#Word64, 10#Word64 #) + !y = packWord64X2# (# 4#Word64, 2#Word64 #) + !z = broadcastWord64X2# 5#Word64 + !w = f x y z + (# w0, w1 #) = unpackWord64X2# w + !v = g x y z + (# v0, v1 #) = unpackWord64X2# v + print (W64# w0, W64# w1) + print (W64# v0, W64# v1) ===================================== testsuite/tests/driver/recomp016/recomp016.stdout ===================================== @@ -9,4 +9,4 @@ second run [2 of 5] Compiling B ( B.hs, B.o ) [Source file changed] [3 of 5] Compiling C ( C.hs, C.o ) [B changed] [4 of 5] Compiling D ( D.hs, D.o ) [C changed] -[5 of 5] Compiling E ( E.hs, E.o ) [B changed] +[5 of 5] Compiling E ( E.hs, E.o ) [D changed] ===================================== testsuite/tests/simd/should_run/all.T ===================================== @@ -66,6 +66,9 @@ setTestOpts( , when(have_cpu_feature('avx'), extra_hc_opts('-mavx')) , when(have_cpu_feature('avx2'), extra_hc_opts('-mavx2')) , when(have_cpu_feature('avx512f'), extra_hc_opts('-mavx512f')) + , when(have_cpu_feature('avx512vl'), extra_hc_opts('-mavx512vl')) + , when(have_cpu_feature('avx512bw'), extra_hc_opts('-mavx512bw')) + , when(have_cpu_feature('avx512dq'), extra_hc_opts('-mavx512dq')) ]) test('simd000', [], compile_and_run, ['']) ===================================== utils/jsffi/dyld.mjs ===================================== @@ -1470,7 +1470,7 @@ async function nodeMain({ searchDirs, mainSoPath, outFd, inFd, args }) { ); } -const isNodeMain = isNode && import.meta.filename === process.argv[1]; +const isNodeMain = isNode && import.meta.main; // node iserv as invoked by // GHC.Runtime.Interpreter.Wasm.spawnWasmInterp ===================================== utils/jsffi/post-link.mjs ===================================== @@ -119,7 +119,7 @@ function isMain() { return false; } - return import.meta.filename === process.argv[1]; + return import.meta.main; } async function main() { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12f48505d0222691b783f205493605… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12f48505d0222691b783f205493605… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/supersven/hadrian-cross-stage3] Fix final ghc-pkg recache run
by Sven Tennie (＠supersven) 14 Feb '26

14 Feb '26

Sven Tennie pushed to branch wip/supersven/hadrian-cross-stage3 at Glasgow Haskell Compiler / GHC Commits: cfb65334 by Sven Tennie at 2026-02-14T19:44:49+01:00 Fix final ghc-pkg recache run Sage3 cross-compiler's ghc-pkg cannot run on the build host. Resort to a prior stage's ghc-pkg. - - - - - 2 changed files: - hadrian/src/BindistConfig.hs - hadrian/src/Rules/BinaryDist.hs Changes: ===================================== hadrian/src/BindistConfig.hs ===================================== @@ -1,29 +1,33 @@ module BindistConfig where -import Stage -import Oracles.Flag import Expression +import Oracles.Flag -data BindistConfig = BindistConfig { library_stage :: Stage -- ^ The stage compiler which builds the libraries - , executable_stage :: Stage -- ^ The stage compiler which builds the executables - } +data BindistConfig = BindistConfig + { -- | The stage compiler which builds the libraries + library_stage :: Stage, + -- | The stage compiler which builds the executables + executable_stage :: Stage, + -- | Which ghc-pkg to use (`targetBindist`'s + -- ghc-pkg cannot run on the build platform) + use_inplace_ghcPkg :: Bool + } -- | A bindist for when the host = target, non cross-compilation setting. -- Both the libraries and final executables are built with stage1 compiler. normalBindist :: BindistConfig -normalBindist = BindistConfig { library_stage = Stage1, executable_stage = Stage1 } +normalBindist = BindistConfig {library_stage = Stage1, executable_stage = Stage1, use_inplace_ghcPkg = True} -- | A bindist which contains a cross compiler (when host /= target) -- The cross compiler is produced by the stage1 compiler, but then we must compile -- all the boot libraries with the cross compiler (hence stage2 for libraries) crossBindist :: BindistConfig -crossBindist = BindistConfig { library_stage = Stage2, executable_stage = Stage1 } +crossBindist = BindistConfig {library_stage = Stage2, executable_stage = Stage1, use_inplace_ghcPkg = True} -- | A bindist which contains executables for the target, which produce code for the -- target. These are produced as "Stage3" build products, produced by a stage2 cross compiler. -targetBindist :: BindistConfig -targetBindist = BindistConfig { library_stage = Stage2, executable_stage = Stage2 } - +targetBindist :: BindistConfig +targetBindist = BindistConfig {library_stage = Stage2, executable_stage = Stage2, use_inplace_ghcPkg = False} -- | The implicit bindist config, if we don't know any better. implicitBindistConfig :: Action BindistConfig @@ -35,7 +39,7 @@ implicitBindistConfig = do return $ if cross then crossBindist else normalBindist -- | Are we building things in this stage for the final target? -buildingForTarget :: Stage -> Action Bool +buildingForTarget :: Stage -> Action Bool buildingForTarget st = do cfg <- implicitBindistConfig return $ st >= (library_stage cfg) ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -222,9 +222,16 @@ buildBinDistDir dirPrefix root conf@BindistConfig{..} = do -- -- N.B. the ghc-pkg executable may be prefixed with a target triple -- (c.f. #20267). - - ghcPkgName <- programName (vanillaContext executable_stage ghcPkg) - cmd_ (bindistFilesDir -/- "bin" -/- ghcPkgName) ["recache", "--package-db", bindistFilesDir -/- "lib" -/- "package.conf.d" ] + -- + -- For Stage3 cross-compilers (those that are supposed to run on the target + -- platform), we have to resort to a prior stage's ghc-pkg as the final + -- stage can naturally not be executed on our current build host. + if use_inplace_ghcPkg then do + ghcPkgName <- programName (vanillaContext executable_stage ghcPkg) + cmd_ (bindistFilesDir -/- "bin" -/- ghcPkgName) ["recache", "--package-db", bindistFilesDir -/- "lib" -/- "package.conf.d" ] + else do + ghcPkgPath <- builderPath $ GhcPkg Recache library_stage + cmd_ ghcPkgPath ["recache", "--package-db", bindistFilesDir -/- "lib" -/- "package.conf.d" ] need ["docs"] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cfb653349053053053a9982ee181623… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cfb653349053053053a9982ee181623… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/supersven/hadrian-cross-stage3] 83 commits: PPC NCG: Generate clear right insn at arch width
by Sven Tennie (＠supersven) 14 Feb '26

14 Feb '26

Sven Tennie pushed to branch wip/supersven/hadrian-cross-stage3 at Glasgow Haskell Compiler / GHC Commits: 56db94f7 by Peter Trommler at 2026-01-26T11:26:18+01:00 PPC NCG: Generate clear right insn at arch width The clear right immediate (clrrxi) is only available in word and doubleword width. Generate clrrxi instructions at architecture width for all MachOp widths. Fixes #24145 - - - - - 5957a8ad by Wolfgang Jeltsch at 2026-01-27T06:11:40-05:00 Add operations for obtaining operating-system handles This contribution implements CLC proposal #369. It adds operations for obtaining POSIX file descriptors and Windows handles that underlie Haskell handles. Those operating system handles can also be obtained without such additional operations, but this is more involved and, more importantly, requires using internals. - - - - - 86a0510c by Greg Steuck at 2026-01-27T06:12:34-05:00 Move flags to precede patterns for grep and read files directly This makes the tests pass with non-GNU (i.e. POSIX-complicant) tools. There's no reason to use cat and pipe where direct file argument works. - - - - - 50761451 by Cheng Shao at 2026-01-27T21:51:23-05:00 ci: update darwin boot ghc to 9.10.3 This patch updates darwin boot ghc to 9.10.3, along with other related updates, and pays off some technical debt here: - Update `nixpkgs` and use the `nixpkgs-25.05-darwin` channel. - Update the `niv` template. - Update LLVM to 21 and update `llvm-targets` to reflect LLVM 21 layout changes for arm64/x86_64 darwin targets. - Use `stdenvNoCC` to prevent nix packaged apple sdk from being used by boot ghc, and manually set `DEVELOPER_DIR`/`SDKROOT` to enforce the usage of system-wide command line sdk for macos. - When building nix derivation for boot ghc, run `configure` via the `arch` command so that `configure` and its subprocesses pick up the manually specified architecture. - Remove the previous horrible hack that obliterates `configure` to make autoconf test result in true. `configure` now properly does its job. - Remove the now obsolete configure args and post install settings file patching logic. - Use `scheme-small` for texlive to avoid build failures in certain unused texlive packages, especially on x86_64-darwin. - - - - - 94dcd15e by Matthew Pickering at 2026-01-27T21:52:05-05:00 Evaluate backtraces for "error" exceptions at the moment they are thrown See Note [Capturing the backtrace in throw] and Note [Hiding precise exception signature in throw] which explain the implementation. This commit makes `error` and `throw` behave the same with regard to backtraces. Previously, exceptions raised by `error` would not contain useful IPE backtraces. I did try and implement `error` in terms of `throw` but it started to involve putting diverging functions into hs-boot files, which seemed to risky if the compiler wouldn't be able to see if applying a function would diverge. CLC proposal: https://github.com/haskell/core-libraries-committee/issues/383 Fixes #26751 - - - - - ef35e3ea by Teo Camarasu at 2026-01-27T21:52:46-05:00 ghc-internal: move all Data instances to Data.Data Most instances of Data are defined in GHC.Internal.Data.Data. Let's move all remaining instance there. This moves other modules down in the dependency hierarchy allowing for more parallelism, and it decreases the likelihood that we would need to load this heavy .hi file if we don't actually need it. Resolves #26830 Metric Decrease: T12227 T16875 - - - - - 5e0ec555 by sheaf at 2026-01-28T06:56:38-05:00 Add test case for #25679 This commit adds the T25679 test case. The test now passes, thanks to commit 1e53277af36d3f0b6ad5491f70ffc5593a49dcfd. Fixes #25679 - - - - - f1cd1611 by sheaf at 2026-01-28T06:56:38-05:00 Improve defaulting of representational equalities This commit makes the defaulting of representational equalities, introduced in 1e53277a, a little bit more robust. Now, instead of calling the eager unifier, it calls the full-blown constraint solver, which means that it can handle some subtle situations, e.g. involving functional dependencies and type-family injectivity annotations, such as: type family F a = r | r -> a type instance F Int = Bool [W] F beta ~R Bool - - - - - 25edf516 by sheaf at 2026-01-28T06:56:38-05:00 Improve errors for unsolved representational equalities This commit adds a new field of CtLoc, CtExplanations, which allows the typechecker to leave some information about what it has done. For the moment, it is only used to improve error messages for unsolved representational equalities. The typechecker will now accumulate, when unifying at representational role: - out-of-scope newtype constructors, - type constructors that have nominal role in a certain argument, - over-saturated type constructors, - AppTys, e.g. `c a ~R# c b`, to report that we must assume that 'c' has nominal role in its parameters, - data family applications that do not reduce, potentially preventing newtype unwrapping. Now, instead of having to re-construct the possible errors after the fact, we simply consult the CtExplanations field. Additionally, this commit modifies the typechecker error messages that concern out-of-scope newtype constructors. The error message now depends on whether we have an import suggestion to provide to the user: - If we have an import suggestion for the newtype constructor, the message will be of the form: The data constructor MkN of the newtype N is out of scope Suggested fix: add 'MkN' to the import list in the import of 'M' - If we don't have any import suggestions, the message will be of the form: NB: The type 'N' is an opaque newtype, whose constructor is hidden Fixes #15850, #20289, #20468, #23731, #25949, #26137 - - - - - 4d0e6da1 by Simon Peyton Jones at 2026-01-28T06:57:19-05:00 Fix two bugs in short-cut constraint solving There are two main changes here: * Use `isSolvedWC` rather than `isEmptyWC` in `tryShortCutSolver` The residual constraint may have some fully-solved, but still-there implications, and we don't want them to abort short cut solving! That bug caused #26805. * In the short-cut solver, we abandon the fully-solved residual constraint; but we may thereby lose track of Givens that are needed, and either report them as redundant or prune evidence bindings that are in fact needed. This bug stopped the `constraints` package from compiling; see the trail in !15389. The second bug led me to (another) significant refactoring of the mechanism for tracking needed EvIds. See the new Note [Tracking needed EvIds] in GHC.Tc.Solver.Solve It's simpler and much less head-scratchy now. Some particulars: * An EvBindsVar now tracks NeededEvIds * We deal with NeededEvIds for an implication only when it is fully solved. Much simpler! * `tryShortCutTcS` now takes a `TcM WantedConstraints` rather than `TcM Bool`, so that is can plumb the needed EvIds correctly. * Remove `ic_need` and `ic_need_implic` from Implication (hooray), and add `ics_dm` and `ics_non_dm` to `IC_Solved`. Pure refactor * Shorten data constructor `CoercionHole` to `CH`, following general practice in GHC. * Rename `EvBindMap` to `EvBindsMap` for consistency - - - - - 662480b7 by Cheng Shao at 2026-01-28T06:58:00-05:00 ci: use debian validate bindists instead of fedora release bindists in testing stage This patch changes the `abi-test`, `hadrian-multi` and `perf` jobs in the full-ci pipeline testing stage to use debian validate bindists instead of fedora release bindists, to increase pipeline level parallelism and allow full-ci pipelines to complete earlier. Closes #26818. - - - - - 39581ec6 by Cheng Shao at 2026-01-28T06:58:40-05:00 ci: run perf test with -j$cores This patch makes the perf ci job compile Cabal with -j$cores to speed up the job. - - - - - 607b287b by Wolfgang Jeltsch at 2026-01-28T15:41:53+02:00 Remove `GHC.Desugar` from `base` `GHC.Desugar` was deprecated and should have been removed in GHC 9.14. However, the removal was forgotten, although there was a code block that was intended to trigger a compilation error when the GHC version in use was 9.14 or later. This code sadly didn’t work, because the `__GLASGOW_HASKELL__` macro was misspelled as `__GLASGOW_HASKELL`. - - - - - e8f5a45d by sterni at 2026-01-29T04:19:18-05:00 users_guide: fix runtime error during build with Sphinx 9.1.0 Appears that pathto is stricter about what it accepts now. Tested Sphinx 8.2.3 and 9.1.0 on the ghc-9.10 branch. Resolves #26810. Co-authored-by: Martin Weinelt <hexa(a)darmstadt.ccc.de> - - - - - ce2d62fb by Jessica Clarke at 2026-01-29T19:48:51-05:00 PPC NCG: Use libcall for 64-bit cmpxchg on 32-bit PowerPC There is no native instruction for this, and even if there were a register pair version we could use, the implementation here is assuming the values fit in a single register, and we end up only using / defining the low halves of the registers. Fixes: b4d39adbb5 ("PrimOps: Add CAS op for all int sizes") Fixes: #23969 - - - - - 43d97761 by Michael Karcher at 2026-01-29T19:49:43-05:00 NCG for PPC: add pattern for CmmRegOff to iselExpr64 Closes #26828 - - - - - aeeb4a20 by Matthew Pickering at 2026-01-30T11:42:47-05:00 determinism: Use deterministic map for Strings in TyLitMap When generating typeable evidence the types we need evidence for all cached in a TypeMap, the order terms are retrieved from a type map determines the order the bindings appear in the program. A TypeMap is quite diligent to use deterministic maps, apart from in the TyLitMap, which uses a UniqFM for storing strings, whose ordering depends on the Unique of the FastString. This can cause non-deterministic .hi and .o files. An unexpected side-effect is the error message but RecordDotSyntaxFail8 changing. I looked into this with Sam and this change caused the constraints to be solved in a different order which results in a slightly different error message. I have accepted the new test, since the output before was non-deterministic and the new output is consistent with the other messages in that file. Fixes #26846 - - - - - 9e4d70c2 by Andrew Lelechenko at 2026-01-30T11:43:29-05:00 Upgrade text submodule to 2.1.4 - - - - - 631fa5ae by Recursion Ninja at 2026-01-31T22:30:11+00:00 Decouple `L.S.H.Decls` from importing `GHC.Types.Basic` Data-types within `GHC.Types.Basic` which describe components of the AST are migrated to `Language.Haskell.Syntax.Basic`. Related function definitions are also moved. Types moved to L.H.S. because they are part of the AST: * TopLevelFlag * RuleName Types moved from L.H.S. to GHC.Hs. because they are not needed in the AST: * TyConFlavour * TypeOrData * NewOrData Migrated instances: * `Outputable` instances moved to in `GHC.Utils.Outputable` * `Binary` instance of `Boxity` moved to to `GHC.Utils.Binary` * Other `Binary` instances are orphans to be migrated later. The `OverlapMode` data-type is given a TTG extension point. The `OverlapFlag` data-type, which depends on `OverlapMode`, is updated to support `OverlapMode` with a GHC "pass" type paramerter. In order to avoid module import cycles, `OverlapMode` and `OverlapFlag` are migrated to new modules (no way around this). * Migrated `OverlapMode` to new module `Language.Haskell.Syntax.Overlap` * Migrated `OverlapFlag` to new module `GHC.Hs.Decls.Overlap` - - - - - 9769cc03 by Simon Hengel at 2026-02-01T04:21:03-05:00 Update the documentation for MultiWayIf (fixes #25376) (so that it matches the implementation) - - - - - 5fc9442a by Peter Trommler at 2026-02-01T04:21:44-05:00 hadrian: Fix dependency generation for assembler Assembler files allow # for comments unless in column 1. A modern cpp for C treats those a preprocessor directives. We tell gcc that a .S file is assembler with cpp and not C. Fixes #26819 - - - - - 269c4087 by Simon Peyton Jones at 2026-02-01T19:38:10-05:00 Include current phase in the range for rule/unfoldings This MR fixes a bad loop in the compiler: #26826. The fix is to add (WAR2) to Note [What is active in the RHS of a RULE or unfolding?] in GHC.Core.Opt.Simplify.Utils - - - - - ddf1434f by Vladislav Zavialov at 2026-02-01T19:38:52-05:00 Refactor: merge HsMultilineString into HsString (#26860) Before this patch, HsLit defined two separate constructors to represent single-line and multi-line strings: data HsLit x ... | HsString (XHsString x) FastString | HsMultilineString (XHsMultilineString x) FastString I found this to be an unnecessary complication and an obstacle to unifying HsLit with HsTyLit. Now we use HsString for both kinds of literals. One user-facing change here is `ppr (HsString st s)` behaving differently for single-line strings containing newlines: x = "first line \ \asdf\n\ \second line" Previously, the literal was fed to `ftext` with its newlines, producing an ill-formed SDoc. This issue is now addressed by using `split` for both single-line and multi-line strings: vcat $ map text $ split '\n' (unpackFS src) See the parser/should_fail/T26860ppr test. In addition (and unrelatedly to the main payload of this patch), drop the unused pmPprHsLit helper. - - - - - 2b4f463c by Simon Peyton Jones at 2026-02-02T17:32:32+00:00 Remove exprIsCheap from doFloatFromRhs See #26854 and Note [Float when expandable] This patch simplifies the code, by removing an extra unnecessary test. - - - - - 9db7f21f by Brandon Chinn at 2026-02-03T09:15:10-05:00 Refactor: make function patterns exhaustive Also added missing (==) logic for: * HsMultilineString * HsInt{8,16,32} * HsWord{8,16,32} - - - - - aa9c5e2c by Hécate Kleidukos at 2026-02-03T15:58:35-05:00 driver: Hide source paths at verbosity level 1 by default - - - - - c64cca1e by mangoiv at 2026-02-03T15:59:29-05:00 ExplicitLevelImports: check staging for types just like for values Previously, imported types were entirely exempted from staging checks as the implicit stage persistance assumed to be all imported types to be well staged. ExplicitLevelImports' change specification, however, does not do such an exemption. Thus we want to introduce such a check, just like we have for values. ExplicitLevelImports does not, however, talk about local names - from its perspective, we could theoretically keep treating locally introduced types specially - e.g. an ill-staged used in a quote would only emit a warning, not an error. To allow for a potential future migration away from such wrinkles as the staging check in notFound (see Note [Out of scope might be a staging error]) we consistently do the strict staging check that we also do for value if ExplicitLevelImports is on. Closes #26098 - - - - - 5f0dbeb6 by Simon Hengel at 2026-02-03T16:00:12-05:00 Use Haddock formatting in deprecation message of `initNameCache` - - - - - 01ecb612 by Andreas Klebinger at 2026-02-04T09:56:25-05:00 testsuite: Explicitly use utf-8 encoding in rts-includes linter. Not doing so caused failures on windows, as python failed to pick a reasonable encoding even with locale set. Fixes #26850 - - - - - ea0d1317 by Zubin Duggal at 2026-02-04T09:57:06-05:00 Bump transformers submodule to 0.6.3.0 Fixes #26790 - - - - - cbe4300e by Simon Peyton Jones at 2026-02-05T04:31:04-05:00 Fix subtle bug in GHC.Core.Utils.mkTick This patch fixes a decade-old bug in `mkTick`, which could generate type-incorrect code! See the diagnosis in #26772. The new code is simpler and easier to understand. (As #26772 says, I think it could be improved further.) - - - - - a193a8da by Simon Peyton Jones at 2026-02-05T04:31:04-05:00 Modify a debug-trace in the Simplifier ...just to show a bit more information. - - - - - b579dfdc by Simon Peyton Jones at 2026-02-05T04:31:04-05:00 Fix long-standing interaction between ticks and casts The code for Note [Eliminate Identity Cases] was simply wrong when ticks and casts interacted. This patch fixes the interaction. It was shown up when validating #26772, although it's not the exactly the bug that's reported by #26772. Nor is it easy to reproduce, hence no regression test. - - - - - fac0de1e by Cheng Shao at 2026-02-05T04:31:49-05:00 libraries: bump Cabal submodule to 3.16.1.0 - - - - - 00589122 by Cheng Shao at 2026-02-05T04:31:49-05:00 libraries: bump deepseq submodule to 1.5.2.0 Also: - Get rid of usage of deprecated `NFData` function instance in the compiler - `T21391` still relies on `NFData` function instance, add `-Wno-deprecations` for the time being. - - - - - 84474c71 by Cheng Shao at 2026-02-05T04:31:50-05:00 libraries: bump directory submodule to 1.3.10.1 - - - - - 1a9f4662 by Cheng Shao at 2026-02-05T04:31:50-05:00 libraries: bump exceptions submodule to 0.10.12 - - - - - 2e39a340 by Peng Fan at 2026-02-07T03:42:01-05:00 NCG/LA64: adjust register usage to avoid src-register being clobbered - - - - - 9faf1b35 by Teo Camarasu at 2026-02-07T03:42:43-05:00 ghc-internal: Delete unnecessary GHC.Internal.Data.Ix This module merely re-exports GHC.Internal.Ix. It was copied from `base` when `ghc-internal` was split, but there is no reason to have this now. So, let's delete it. Resolves #26848 - - - - - d112b440 by Sven Tennie at 2026-02-07T10:47:56-05:00 Add cabal.project file to generate-ci This fixes the HLS setup for our CI code generation script (generate-ci). The project file simply makes `generate-ci` of the cabal file discoverable. - - - - - 5339f6f0 by Andreas Klebinger at 2026-02-07T10:48:40-05:00 CI: Don't collapse test results. This puts test output back into the primary test log instead of a subsection removing the need to expand a section to see test results. While the intention was good in practice the old behaviour mostly wastes time by requiring expansion of the section. Fixes #26882 - - - - - 0e1cd2e0 by Evan Piro at 2026-02-08T10:35:16-08:00 Linker.MacOS reduce dynflags import - - - - - 1c79a4cd by Michael Alan Dorman at 2026-02-09T08:11:51-05:00 Remove `extra_src_files` variable from `testsuite/driver/testlib.py` While reading through the test harness code, I noticed this variable with a TODO attached that referenced #12223. Although that bug is closed, it strongly implied that this special-case variable that only affected a single test was expected to be removed at some point. I also looked at 3415bcaa0b1903b5e12dfaadb5b774718e406eab---where it was added---whose commit message suggested that it would have been desirable to remove it, but that there were special circumstances that meant it had to remain (though it doesn't elucidate what those special circumstances are). However, the special circumstances were mentioned as if the test was in a different location than is currently is, so I decided to try changing the test to use the standard `extra_files` mechanism, which works in local testing. This also seems like a reasonable time to remove the script that was originally used in the transition, since it doesn't really serve a purpose anymore. - - - - - 0020e38a by Matthew Pickering at 2026-02-09T17:29:14-05:00 determinism: Use a stable sort in WithHsDocIdentifiers binary instance `WithHsDocIdentifiers` is defined as ``` 71 data WithHsDocIdentifiers a pass = WithHsDocIdentifiers 72 { hsDocString :: !a 73 , hsDocIdentifiers :: ![Located (IdP pass)] 74 } ``` This list of names is populated from `rnHsDocIdentifiers`, which calls `lookupGRE`, which calls `lookupOccEnv_AllNameSpaces`, which calls `nonDetEltsUFM` and returns the results in an order depending on uniques. Sorting the list with a stable sort before returning the interface makes the output deterministic and follows the approach taken by other fields in `Docs`. Fixes #26858 - - - - - 89898ce6 by echoumcp1 at 2026-02-09T17:30:01-05:00 Replace putstrln with logMsg in handleSeqHValueStatus Fixes #26549 - - - - - 7c52c4f9 by John Paul Adrian Glaubitz at 2026-02-10T13:52:43-05:00 rts: Switch prim to use modern atomic compiler builtins The __sync_*() atomic compiler builtins have been deprecated in GCC for a while now and also don't provide variants for 64-bit values such as __sync_fetch_and_add_8(). Thus, replace them with the modern __atomic_*() compiler builtins and while we're at it, also drop the helper macro CAS_NAND() which is now no longer needed since we stopped using the __sync_*() compiler builtins altogether. Co-authored-by: Ilias Tsitsimpis <iliastsi(a)debian.org> Fixes #26729 - - - - - cf60850a by Recursion Ninja at 2026-02-10T13:53:27-05:00 Decoupling L.H.S.Decls from GHC.Types.ForeignCall - Adding TTG extension point for 'CCallTarget' - Adding TTG extension point for 'CType' - Adding TTG extension point for 'Header' - Moving ForeignCall types that do not need extension to new L.H.S.Decls.Foreign module - Replacing 'Bool' parameters with descriptive data-types to increase clairty and prevent "Boolean Blindness" - - - - - 11a04cbb by Eric Lee at 2026-02-11T09:20:46-05:00 Derive Semigroup/Monoid for instances believed could be derived in #25871 - - - - - 15d9ce44 by Eric Lee at 2026-02-11T09:20:46-05:00 add Ghc.Data.Pair deriving - - - - - c85dc170 by Evan Piro at 2026-02-11T09:21:45-05:00 Linker.MacOS reduce options import - - - - - a541dd83 by Chris Wendt at 2026-02-11T16:06:41-05:00 Initialize plugins for `:set +c` in GHCi Fixes #23110. - - - - - 0f5a73bc by Cheng Shao at 2026-02-11T16:07:27-05:00 compiler: add Binary Text instance This patch adds `Binary` instance for strict `Text`, in preparation of making `Text` usable in certain GHC API use cases (e.g. haddock). This also introduces `text` as a direct dependency of the `ghc` package. - - - - - 9e58b8a1 by Cheng Shao at 2026-02-11T16:08:10-05:00 ghc-toolchain: add C11 check This patch partially reverts commit b8307eab80c5809df5405d76c822bf86877f5960 that removed C99 check in autoconf/ghc-toolchain. Now we: - No longer re-implement `FP_SET_CFLAGS_C11` similar to `FP_SET_CFLAGS_C99` in the past, since autoconf doesn't provide a convenient `AC_PROG_CC_C11` function. ghc-toolchain will handle it anyway. - The Cmm CPP C99 check is relanded and repurposed for C11. - The C99 logic in ghc-toolchain is relanded and repurposed for C11. - The C99 check in Stg.h is corrected to check for C11. The obsolete _ISOC99_SOURCE trick is dropped. - Usages of `-std=gnu99` in the testsuite are corrected to use `-std=gnu11`. Closes #26908. - - - - - 4df0adf6 by Simon Peyton Jones at 2026-02-11T21:50:13-05:00 Simplify the treatment of static forms This MR implements GHC proposal 732: simplify static forms, https://github.com/ghc-proposals/ghc-proposals/pull/732 thereby addressing #26556. See `Note [Grand plan for static forms]` in GHC.Iface.Tidy.StaticPtrTable The main changes are: * There is a new, simple rule for (static e), namely that the free term variables of `e` must be bound at top level. The check is done in the `HsStatic` case of `GHC.Rename.Expr.rnExpr` * That in turn substantially simplifies the info that the typechecker carries around in its type environment. Hooray. * The desugarer emits static bindings to top level directly; see the `HsStatic` case of `dsExpr`. * There is no longer any special static-related magic in the FloatOut pass. And the main Simplifier pipeline no longer needs a special case to run FloatOut even with -O0. Hooray. All this forced an unexpected change to the pattern match checker. It recursively invokes the main Hs desugarer when it wants to take a look at a term to spot some special cases (notably constructor applications). We don't want to emit any nested (static e) bindings to top level a second time! Yikes. That forced a modest refactor in GHC.HsToCore.Pmc: * The `dsl_nablas` field of `DsLclEnv` now has a `NoPmc` case, which says "I'm desugaring just for pattern-match checking purposes". * When that flag is set we don't emit static binds. That in turn forces a cascade of refactoring, but the net effect is an improvement; less risk of duplicated (even exponential?) work. See Note [Desugaring HsExpr during pattern-match checking]. 10% metric decrease, on some architectures, of compile-time max-bytes-used on T15304. Metric Decrease: T15304 - - - - - 7922f728 by Teo Camarasu at 2026-02-11T21:50:58-05:00 ghc-internal: avoid depending on GHC.Internal.Exts This module is mostly just re-exports. It made sense as a user-facing module, but there's no good reason ghc-internal modules should depend on it and doing so linearises the module graph - move considerAccessible to GHC.Internal.Magic Previously it lived in GHC.Internal.Exts, but it really deserves to live along with the other magic function, which are already re-exported from .Exts - move maxTupleSize to GHC.Internal.Tuple This previously lived in GHC.Internal.Exts but a comment already said it should be moved to .Tuple Resolves #26832 - - - - - b6a4a29b by Eric Lee at 2026-02-11T21:51:55-05:00 Remove unused Semigroup imports to fix GHC 9.14 bootstrapping - - - - - 99d8c146 by Simon Peyton Jones at 2026-02-12T17:36:59+00:00 Fix subtle bug in cast worker/wrapper See (CWw4) in Note [Cast worker/wrapper]. The true payload is in the change to the definition of GHC.Types.Id.Info.hasInlineUnfolding Everthing else is just documentation. There is a 2% compile time decrease for T13056; I'll take the win! Metric Decrease: T13056 - - - - - 530e8e58 by Simon Peyton Jones at 2026-02-12T20:17:23-05:00 Add regression tests for four StaticPtr bugs Tickets #26545, #24464, #24773, #16981 are all solved by the recently-landed MR commit 318ee13bcffa6aa8df42ba442ccd92aa0f7e210c Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com> Date: Mon Oct 20 23:07:20 2025 +0100 Simplify the treatment of static forms This MR just adds regression tests for them. - - - - - 4157160f by Cheng Shao at 2026-02-13T06:27:04-05:00 ci: remove unused hlint-ghc-and-base job definition This patch removes the unused `hlint-ghc-and-base` job definition, it's never run since !9806. Note that hadrian lint rules still work locally, so anyone that wishes to run hlint on the codebase can continue to do so in their local worktree. - - - - - 039f1977 by Cheng Shao at 2026-02-13T06:27:47-05:00 wasm: use import.meta.main for proper distinction of nodejs main modules This patch uses `import.meta.main` for proper distinction of nodejs main modules, especially when the main module might be installed as a symlink. Fixes #26916. - - - - - eded9001 by Matthew Pickering at 2026-02-14T08:44:28+01:00 Add missing req_interp modifier to T18441fail3 and T18441fail19 These tests require the interpreter but they were failing in a different way with the javascript backend because the interpreter was disabled and stderr is ignored by the test. - - - - - 0961528a by Matthew Pickering at 2026-02-14T08:44:28+01:00 Use explicit syntax rather than pure - - - - - e85f8596 by Matthew Pickering at 2026-02-14T08:44:28+01:00 packaging: correctly propagate build/host/target to bindist configure script At the moment the host and target which we will produce a compiler for is fixed at the initial configure time. Therefore we need to persist the choice made at this time into the installation bindist as well so we look for the right tools, with the right prefixes at install time. In the future, we want to provide a bit more control about what kind of bindist we produce so the logic about what the host/target will have to be written by hadrian rather than persisted by the configure script. In particular with cross compilers we want to either build a normal stage 2 cross bindist or a stage 3 bindist, which creates a bindist which has a native compiler for the target platform. Fixes #21970 - - - - - 1ed68fcf by Matthew Pickering at 2026-02-14T08:44:28+01:00 hadrian: Fill in more of the default.host toolchain file When you are building a cross compiler this file will be used to build stage1 and it's libraries, so we need enough information here to work accurately. There is still more work to be done (see for example, word size is still fixed). - - - - - c37f06dc by Matthew Pickering at 2026-02-14T08:44:28+01:00 hadrian: Disable docs when cross compiling Before there were a variety of ad-hoc places where doc building was disabled when cross compiling. * Some CI jobs sets --docs=none in gen_ci.hs * Some CI jobs set --docs=none in .gitlab/ci.sh * There was some logic in hadrian to not need the ["docs"] target when making a bindist. Now the situation is simple: * If you are cross compiling then defaultDocsTargets is empty by default. In theory, there is no reason why we can't build documentation for cross compiler bindists, but this is left to future work to generalise the documentation building rules to allow this (#24289) - - - - - c4dcc945 by Matthew Pickering at 2026-02-14T08:44:28+01:00 hadrian: Build stage 2 cross compilers * Most of hadrian is abstracted over the stage in order to remove the assumption that the target of all stages is the same platform. This allows the RTS to be built for two different targets for example. * Abstracts the bindist creation logic to allow building either normal or cross bindists. Normal bindists use stage 1 libraries and a stage 2 compiler. Cross bindists use stage 2 libararies and a stage 2 compiler. * hadrian: Make binary-dist-dir the default build target. This allows us to have the logic in one place about which libraries/stages to build with cross compilers. Fixes #24192 New hadrian target: * `binary-dist-dir-cross`: Build a cross compiler bindist (compiler = stage 1, libraries = stage 2) This commit also contains various changes to make stage2 compilers feasible. ------------------------- Metric Decrease: ManyAlternatives MultiComponentModulesRecomp MultiLayerModulesRecomp T10421 T12425 T12707 T13035 T13379 T15703 T16577 T18698a T18698b T18923 T1969 T21839c T3294 T4801 T5030 T5321Fun T5642 T783 T9198 T9872d T9961 parsing001 T5321FD T6048 T12227 T18140 T18282 T9233 T5631 T9630 ------------------------- Co-authored-by: Sven Tennie <sven.tennie(a)gmail.com> Fix rebase: settings-use-distro-mingw is now staged - - - - - 7b47a226 by Matthew Pickering at 2026-02-14T08:44:28+01:00 ci: Test cross bindists We remove the special logic for testing in-tree cross compilers and instead test cross compiler bindists, like we do for all other platforms. - - - - - 63e5c457 by Matthew Pickering at 2026-02-14T08:44:28+01:00 ci: Introduce CROSS_STAGE variable In preparation for building and testing stage3 bindists we introduce the CROSS_STAGE variable which is used by a CI job to determine what kind of bindist the CI job should produce. At the moment we are only using CROSS_STAGE=2 but in the future we will have some jobs which set CROSS_STAGE=3 to produce native bindists for a target, but produced by a cross compiler, which can be tested on by another CI job on the native platform. CROSS_STAGE=2: Build a normal cross compiler bindist CROSS_STAGE=3: Build a stage 3 bindist, one which is a native compiler and library for the target - - - - - 6a749369 by Matthew Pickering at 2026-02-14T08:44:28+01:00 hadrian: Refactor system-cxx-std-lib rules0 I noticed a few things wrong with the hadrian rules for `system-cxx-std-lib` rules. * For `text` there is an ad-hoc check to depend on `system-cxx-std-lib` outside of `configurePackage`. * The `system-cxx-std-lib` dependency is not read from cabal files. * Recache is not called on the packge database after the `.conf` file is generated, a more natural place for this rule is `registerRules`. Treating this uniformly like other packages is complicated by it not having any source code or a cabal file. However we can do a bit better by reporting the dependency firstly in `PackageData` and then needing the `.conf` file in the same place as every other package in `configurePackage`. Fixes #25303 - - - - - 8b155ddb by Sven Tennie at 2026-02-14T08:44:28+01:00 ci: Increase timeout for emulators Test runs with emulators naturally take longer than on native machines. Generate jobs.yml - - - - - 179b678b by Sven Tennie at 2026-02-14T08:44:28+01:00 ghc: Distinguish between having an interpreter and having an internal one Otherwise, we fail with warnings when compiling tools. Actually, these are related but different things: - ghc can run an interpreter (either internal or external) - ghc is compiled with an internal interpreter - - - - - 751cd014 by Matthew Pickering at 2026-02-14T08:44:28+01:00 ci: Javascript don't set CROSS_EMULATOR There is no CROSS_EMULATOR needed to run javascript binaries, so we don't set the CROSS_EMULATOR to some dummy value. - - - - - 0ca3c382 by Sven Tennie at 2026-02-14T08:44:28+01:00 Javascript skip T23697 See #22355 about how HSC2HS and the Javascript target don't play well together. - - - - - a64f5a1d by Sven Tennie at 2026-02-14T08:44:28+01:00 Mark T24602 as fragile It was skipped before (due to CROSS_EMULATOR being set, which changed for JS), so we don't make things worse by marking it as fragile. - - - - - b2965b75 by Sven Tennie at 2026-02-14T08:44:28+01:00 Windows needs NM_STAGE0 as well The stage0 always needs nm. - - - - - 535cfbb0 by Sven Tennie at 2026-02-14T08:44:28+01:00 T17912 sometimes works for windows-validate This seems to be timing related. However, just simply increasing the timeout (sleep) statement of this test didn't help. Maybe, it has been flaky on CI before. - - - - - 9bbde165 by Sven Tennie at 2026-02-14T09:13:02+01:00 Enable stage3 bin-dists - - - - - aa7b9581 by Sven Tennie at 2026-02-14T09:13:02+01:00 Generated cross stage 3 CI jobs - - - - - bf946286 by Sven Tennie at 2026-02-14T09:13:03+01:00 Hack - - - - - af3b253e by Sven Tennie at 2026-02-14T09:13:03+01:00 WIP: Validate script - - - - - 5b973895 by Sven Tennie at 2026-02-14T09:13:03+01:00 Fix stage3 bindist creation - - - - - fe5c9c0c by Sven Tennie at 2026-02-14T09:13:03+01:00 Adjust jobs.yaml - - - - - 192585ec by Sven Tennie at 2026-02-14T19:11:11+01:00 Fix final ghc-pkg recache run Sage3 cross-compiler's ghc-pkg cannot run on the build host. Resort to a prior stage's ghc-pkg. - - - - - 443 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/cabal.project - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/CmmToAsm/LA64/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/TyCon/RecWalk.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/AddImplicitBinds.hs - compiler/GHC/Data/Maybe.hs - compiler/GHC/Data/Pair.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - + compiler/GHC/Hs/Decls/Overlap.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Foreign/Call.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Foreign/Utils.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/Linker/MacOS.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Parser/String.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Splice.hs-boot - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Foreign.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Default.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/InertSet.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types/BasicTypes.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/CtLoc.hs - compiler/GHC/Tc/Types/ErrCtxt.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - − compiler/GHC/Tc/Utils/TcMType.hs-boot - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/ForeignCall.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/InlinePragma.hs - compiler/GHC/Types/Name.hs - compiler/GHC/Types/Name/Cache.hs - compiler/GHC/Types/RepType.hs - compiler/GHC/Types/Unique/DSet.hs - compiler/GHC/Types/Var.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Types.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Monad.hs - compiler/GHC/Utils/Outputable.hs - compiler/GHC/Utils/Ppr/Colour.hs - compiler/GHC/Utils/Trace.hs - compiler/Language/Haskell/Syntax/Basic.hs - compiler/Language/Haskell/Syntax/Decls.hs - + compiler/Language/Haskell/Syntax/Decls/Foreign.hs - + compiler/Language/Haskell/Syntax/Decls/Overlap.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Lit.hs - compiler/ghc.cabal.in - configure.ac - distrib/configure.ac.in - docs/users_guide/9.16.1-notes.rst - docs/users_guide/exts/multiway_if.rst - docs/users_guide/rtd-theme/layout.html - ghc/GHC/Driver/Session/Mode.hs - ghc/GHCi/UI.hs - ghc/GHCi/UI/Info.hs - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/README.md - hadrian/bindist/config.mk.in - hadrian/cfg/default.host.target.in - + hadrian/cfg/system.config.host.in - hadrian/cfg/system.config.in - + hadrian/cfg/system.config.target.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - + hadrian/src/BindistConfig.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Expression.hs - hadrian/src/Flavour.hs - hadrian/src/Flavour/Type.hs - hadrian/src/Hadrian/Builder.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Hadrian/Haskell/Cabal/Type.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Flavour.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Oracles/TestSettings.hs - hadrian/src/Packages.hs - hadrian/src/Rules.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Compile.hs - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - + hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Library.hs - hadrian/src/Rules/Program.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/Common.hs - hadrian/src/Settings/Builders/Configure.hs - hadrian/src/Settings/Builders/DeriveConstants.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/src/Settings/Builders/SplitSections.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Flavours/Benchmark.hs - hadrian/src/Settings/Flavours/Development.hs - hadrian/src/Settings/Flavours/GhcInGhci.hs - hadrian/src/Settings/Flavours/Performance.hs - hadrian/src/Settings/Flavours/Quick.hs - hadrian/src/Settings/Flavours/QuickCross.hs - hadrian/src/Settings/Flavours/Quickest.hs - hadrian/src/Settings/Flavours/Validate.hs - hadrian/src/Settings/Packages.hs - hadrian/src/Settings/Program.hs - hadrian/src/Settings/Warnings.hs - libraries/Cabal - libraries/base/base.cabal.in - libraries/base/changelog.md - libraries/base/src/Data/Ix.hs - − libraries/base/src/GHC/Desugar.hs - + libraries/base/src/System/IO/OS.hs - libraries/base/tests/IO/all.T - + libraries/base/tests/IO/osHandles001FileDescriptors.hs - + libraries/base/tests/IO/osHandles001FileDescriptors.stdout - + libraries/base/tests/IO/osHandles001WindowsHandles.hs - + libraries/base/tests/IO/osHandles001WindowsHandles.stdout - + libraries/base/tests/IO/osHandles002FileDescriptors.hs - + libraries/base/tests/IO/osHandles002FileDescriptors.stderr - + libraries/base/tests/IO/osHandles002FileDescriptors.stdin - + libraries/base/tests/IO/osHandles002FileDescriptors.stdout - + libraries/base/tests/IO/osHandles002WindowsHandles.hs - + libraries/base/tests/IO/osHandles002WindowsHandles.stderr - + libraries/base/tests/IO/osHandles002WindowsHandles.stdin - + libraries/base/tests/IO/osHandles002WindowsHandles.stdout - libraries/base/tests/T23454.stderr - libraries/base/tests/all.T - libraries/base/tests/perf/Makefile - libraries/deepseq - libraries/directory - libraries/exceptions - libraries/ghc-internal/ghc-internal.cabal.in - libraries/ghc-internal/src/GHC/Internal/Data/Data.hs - − libraries/ghc-internal/src/GHC/Internal/Data/Ix.hs - libraries/ghc-internal/src/GHC/Internal/Err.hs - libraries/ghc-internal/src/GHC/Internal/Exts.hs - libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs - libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs - libraries/ghc-internal/src/GHC/Internal/JS/Foreign/Callback.hs - libraries/ghc-internal/src/GHC/Internal/JS/Prim.hs - libraries/ghc-internal/src/GHC/Internal/JS/Prim/Internal/Build.hs - libraries/ghc-internal/src/GHC/Internal/Magic.hs - libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs - + libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs - libraries/ghc-internal/src/GHC/Internal/Tuple.hs - libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.hs - libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs - libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs - libraries/ghc-internal/tests/stack-annotation/all.T - + libraries/ghc-internal/tests/stack-annotation/ann_frame005.hs - + libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout - libraries/text - libraries/transformers - llvm-targets - m4/fp_cmm_cpp_cmd_with_args.m4 - m4/fp_find_nm.m4 - m4/fptools_set_platform_vars.m4 - m4/prep_target_file.m4 - rts/include/Stg.h - rts/prim/atomic.c - − testsuite/driver/kill_extra_files.py - testsuite/driver/testlib.py - testsuite/ghc-config/ghc-config.hs - testsuite/mk/test.mk - testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout - testsuite/tests/codeGen/should_run/CgStaticPointers.hs - testsuite/tests/codeGen/should_run/CgStaticPointersNoFullLazyness.hs - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - + testsuite/tests/default/T25825.hs - testsuite/tests/default/all.T - testsuite/tests/deriving/should_fail/T1496.stderr - testsuite/tests/deriving/should_fail/T4846.stderr - testsuite/tests/deriving/should_fail/T5498.stderr - testsuite/tests/deriving/should_fail/T6147.stderr - testsuite/tests/deriving/should_fail/T7148.stderr - testsuite/tests/deriving/should_fail/T7148a.stderr - testsuite/tests/deriving/should_fail/T8984.stderr - testsuite/tests/deriving/should_fail/deriving-via-fail.stderr - testsuite/tests/deriving/should_fail/deriving-via-fail4.stderr - testsuite/tests/deriving/should_fail/deriving-via-fail5.stderr - testsuite/tests/driver/T16318/Makefile - testsuite/tests/driver/T18125/Makefile - testsuite/tests/driver/T20030/test1/all.T - testsuite/tests/driver/T20030/test2/all.T - testsuite/tests/driver/T20030/test3/all.T - testsuite/tests/driver/T20030/test4/all.T - testsuite/tests/driver/T20030/test5/all.T - testsuite/tests/driver/T20030/test6/all.T - testsuite/tests/driver/T8526/T8526.script - testsuite/tests/driver/bytecode-object/Makefile - testsuite/tests/driver/bytecode-object/bytecode_object19.stdout - testsuite/tests/driver/dynamicToo/dynamicToo001/Makefile - testsuite/tests/driver/fat-iface/fat014.script - testsuite/tests/driver/implicit-dyn-too/Makefile - testsuite/tests/driver/multipleHomeUnits/all.T - testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_recomp_th.stdout - testsuite/tests/ffi/should_run/all.T - testsuite/tests/gadt/CasePrune.stderr - + testsuite/tests/ghc-api/TypeMapStringLiteral.hs - testsuite/tests/ghc-api/all.T - testsuite/tests/ghc-e/should_fail/all.T - testsuite/tests/ghci.debugger/scripts/T26042b.stdout - testsuite/tests/ghci.debugger/scripts/T26042c.stdout - testsuite/tests/ghci.debugger/scripts/T26042d2.stdout - testsuite/tests/ghci.debugger/scripts/T26042f2.stdout - testsuite/tests/ghci.debugger/scripts/T8487.stdout - testsuite/tests/ghci.debugger/scripts/break011.stdout - testsuite/tests/ghci.debugger/scripts/break017.stdout - testsuite/tests/ghci.debugger/scripts/break025.stdout - − testsuite/tests/ghci/linking/T11531.stderr - testsuite/tests/ghci/prog018/prog018.script - testsuite/tests/ghci/scripts/T13869.script - testsuite/tests/ghci/scripts/T13997.script - testsuite/tests/ghci/scripts/T17669.script - testsuite/tests/ghci/scripts/T18330.script - testsuite/tests/ghci/scripts/T18330.stdout - testsuite/tests/ghci/scripts/T1914.script - testsuite/tests/ghci/scripts/T20150.stdout - testsuite/tests/ghci/scripts/T20217.script - testsuite/tests/ghci/scripts/T6105.script - testsuite/tests/ghci/scripts/T8042.script - testsuite/tests/ghci/scripts/T8042recomp.script - testsuite/tests/ghci/should_run/Makefile - testsuite/tests/indexed-types/should_fail/T9580.stderr - 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 - testsuite/tests/javascript/closure/all.T - testsuite/tests/linear/should_fail/LinearRole.stderr - testsuite/tests/linters/regex-linters/check-rts-includes.py - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/T14189.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr - + testsuite/tests/parser/should_fail/T26860ppr.hs - + testsuite/tests/parser/should_fail/T26860ppr.stderr - testsuite/tests/parser/should_fail/all.T - + testsuite/tests/plugins/T23110.hs - + testsuite/tests/plugins/T23110.script - + testsuite/tests/plugins/T23110.stdout - testsuite/tests/plugins/all.T - testsuite/tests/process/all.T - testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr - testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr - + testsuite/tests/rename/should_fail/T26545.hs - + testsuite/tests/rename/should_fail/T26545.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/roles/should_fail/RolesIArray.stderr - testsuite/tests/rts/T13676.script - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/HaddockSpanIssueT24378.stdout - testsuite/tests/showIface/MagicHashInHaddocks.stdout - testsuite/tests/simplCore/should_compile/T21391.hs - + testsuite/tests/simplCore/should_compile/T26805.hs - + testsuite/tests/simplCore/should_compile/T26805.stderr - + testsuite/tests/simplCore/should_compile/T26826.hs - + testsuite/tests/simplCore/should_compile/T26903.hs - + testsuite/tests/simplCore/should_compile/T26903.stderr - testsuite/tests/simplCore/should_compile/T8331.stderr - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/th/T26098A_quote.hs - + testsuite/tests/th/T26098A_splice.hs - + testsuite/tests/th/T26098_local.hs - + testsuite/tests/th/T26098_local.stderr - + testsuite/tests/th/T26098_quote.hs - + testsuite/tests/th/T26098_quote.stderr - + testsuite/tests/th/T26098_splice.hs - + testsuite/tests/th/T26098_splice.stderr - testsuite/tests/th/all.T - + testsuite/tests/typecheck/should_compile/T24464.hs - + testsuite/tests/typecheck/should_compile/T26805a.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T10285.stderr - testsuite/tests/typecheck/should_fail/T10534.stderr - testsuite/tests/typecheck/should_fail/T10715b.stderr - testsuite/tests/typecheck/should_fail/T11347.stderr - testsuite/tests/typecheck/should_fail/T15801.stderr - + testsuite/tests/typecheck/should_fail/T15850.hs - + testsuite/tests/typecheck/should_fail/T15850.stderr - + testsuite/tests/typecheck/should_fail/T15850_Lib.hs - + testsuite/tests/typecheck/should_fail/T20289.hs - + testsuite/tests/typecheck/should_fail/T20289.stderr - + testsuite/tests/typecheck/should_fail/T20289_A.hs - testsuite/tests/typecheck/should_fail/T22645.stderr - testsuite/tests/typecheck/should_fail/T22924a.stderr - + testsuite/tests/typecheck/should_fail/T23731.hs - + testsuite/tests/typecheck/should_fail/T23731.stderr - + testsuite/tests/typecheck/should_fail/T23731b.hs - + testsuite/tests/typecheck/should_fail/T23731b.stderr - + testsuite/tests/typecheck/should_fail/T23731b_aux.hs - + testsuite/tests/typecheck/should_fail/T25679.hs - + testsuite/tests/typecheck/should_fail/T25679.stderr - + testsuite/tests/typecheck/should_fail/T25949.hs - + testsuite/tests/typecheck/should_fail/T25949.stderr - + testsuite/tests/typecheck/should_fail/T25949_aux.hs - + testsuite/tests/typecheck/should_fail/T26137.hs - + testsuite/tests/typecheck/should_fail/T26137.stderr - testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr - testsuite/tests/typecheck/should_fail/TcCoercibleFail3.stderr - testsuite/tests/typecheck/should_fail/all.T - + testsuite/tests/typecheck/should_run/T16981.hs - + testsuite/tests/typecheck/should_run/T16981.stdout - + testsuite/tests/typecheck/should_run/T24773.hs - + testsuite/tests/typecheck/should_run/T24773.stdout - testsuite/tests/typecheck/should_run/all.T - testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr - utils/check-exact/ExactPrint.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/Interface/LexParseRn.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs - utils/jsffi/dyld.mjs - utils/jsffi/post-link.mjs - + validate-riscv-bindist.sh The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/77ec95ae9e7e73313b4717ed2f0c44… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/77ec95ae9e7e73313b4717ed2f0c44… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/fendor/stack-annotation-ty] 2 commits: Add optional `SrcLoc` to `StackAnnotation` class
by Hannes Siebenhandl (＠fendor) 14 Feb '26

14 Feb '26

Hannes Siebenhandl pushed to branch wip/fendor/stack-annotation-ty at Glasgow Haskell Compiler / GHC Commits: c32beb60 by fendor at 2026-02-14T10:05:37+01:00 Add optional `SrcLoc` to `StackAnnotation` class `StackAnnotation` give access to an optional `SrcLoc` field that stack annotations can use to provide better backtraces in both error messages and when decoding the callstack. We update builtin stack annotations such as `StringAnnotation` and `ShowAnnotation` to also capture the `SrcLoc` of the current `CallStack` to improve backtraces by default (if stack annotations are used). This change is backwards compatible with GHC 9.14.1. - - - - - 13c2f349 by fendor at 2026-02-14T10:05:37+01:00 Allow inlining of annotateStackIO - - - - - 19 changed files: - libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs - + libraries/ghc-experimental/tests/Makefile - + libraries/ghc-experimental/tests/all.T - + libraries/ghc-experimental/tests/backtraces/Makefile - + libraries/ghc-experimental/tests/backtraces/T26806a.hs - + libraries/ghc-experimental/tests/backtraces/T26806a.stderr - + libraries/ghc-experimental/tests/backtraces/T26806b.hs - + libraries/ghc-experimental/tests/backtraces/T26806b.stderr - + libraries/ghc-experimental/tests/backtraces/T26806c.hs - + libraries/ghc-experimental/tests/backtraces/T26806c.stderr - + libraries/ghc-experimental/tests/backtraces/all.T - libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs - libraries/ghc-internal/tests/stack-annotation/ann_frame001.stdout - libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout - libraries/ghc-internal/tests/stack-annotation/ann_frame003.stdout - libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout - libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout - testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 Changes: ===================================== libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs ===================================== @@ -82,9 +82,6 @@ import GHC.Internal.Stack.Annotation -- the pure variations can behave in ways that are hard to predict. -- -- See Note [Stack annotations in pure code] for more details. --- --- At last, stack annotations are tricky to use with 'error'. --- See Note [Pushing annotation frames on 'error'] for why this is the case. -- Note [Stack annotations in pure code] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -96,57 +93,50 @@ import GHC.Internal.Stack.Annotation -- For example: -- -- @ --- annotateStackShow (5 @Int) (fib 20 + throw (ErrorCall "Oh no!")) +-- annotateStackShow (5 @Int) (fib 20 + error "Oh no!") -- @ -- --- Without forcing the result of @(fib 20 + throw (ErrorCall "Oh no!"))@, the computation +-- Without forcing the result of @(fib 20 + error "Oh no!")@, the computation -- will simply return a thunk, and the stack annotation would be popped off the stack. -- Once the thunk is evaluated, the exception is raised, but no stack annotation will be found! --- If we force the result of @(fib 20 + throw (ErrorCall "Oh no!"))@, then the stack +-- If we force the result of @(fib 20 + error "Oh no!")@, then the stack -- annotations remain on the stack, and are displayed in the stack trace. -- -- Naturally, this only holds if no imprecise exceptions are thrown during evaluation of any -- nested value, for example in 'annotateStackShow 5 (Just $ throw (ErrorCall "Oh no!"))', the -- stack trace will not include the value @5@. -- --- See how we preferred @throw (ErrorCall ...)@ over @error@? --- See Note [Pushing annotation frames on 'error'] for why we do this. - --- Note [Pushing annotation frames on 'error'] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Examples so far have not been using 'error' at all. --- The reason is that 'error' is extraordinarily difficult to use correctly with stack annotation frames. --- See Note [Capturing the backtrace in throw] for a detailed discussion of how 'throw' --- manages to capture 'Backtraces'. --- --- Long story short, 'error' does not do the same thing as 'throw' and is subtly different --- in terms of evaluation, cause it to bypass the stack annotation frames, especially in --- pure code. --- --- However, even in 'IO' code, it is difficult to use 'error' and obtain stack annotation frames --- close to the call site due to the same issue of laziness and backtrace collection. --- --- This means, right now, if you want to reliably capture stack frame annotations, --- in both pure and impure code, prefer 'throw' and 'throwIO' variants over 'error'. -- ---------------------------------------------------------------------------- -- Annotations -- ---------------------------------------------------------------------------- + +-- | A 'String' only annotation with an optional source location. data StringAnnotation where - StringAnnotation :: String -> StringAnnotation + StringAnnotation :: !(Maybe SrcLoc) -> String -> StringAnnotation instance StackAnnotation StringAnnotation where - displayStackAnnotation (StringAnnotation str) = str + displayStackAnnotationShort (StringAnnotation _srcLoc str) = + str + + stackAnnotationSourceLocation (StringAnnotation srcLoc _str) = + srcLoc -- | Use the 'Show' instance of a type to display as the 'StackAnnotation'. data ShowAnnotation where - ShowAnnotation :: forall a . Show a => a -> ShowAnnotation + ShowAnnotation :: forall a . Show a => !(Maybe SrcLoc) -> a -> ShowAnnotation instance StackAnnotation ShowAnnotation where - displayStackAnnotation (ShowAnnotation showAnno) = show showAnno + displayStackAnnotationShort (ShowAnnotation _srcLoc showAnno) = + show showAnno + + stackAnnotationSourceLocation (ShowAnnotation srcLoc _showAnno) = + srcLoc -- | A 'CallStack' stack annotation. +-- +-- Captures the whole 'CallStack'. newtype CallStackAnnotation = CallStackAnnotation CallStack instance Show CallStackAnnotation where @@ -154,9 +144,23 @@ instance Show CallStackAnnotation where -- | Displays the first entry of the 'CallStack' instance StackAnnotation CallStackAnnotation where - displayStackAnnotation (CallStackAnnotation cs) = case getCallStack cs of + stackAnnotationSourceLocation (CallStackAnnotation cs) = + callStackHeadSrcLoc cs + + displayStackAnnotationShort (CallStackAnnotation cs) = + callStackHeadFunctionName cs + +callStackHeadSrcLoc :: CallStack -> Maybe SrcLoc +callStackHeadSrcLoc cs = + case getCallStack cs of + [] -> Nothing + (_, srcLoc):_ -> Just srcLoc + +callStackHeadFunctionName :: CallStack -> String +callStackHeadFunctionName cs = + case getCallStack cs of [] -> "<unknown source location>" - ((fnName,srcLoc):_) -> fnName ++ ", called at " ++ prettySrcLoc srcLoc + (fnName, _):_ -> fnName -- ---------------------------------------------------------------------------- -- Annotate the CallStack with custom data @@ -172,7 +176,7 @@ instance StackAnnotation CallStackAnnotation where -- -- WARNING: forces the evaluation of @b@ to WHNF. {-# NOINLINE annotateStack #-} -annotateStack :: forall a b. (Typeable a, StackAnnotation a) => a -> b -> b +annotateStack :: forall a b. (HasCallStack, Typeable a, StackAnnotation a) => a -> b -> b annotateStack ann b = unsafePerformIO $ annotateStackIO ann (evaluate b) @@ -196,9 +200,9 @@ annotateCallStack b = unsafePerformIO $ withFrozenCallStack $ -- information to stack traces. -- -- WARNING: forces the evaluation of @b@ to WHNF. -annotateStackString :: forall b . String -> b -> b +annotateStackString :: forall b . HasCallStack => String -> b -> b annotateStackString ann = - annotateStack (StringAnnotation ann) + annotateStack (StringAnnotation (callStackHeadSrcLoc ?callStack) ann) -- | @'annotateStackShow' showable b@ annotates the evaluation stack of @b@ -- with the value @showable@. @@ -207,37 +211,36 @@ annotateStackString ann = -- information to stack traces. -- -- WARNING: forces the evaluation of @b@ to WHNF. -annotateStackShow :: forall a b . (Typeable a, Show a) => a -> b -> b +annotateStackShow :: forall a b . (HasCallStack, Typeable a, Show a) => a -> b -> b annotateStackShow ann = - annotateStack (ShowAnnotation ann) + annotateStack (ShowAnnotation (callStackHeadSrcLoc ?callStack) ann) -- | @'annotateStackIO' showable b@ annotates the evaluation stack of @b@ -- with the value @showable@. -- -- When decoding the call stack, the annotation frames can be used to add more -- information to stack traces. -annotateStackIO :: forall a b . (Typeable a, StackAnnotation a) => a -> IO b -> IO b +annotateStackIO :: forall a b . (HasCallStack, Typeable a, StackAnnotation a) => a -> IO b -> IO b annotateStackIO ann (IO act) = IO $ \s -> annotateStack# (SomeStackAnnotation ann) act s -{-# NOINLINE annotateStackIO #-} -- | @'annotateStackStringIO' msg b@ annotates the evaluation stack of @b@ -- with the value @msg@. -- -- When decoding the call stack, the annotation frames can be used to add more -- information to stack traces. -annotateStackStringIO :: forall b . String -> IO b -> IO b +annotateStackStringIO :: forall b . HasCallStack => String -> IO b -> IO b annotateStackStringIO ann = - annotateStackIO (StringAnnotation ann) + annotateStackIO (StringAnnotation (callStackHeadSrcLoc ?callStack) ann) -- | @'annotateStackShowIO' msg b@ annotates the evaluation stack of @b@ -- with the value @msg@. -- -- When decoding the call stack, the annotation frames can be used to add more -- information to stack traces. -annotateStackShowIO :: forall a b . (Show a) => a -> IO b -> IO b +annotateStackShowIO :: forall a b . (HasCallStack, Show a) => a -> IO b -> IO b annotateStackShowIO ann = - annotateStackIO (ShowAnnotation ann) + annotateStackIO (ShowAnnotation (callStackHeadSrcLoc ?callStack) ann) -- | @'annotateCallStackIO' b@ annotates the evaluation stack of @b@ with the -- current 'callstack'. ===================================== libraries/ghc-experimental/tests/Makefile ===================================== @@ -0,0 +1,7 @@ +# This Makefile runs the tests using GHC's testsuite framework. It +# assumes the package is part of a GHC build tree with the testsuite +# installed in ../../../testsuite. + +TOP=../../../testsuite +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk ===================================== libraries/ghc-experimental/tests/all.T ===================================== ===================================== libraries/ghc-experimental/tests/backtraces/Makefile ===================================== @@ -0,0 +1,7 @@ +# This Makefile runs the tests using GHC's testsuite framework. It +# assumes the package is part of a GHC build tree with the testsuite +# installed in ../../../testsuite. + +TOP=../../../../testsuite +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk ===================================== libraries/ghc-experimental/tests/backtraces/T26806a.hs ===================================== @@ -0,0 +1,14 @@ +module Main where + +import GHC.Stack.Annotation.Experimental +import Control.Exception +import Control.Exception.Backtrace + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + annotateCallStackIO $ do + annotateStackShowIO ([1..4] :: [Int]) $ do + annotateStackStringIO "Lovely annotation" $ do + throwIO $ ErrorCall "Backtrace Test" + ===================================== libraries/ghc-experimental/tests/backtraces/T26806a.stderr ===================================== @@ -0,0 +1,11 @@ +T26806a: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: + +Backtrace Test + +IPE backtrace: + Lovely annotation, called at T26806a.hs:12:7 in main:Main + [1,2,3,4], called at T26806a.hs:11:5 in main:Main + annotateCallStackIO, called at T26806a.hs:10:3 in main:Main +HasCallStack backtrace: + throwIO, called at T26806a.hs:13:9 in main:Main + ===================================== libraries/ghc-experimental/tests/backtraces/T26806b.hs ===================================== @@ -0,0 +1,18 @@ +module Main where + +import GHC.Stack.Annotation.Experimental +import Control.Exception +import Control.Exception.Backtrace + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + print $ foo 500 + +foo :: Int -> Int +foo n = + annotateCallStack $ + annotateStackShow ([1..4] :: [Int]) $ + annotateStackString "Lovely annotation" $ + throw $ ErrorCall $ "Backtrace Test: " ++ show (n * n * n) + ===================================== libraries/ghc-experimental/tests/backtraces/T26806b.stderr ===================================== @@ -0,0 +1,13 @@ +T26806b: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: + +Backtrace Test: 125000000 + +IPE backtrace: + Lovely annotation, called at T26806b.hs:16:7 in main:Main + [1,2,3,4], called at T26806b.hs:15:5 in main:Main + annotateCallStack, called at T26806b.hs:14:3 in main:Main +HasCallStack backtrace: + collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:170:37 in ghc-internal:GHC.Internal.Exception + toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:90:42 in ghc-internal:GHC.Internal.Exception + throw, called at T26806b.hs:17:9 in main:Main + ===================================== libraries/ghc-experimental/tests/backtraces/T26806c.hs ===================================== @@ -0,0 +1,18 @@ +module Main where + +import GHC.Stack.Annotation.Experimental +import Control.Exception +import Control.Exception.Backtrace + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + print $ foo 500 + +foo :: Int -> Int +foo n = + annotateCallStack $ + annotateStackShow ([1..4] :: [Int]) $ + annotateStackString "Lovely annotation" $ + error $ "Backtrace Test: " ++ show (n * n * n) + ===================================== libraries/ghc-experimental/tests/backtraces/T26806c.stderr ===================================== @@ -0,0 +1,11 @@ +T26806c: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall: + +Backtrace Test: 125000000 + +IPE backtrace: + Lovely annotation, called at T26806c.hs:16:7 in main:Main + [1,2,3,4], called at T26806c.hs:15:5 in main:Main + annotateCallStack, called at T26806c.hs:14:3 in main:Main +HasCallStack backtrace: + error, called at T26806c.hs:17:9 in main:Main + ===================================== libraries/ghc-experimental/tests/backtraces/all.T ===================================== @@ -0,0 +1,5 @@ +stack_annotation_backtrace_opts = [ when(have_profiling(), extra_ways(['prof'])) , when(js_arch(), skip) , exit_code(1) ] + +test('T26806a', stack_annotation_backtrace_opts, compile_and_run, ['']) +test('T26806b', stack_annotation_backtrace_opts, compile_and_run, ['']) +test('T26806c', stack_annotation_backtrace_opts, compile_and_run, ['']) ===================================== libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs ===================================== @@ -4,6 +4,7 @@ module GHC.Internal.Stack.Annotation where import GHC.Internal.Base import GHC.Internal.Data.Typeable +import GHC.Internal.Stack (SrcLoc, prettySrcLoc) -- ---------------------------------------------------------------------------- -- StackAnnotation @@ -13,8 +14,38 @@ import GHC.Internal.Data.Typeable -- as the payload of 'AnnFrame' stack frames. -- class StackAnnotation a where + -- | Display a human readable string for the 'StackAnnotation'. + -- + -- This is supposed to be the long version of 'displayStackAnnotationShort' + -- and may contain a source location. + -- + -- If not provided, 'displayStackAnnotation' is derived from 'stackAnnotationSourceLocation' + -- and 'displayStackAnnotationShort'. displayStackAnnotation :: a -> String + -- | Get the 'SrcLoc' of the given 'StackAnnotation'. + -- + -- This is optional, 'SrcLoc' are not strictly required for 'StackAnnotation', but + -- it is still heavily encouarged to provide a 'SrcLoc' for better IPE backtraces. + stackAnnotationSourceLocation :: a -> Maybe SrcLoc + + -- | The description of the StackAnnotation without any metadata such as source locations. + -- + -- Pefer implementing 'displayStackAnnotationShort' over 'displayStackAnnotation'. + displayStackAnnotationShort :: a -> String + + {-# MINIMAL displayStackAnnotation | displayStackAnnotationShort #-} + + displayStackAnnotation ann = + displayStackAnnotationShort ann + ++ case stackAnnotationSourceLocation ann of + Nothing -> "" + Just srcLoc -> ", called at " ++ prettySrcLoc srcLoc + + stackAnnotationSourceLocation _ann = Nothing + + displayStackAnnotationShort = displayStackAnnotation + -- ---------------------------------------------------------------------------- -- Annotations -- ---------------------------------------------------------------------------- @@ -28,4 +59,11 @@ data SomeStackAnnotation where SomeStackAnnotation :: forall a. (Typeable a, StackAnnotation a) => a -> SomeStackAnnotation instance StackAnnotation SomeStackAnnotation where - displayStackAnnotation (SomeStackAnnotation a) = displayStackAnnotation a + displayStackAnnotation (SomeStackAnnotation a) = + displayStackAnnotation a + + stackAnnotationSourceLocation (SomeStackAnnotation a) = + stackAnnotationSourceLocation a + + displayStackAnnotationShort (SomeStackAnnotation a) = + displayStackAnnotationShort a ===================================== libraries/ghc-internal/tests/stack-annotation/ann_frame001.stdout ===================================== @@ -1,12 +1,12 @@ Stack annotations: -- (2,3) +- (2,3), called at ann_frame001.hs:5:13 in main:Main 47 Stack annotations: -- "bar" -- "foo" -- "tailCallEx" +- "bar", called at ann_frame001.hs:23:9 in main:Main +- "foo", called at ann_frame001.hs:21:11 in main:Main +- "tailCallEx", called at ann_frame001.hs:17:18 in main:Main Stack annotations: -- "bar" -- "foo" -- "tailCallEx" +- "bar", called at ann_frame001.hs:23:9 in main:Main +- "foo", called at ann_frame001.hs:21:11 in main:Main +- "tailCallEx", called at ann_frame001.hs:17:18 in main:Main 40 ===================================== libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout ===================================== @@ -7,5 +7,5 @@ Finish some work Some more work in bar 17711 Stack annotations: -- bar +- bar, called at ann_frame002.hs:23:29 in main:Main - annotateCallStackIO, called at ann_frame002.hs:23:7 in main:Main ===================================== libraries/ghc-internal/tests/stack-annotation/ann_frame003.stdout ===================================== @@ -1,6 +1,6 @@ 47 Stack annotations: -- "bar" -- "foo" -- "tailCallEx" +- "bar", called at ann_frame003.hs:25:9 in main:Main +- "foo", called at ann_frame003.hs:21:11 in main:Main +- "tailCallEx", called at ann_frame003.hs:16:18 in main:Main 40 ===================================== libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout ===================================== @@ -13,5 +13,5 @@ Stack annotations: - annotateCallStack, called at ann_frame004.hs:21:17 in main:Main - annotateCallStack, called at ann_frame004.hs:21:17 in main:Main - annotateCallStack, called at ann_frame004.hs:13:10 in main:Main -- bar +- bar, called at ann_frame004.hs:12:29 in main:Main - annotateCallStackIO, called at ann_frame004.hs:12:7 in main:Main ===================================== libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout ===================================== @@ -2,9 +2,9 @@ Caught exception: SimpleBoom Exception context: - IPE backtrace: -- throwIO SimpleBoom -- raising action -- catch site for throwIO SimpleBoom +- throwIO SimpleBoom, called at ann_frame005.hs:33:5 in main:Main +- raising action, called at ann_frame005.hs:32:3 in main:Main +- catch site for throwIO SimpleBoom, called at ann_frame005.hs:27:5 in main:Main - annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main - HasCallStack backtrace: - throwIO, called at ann_frame005.hs:34:7 in main:Main @@ -13,9 +13,9 @@ Handler annotation not present in context Caught exception: Prelude.undefined Exception context: - IPE backtrace: -- undefined thunk -- raising undefined action -- catch site for undefined +- undefined thunk, called at ann_frame005.hs:41:9 in main:Main +- raising undefined action, called at ann_frame005.hs:38:3 in main:Main +- catch site for undefined, called at ann_frame005.hs:27:5 in main:Main - annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main - HasCallStack backtrace: - undefined, called at ann_frame005.hs:41:48 in main:Main @@ -24,9 +24,9 @@ Handler annotation not present in context Caught exception: error from annotateStackString Exception context: - IPE backtrace: -- error thunk -- raising error action -- catch site for error +- error thunk, called at ann_frame005.hs:48:9 in main:Main +- raising error action, called at ann_frame005.hs:45:3 in main:Main +- catch site for error, called at ann_frame005.hs:27:5 in main:Main - annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main - HasCallStack backtrace: - error, called at ann_frame005.hs:48:44 in main:Main @@ -35,8 +35,8 @@ Handler annotation not present in context Caught exception: SimpleBoom Exception context: - IPE backtrace: -- raising throwSTM action -- catch site for throwSTM +- raising throwSTM action, called at ann_frame005.hs:52:3 in main:Main +- catch site for throwSTM, called at ann_frame005.hs:27:5 in main:Main - annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main - HasCallStack backtrace: - collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:170:37 in ghc-internal:GHC.Internal.Exception ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout ===================================== @@ -6499,25 +6499,27 @@ module GHC.Stack.Annotation.Experimental where newtype CallStackAnnotation = CallStackAnnotation GHC.Internal.Stack.Types.CallStack type ShowAnnotation :: * data ShowAnnotation where - ShowAnnotation :: forall a. GHC.Internal.Show.Show a => a -> ShowAnnotation + ShowAnnotation :: forall a. GHC.Internal.Show.Show a => !(GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc) -> a -> ShowAnnotation type SomeStackAnnotation :: * data SomeStackAnnotation where SomeStackAnnotation :: forall a. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> SomeStackAnnotation type StackAnnotation :: * -> Constraint class StackAnnotation a where displayStackAnnotation :: a -> GHC.Internal.Base.String - {-# MINIMAL displayStackAnnotation #-} + stackAnnotationSourceLocation :: a -> GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc + displayStackAnnotationShort :: a -> GHC.Internal.Base.String + {-# MINIMAL displayStackAnnotation | displayStackAnnotationShort #-} type StringAnnotation :: * data StringAnnotation where - StringAnnotation :: GHC.Internal.Base.String -> StringAnnotation + StringAnnotation :: !(GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc) -> GHC.Internal.Base.String -> StringAnnotation annotateCallStack :: forall b. GHC.Internal.Stack.Types.HasCallStack => b -> b annotateCallStackIO :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO a -> GHC.Internal.Types.IO a - annotateStack :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> b -> b - annotateStackIO :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b - annotateStackShow :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Show.Show a) => a -> b -> b - annotateStackShowIO :: forall a b. GHC.Internal.Show.Show a => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b - annotateStackString :: forall b. GHC.Internal.Base.String -> b -> b - annotateStackStringIO :: forall b. GHC.Internal.Base.String -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b + annotateStack :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> b -> b + annotateStackIO :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b + annotateStackShow :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Show.Show a) => a -> b -> b + annotateStackShowIO :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Show.Show a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b + annotateStackString :: forall b. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> b -> b + annotateStackStringIO :: forall b. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b module GHC.Stats.Experimental where -- Safety: Safe ===================================== testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32 ===================================== @@ -6502,25 +6502,27 @@ module GHC.Stack.Annotation.Experimental where newtype CallStackAnnotation = CallStackAnnotation GHC.Internal.Stack.Types.CallStack type ShowAnnotation :: * data ShowAnnotation where - ShowAnnotation :: forall a. GHC.Internal.Show.Show a => a -> ShowAnnotation + ShowAnnotation :: forall a. GHC.Internal.Show.Show a => !(GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc) -> a -> ShowAnnotation type SomeStackAnnotation :: * data SomeStackAnnotation where SomeStackAnnotation :: forall a. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> SomeStackAnnotation type StackAnnotation :: * -> Constraint class StackAnnotation a where displayStackAnnotation :: a -> GHC.Internal.Base.String - {-# MINIMAL displayStackAnnotation #-} + stackAnnotationSourceLocation :: a -> GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc + displayStackAnnotationShort :: a -> GHC.Internal.Base.String + {-# MINIMAL displayStackAnnotation | displayStackAnnotationShort #-} type StringAnnotation :: * data StringAnnotation where - StringAnnotation :: GHC.Internal.Base.String -> StringAnnotation + StringAnnotation :: !(GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.SrcLoc) -> GHC.Internal.Base.String -> StringAnnotation annotateCallStack :: forall b. GHC.Internal.Stack.Types.HasCallStack => b -> b annotateCallStackIO :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO a -> GHC.Internal.Types.IO a - annotateStack :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> b -> b - annotateStackIO :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b - annotateStackShow :: forall a b. (ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Show.Show a) => a -> b -> b - annotateStackShowIO :: forall a b. GHC.Internal.Show.Show a => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b - annotateStackString :: forall b. GHC.Internal.Base.String -> b -> b - annotateStackStringIO :: forall b. GHC.Internal.Base.String -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b + annotateStack :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> b -> b + annotateStackIO :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, StackAnnotation a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b + annotateStackShow :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a, GHC.Internal.Show.Show a) => a -> b -> b + annotateStackShowIO :: forall a b. (GHC.Internal.Stack.Types.HasCallStack, GHC.Internal.Show.Show a) => a -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b + annotateStackString :: forall b. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> b -> b + annotateStackStringIO :: forall b. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> GHC.Internal.Types.IO b -> GHC.Internal.Types.IO b module GHC.Stats.Experimental where -- Safety: Safe View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d35798664a9e84b65bdb1e04431768… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d35798664a9e84b65bdb1e04431768… You're receiving this email because of your account on gitlab.haskell.org.

1 0