- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/romes/step-out-9] ghci: Allocate BreakArrays at link time only
by Rodrigo Mesquita (＠alt-romes) 03 Jul '25

03 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/step-out-9 at Glasgow Haskell Compiler / GHC Commits: 52490055 by Rodrigo Mesquita at 2025-07-03T16:18:11+01:00 ghci: Allocate BreakArrays at link time only Previously, a BreakArray would be allocated with a slot for every tick in a module at `mkModBreaks`, in HsToCore. However, this approach has a few downsides: - It interleaves interpreter behaviour (allocating arrays for breakpoints) within the desugarer - It is inflexible in the sense it is impossible for the bytecode generator to add "internal" breakpoints that can be triggered at runtime, because those wouldn't have a source tick. (This is relevant for our intended implementation plan of step-out in #26042) - It ties the BreakArray indices to the *tick* indexes, while at runtime we would rather just have the *info* indexes (currently we have both because BreakArrays are indexed by the *tick* one). Paving the way for #26042 and #26064, this commit moves the allocation of BreakArrays to bytecode-loading time -- akin to what is done for CCS arrays. Since a BreakArray is allocated only when bytecode is linked, if a breakpoint is set (e.g. `:break 10`) before the bytecode is linked, there will exist no BreakArray to trigger the breakpoint in. Therefore, the function to allocate break arrays (`allocateBreakArrays`) is exposed and also used in GHC.Runtime.Eval to allocate a break array when a breakpoint is set, if it doesn't exist yet (in the linker env). - - - - - 10 changed files: - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Eval.hs - − compiler/GHC/Runtime/Interpreter.hs-boot - − compiler/GHC/Runtime/Interpreter/Types.hs-boot - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -58,15 +58,16 @@ linkBCO :: Interp -> PkgsLoaded -> LinkerEnv + -> LinkedBreaks -> NameEnv Int -> UnlinkedBCO -> IO ResolvedBCO -linkBCO interp pkgs_loaded le bco_ix +linkBCO interp pkgs_loaded le lb bco_ix (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do -- fromIntegral Word -> Word64 should be a no op if Word is Word64 -- otherwise it will result in a cast to longlong on 32bit systems. - (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le) (elemsFlatBag lits0) - ptrs <- mapM (resolvePtr interp pkgs_loaded le bco_ix) (elemsFlatBag ptrs0) + (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le lb) (elemsFlatBag lits0) + ptrs <- mapM (resolvePtr interp pkgs_loaded le lb bco_ix) (elemsFlatBag ptrs0) let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits return $ ResolvedBCO { resolvedBCOIsLE = isLittleEndian , resolvedBCOArity = arity @@ -76,8 +77,8 @@ linkBCO interp pkgs_loaded le bco_ix , resolvedBCOPtrs = addListToSS emptySS ptrs } -lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> BCONPtr -> IO Word -lookupLiteral interp pkgs_loaded le ptr = case ptr of +lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> LinkedBreaks -> BCONPtr -> IO Word +lookupLiteral interp pkgs_loaded le lb ptr = case ptr of BCONPtrWord lit -> return lit BCONPtrLbl sym -> do Ptr a# <- lookupStaticPtr interp sym @@ -99,7 +100,7 @@ lookupLiteral interp pkgs_loaded le ptr = case ptr of pure $ fromIntegral p BCONPtrCostCentre BreakpointId{..} | interpreterProfiled interp -> do - case expectJust (lookupModuleEnv (ccs_env le) bi_tick_mod) ! bi_tick_index of + case expectJust (lookupModuleEnv (ccs_env lb) bi_tick_mod) ! bi_tick_index of RemotePtr p -> pure $ fromIntegral p | otherwise -> case toRemotePtr nullPtr of @@ -158,10 +159,11 @@ resolvePtr :: Interp -> PkgsLoaded -> LinkerEnv + -> LinkedBreaks -> NameEnv Int -> BCOPtr -> IO ResolvedBCOPtr -resolvePtr interp pkgs_loaded le bco_ix ptr = case ptr of +resolvePtr interp pkgs_loaded le lb bco_ix ptr = case ptr of BCOPtrName nm | Just ix <- lookupNameEnv bco_ix nm -> return (ResolvedBCORef ix) -- ref to another BCO in this group @@ -182,10 +184,10 @@ resolvePtr interp pkgs_loaded le bco_ix ptr = case ptr of -> ResolvedBCOStaticPtr <$> lookupPrimOp interp pkgs_loaded op BCOPtrBCO bco - -> ResolvedBCOPtrBCO <$> linkBCO interp pkgs_loaded le bco_ix bco + -> ResolvedBCOPtrBCO <$> linkBCO interp pkgs_loaded le lb bco_ix bco BCOPtrBreakArray tick_mod -> - withForeignRef (expectJust (lookupModuleEnv (breakarray_env le) tick_mod)) $ + withForeignRef (expectJust (lookupModuleEnv (breakarray_env lb) tick_mod)) $ \ba -> pure $ ResolvedBCOPtrBreakArray ba -- | Look up the address of a Haskell symbol in the currently ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -97,8 +97,8 @@ import GHC.Unit.Module.Deps import Data.List (partition) import Data.IORef -import Data.Traversable (for) import GHC.Iface.Make (mkRecompUsageInfo) +import GHC.Runtime.Interpreter (interpreterProfiled) {- ************************************************************************ @@ -162,13 +162,12 @@ deSugar hsc_env mod mod_loc export_set (typeEnvTyCons type_env) binds else return (binds, Nothing) - ; modBreaks <- for - [ (i, s) - | i <- hsc_interp hsc_env - , (_, s) <- m_tickInfo - , breakpointsAllowed dflags - ] - $ \(interp, specs) -> mkModBreaks interp mod specs + ; let modBreaks + | Just (_, specs) <- m_tickInfo + , breakpointsAllowed dflags + = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod specs + | otherwise + = Nothing ; ds_hpc_info <- case m_tickInfo of Just (orig_file2, ticks) ===================================== compiler/GHC/HsToCore/Breakpoints.hs ===================================== @@ -33,14 +33,6 @@ import GHC.Unit.Module (Module) import GHC.Utils.Outputable import Data.List (intersperse) -import GHCi.BreakArray (BreakArray) -import GHCi.RemoteTypes (ForeignRef) - --- TODO: Break this cycle -import {-# SOURCE #-} GHC.Runtime.Interpreter.Types (Interp, interpreterProfiled) -import {-# SOURCE #-} qualified GHC.Runtime.Interpreter as GHCi (newBreakArray) -import Data.Array.Base (numElements) - -------------------------------------------------------------------------------- -- ModBreaks -------------------------------------------------------------------------------- @@ -58,10 +50,7 @@ import Data.Array.Base (numElements) -- and 'modBreaks_decls'. data ModBreaks = ModBreaks - { modBreaks_flags :: ForeignRef BreakArray - -- ^ The array of flags, one per breakpoint, - -- indicating which breakpoints are enabled. - , modBreaks_locs :: !(Array BreakTickIndex SrcSpan) + { modBreaks_locs :: !(Array BreakTickIndex SrcSpan) -- ^ An array giving the source span of each breakpoint. , modBreaks_vars :: !(Array BreakTickIndex [OccName]) -- ^ An array giving the names of the free variables at each breakpoint. @@ -83,40 +72,31 @@ data ModBreaks -- generator needs to encode this information for each expression, the data is -- allocated remotely in GHCi's address space and passed to the codegen as -- foreign pointers. -mkModBreaks :: Interp -> Module -> SizedSeq Tick -> IO ModBreaks -mkModBreaks interp mod extendedMixEntries - = do - let count = fromIntegral $ sizeSS extendedMixEntries +mkModBreaks :: Bool {-^ Whether the interpreter is profiled and thus if we should include store a CCS array -} + -> Module -> SizedSeq Tick -> ModBreaks +mkModBreaks interpreterProfiled modl extendedMixEntries + = let count = fromIntegral $ sizeSS extendedMixEntries entries = ssElts extendedMixEntries - let - locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ] - varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ] - declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ] - ccs - | interpreterProfiled interp = - listArray - (0, count - 1) - [ ( concat $ intersperse "." $ tick_path t, - renderWithContext defaultSDocContext $ ppr $ tick_loc t - ) - | t <- entries - ] - | otherwise = listArray (0, -1) [] - hydrateModBreaks interp $ - ModBreaks - { modBreaks_flags = undefined, - modBreaks_locs = locsTicks, - modBreaks_vars = varsTicks, - modBreaks_decls = declsTicks, - modBreaks_ccs = ccs, - modBreaks_module = mod - } - -hydrateModBreaks :: Interp -> ModBreaks -> IO ModBreaks -hydrateModBreaks interp ModBreaks {..} = do - let count = numElements modBreaks_locs - modBreaks_flags <- GHCi.newBreakArray interp count - pure ModBreaks {..} + locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ] + varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ] + declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ] + ccs + | interpreterProfiled = + listArray + (0, count - 1) + [ ( concat $ intersperse "." $ tick_path t, + renderWithContext defaultSDocContext $ ppr $ tick_loc t + ) + | t <- entries + ] + | otherwise = listArray (0, -1) [] + in ModBreaks + { modBreaks_locs = locsTicks + , modBreaks_vars = varsTicks + , modBreaks_decls = declsTicks + , modBreaks_ccs = ccs + , modBreaks_module = modl + } {- Note [Field modBreaks_decls] ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -28,6 +28,7 @@ module GHC.Linker.Loader , extendLoadedEnv , deleteFromLoadedEnv -- * Internals + , allocateBreakArrays , rmDupLinkables , modifyLoaderState , initLinkDepsOpts @@ -122,8 +123,8 @@ import System.Win32.Info (getSystemDirectory) import GHC.Utils.Exception import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey) import GHC.Driver.Downsweep - - +import qualified GHC.Runtime.Interpreter as GHCi +import Data.Array.Base (numElements) -- Note [Linkers and loaders] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -177,13 +178,15 @@ emptyLoaderState = LoaderState { closure_env = emptyNameEnv , itbl_env = emptyNameEnv , addr_env = emptyNameEnv - , breakarray_env = emptyModuleEnv - , ccs_env = emptyModuleEnv } , pkgs_loaded = init_pkgs , bcos_loaded = emptyModuleEnv , objs_loaded = emptyModuleEnv , temp_sos = [] + , linked_breaks = LinkedBreaks + { breakarray_env = emptyModuleEnv + , ccs_env = emptyModuleEnv + } } -- Packages that don't need loading, because the compiler -- shares them with the interpreted program. @@ -694,28 +697,22 @@ loadDecls interp hsc_env span linkable = do else do -- Link the expression itself let le = linker_env pls + let lb = linked_breaks pls le2_itbl_env <- linkITbls interp (itbl_env le) (concat $ map bc_itbls cbcs) le2_addr_env <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le) cbcs - le2_breakarray_env <- - allocateBreakArrays - interp - (catMaybes $ map bc_breaks cbcs) - (breakarray_env le) - le2_ccs_env <- - allocateCCS - interp - (catMaybes $ map bc_breaks cbcs) - (ccs_env le) + le2_breakarray_env <- allocateBreakArrays interp (breakarray_env lb) (catMaybes $ map bc_breaks cbcs) + le2_ccs_env <- allocateCCS interp (ccs_env lb) (catMaybes $ map bc_breaks cbcs) let le2 = le { itbl_env = le2_itbl_env - , addr_env = le2_addr_env - , breakarray_env = le2_breakarray_env + , addr_env = le2_addr_env } + let lb2 = lb { breakarray_env = le2_breakarray_env , ccs_env = le2_ccs_env } -- Link the necessary packages and linkables - new_bindings <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs + new_bindings <- linkSomeBCOs interp (pkgs_loaded pls) le2 lb2 cbcs nms_fhvs <- makeForeignNamedHValueRefs interp new_bindings let ce2 = extendClosureEnv (closure_env le2) nms_fhvs - !pls2 = pls { linker_env = le2 { closure_env = ce2 } } + !pls2 = pls { linker_env = le2 { closure_env = ce2 } + , linked_breaks = lb2 } return (pls2, (nms_fhvs, links_needed, units_needed)) where cbcs = linkableBCOs linkable @@ -931,17 +928,15 @@ dynLinkBCOs interp pls bcos = do le1 = linker_env pls + lb1 = linked_breaks pls ie2 <- linkITbls interp (itbl_env le1) (concatMap bc_itbls cbcs) ae2 <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le1) cbcs - be2 <- - allocateBreakArrays - interp - (catMaybes $ map bc_breaks cbcs) - (breakarray_env le1) - ce2 <- allocateCCS interp (catMaybes $ map bc_breaks cbcs) (ccs_env le1) - let le2 = le1 { itbl_env = ie2, addr_env = ae2, breakarray_env = be2, ccs_env = ce2 } + be2 <- allocateBreakArrays interp (breakarray_env lb1) (catMaybes $ map bc_breaks cbcs) + ce2 <- allocateCCS interp (ccs_env lb1) (catMaybes $ map bc_breaks cbcs) + let le2 = le1 { itbl_env = ie2, addr_env = ae2 } + let lb2 = lb1 { breakarray_env = be2, ccs_env = ce2 } - names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs + names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 lb2 cbcs -- We only want to add the external ones to the ClosureEnv let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs @@ -952,19 +947,21 @@ dynLinkBCOs interp pls bcos = do new_binds <- makeForeignNamedHValueRefs interp to_add let ce2 = extendClosureEnv (closure_env le2) new_binds - return $! pls1 { linker_env = le2 { closure_env = ce2 } } + return $! pls1 { linker_env = le2 { closure_env = ce2 } + , linked_breaks = lb2 } -- Link a bunch of BCOs and return references to their values linkSomeBCOs :: Interp -> PkgsLoaded -> LinkerEnv + -> LinkedBreaks -> [CompiledByteCode] -> IO [(Name,HValueRef)] -- The returned HValueRefs are associated 1-1 with -- the incoming unlinked BCOs. Each gives the -- value of the corresponding unlinked BCO -linkSomeBCOs interp pkgs_loaded le mods = foldr fun do_link mods [] +linkSomeBCOs interp pkgs_loaded le lb mods = foldr fun do_link mods [] where fun CompiledByteCode{..} inner accum = inner (Foldable.toList bc_bcos : accum) @@ -974,7 +971,7 @@ linkSomeBCOs interp pkgs_loaded le mods = foldr fun do_link mods [] let flat = [ bco | bcos <- mods, bco <- bcos ] names = map unlinkedBCOName flat bco_ix = mkNameEnv (zip names [0..]) - resolved <- sequence [ linkBCO interp pkgs_loaded le bco_ix bco | bco <- flat ] + resolved <- sequence [ linkBCO interp pkgs_loaded le lb bco_ix bco | bco <- flat ] hvrefs <- createBCOs interp resolved return (zip names hvrefs) @@ -1072,9 +1069,13 @@ unload_wkr interp keep_linkables pls@LoaderState{..} = do keep_name n = isExternalName n && nameModule n `elemModuleEnv` remaining_bcos_loaded - !new_pls = pls { linker_env = filterLinkerEnv keep_name linker_env, - bcos_loaded = remaining_bcos_loaded, - objs_loaded = remaining_objs_loaded } + keep_mod :: Module -> Bool + keep_mod m = m `elemModuleEnv` remaining_bcos_loaded + + !new_pls = pls { linker_env = filterLinkerEnv keep_name linker_env, + linked_breaks = filterLinkedBreaks keep_mod linked_breaks, + bcos_loaded = remaining_bcos_loaded, + objs_loaded = remaining_objs_loaded } return new_pls where @@ -1656,30 +1657,34 @@ allocateTopStrings interp topStrings prev_env = do where mk_entry nm ptr = (nm, (nm, AddrPtr ptr)) --- | Given a list of 'ModBreaks' collected from a list of --- 'CompiledByteCode', allocate the 'BreakArray'. +-- | Given a list of 'InternalModBreaks' collected from a list of +-- 'CompiledByteCode', allocate the 'BreakArray' used to trigger breakpoints. allocateBreakArrays :: Interp -> - [InternalModBreaks] -> ModuleEnv (ForeignRef BreakArray) -> + [InternalModBreaks] -> IO (ModuleEnv (ForeignRef BreakArray)) -allocateBreakArrays _interp mbs be = +allocateBreakArrays interp = foldlM - ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> - evaluate $ extendModuleEnv be0 modBreaks_module modBreaks_flags + ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do + -- If no BreakArray is assigned to this module yet, create one + if not $ elemModuleEnv modBreaks_module be0 then do + let count = numElements modBreaks_locs + breakArray <- GHCi.newBreakArray interp count + evaluate $ extendModuleEnv be0 modBreaks_module breakArray + else + return be0 ) - be - mbs --- | Given a list of 'ModBreaks' collected from a list of --- 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling --- is enabled. +-- | Given a list of 'InternalModBreaks' collected from a list +-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is +-- enabled. allocateCCS :: Interp -> - [InternalModBreaks] -> ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) -> + [InternalModBreaks] -> IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) -allocateCCS interp mbs ce +allocateCCS interp ce mbss | interpreterProfiled interp = foldlM ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do @@ -1688,12 +1693,15 @@ allocateCCS interp mbs ce interp (moduleNameString $ moduleName modBreaks_module) (elems modBreaks_ccs) - evaluate $ - extendModuleEnv ce0 modBreaks_module $ - listArray - (0, length ccs - 1) - ccs + if not $ elemModuleEnv modBreaks_module ce0 then do + evaluate $ + extendModuleEnv ce0 modBreaks_module $ + listArray + (0, length ccs - 1) + ccs + else + return ce0 ) ce - mbs + mbss | otherwise = pure ce ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -18,6 +18,8 @@ module GHC.Linker.Types , ClosureEnv , emptyClosureEnv , extendClosureEnv + , LinkedBreaks(..) + , filterLinkedBreaks , LinkableSet , mkLinkableSet , unionLinkableSet @@ -159,6 +161,9 @@ data LoaderState = LoaderState , temp_sos :: ![(FilePath, String)] -- ^ We need to remember the name of previous temporary DLL/.so -- libraries so we can link them (see #10322) + + , linked_breaks :: !LinkedBreaks + -- ^ Mapping from loaded modules to their breakpoint arrays } uninitializedLoader :: IO Loader @@ -184,20 +189,13 @@ data LinkerEnv = LinkerEnv , addr_env :: !AddrEnv -- ^ Like 'closure_env' and 'itbl_env', but for top-level 'Addr#' literals, -- see Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode. - - , breakarray_env :: !(ModuleEnv (ForeignRef BreakArray)) - -- ^ Each 'Module's remote pointer of 'BreakArray'. - - , ccs_env :: !(ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) - -- ^ Each 'Module's array of remote pointers of 'CostCentre'. - -- Untouched when not profiling. } filterLinkerEnv :: (Name -> Bool) -> LinkerEnv -> LinkerEnv -filterLinkerEnv f le = le - { closure_env = filterNameEnv (f . fst) (closure_env le) - , itbl_env = filterNameEnv (f . fst) (itbl_env le) - , addr_env = filterNameEnv (f . fst) (addr_env le) +filterLinkerEnv f (LinkerEnv closure_e itbl_e addr_e) = LinkerEnv + { closure_env = filterNameEnv (f . fst) closure_e + , itbl_env = filterNameEnv (f . fst) itbl_e + , addr_env = filterNameEnv (f . fst) addr_e } type ClosureEnv = NameEnv (Name, ForeignHValue) @@ -209,6 +207,29 @@ extendClosureEnv :: ClosureEnv -> [(Name,ForeignHValue)] -> ClosureEnv extendClosureEnv cl_env pairs = extendNameEnvList cl_env [ (n, (n,v)) | (n,v) <- pairs] +-- | 'BreakArray's and CCSs are allocated per-module at link-time. +-- +-- Specifically, a module's 'BreakArray' is allocated either: +-- - When a BCO for that module is linked +-- - When :break is used on a given module *before* the BCO has been linked. +-- +-- We keep this structure in the 'LoaderState' +data LinkedBreaks + = LinkedBreaks + { breakarray_env :: !(ModuleEnv (ForeignRef BreakArray)) + -- ^ Each 'Module's remote pointer of 'BreakArray'. + + , ccs_env :: !(ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) + -- ^ Each 'Module's array of remote pointers of 'CostCentre'. + -- Untouched when not profiling. + } + +filterLinkedBreaks :: (Module -> Bool) -> LinkedBreaks -> LinkedBreaks +filterLinkedBreaks f (LinkedBreaks ba_e ccs_e) = LinkedBreaks + { breakarray_env = filterModuleEnv (\m _ -> f m) ba_e + , ccs_env = filterModuleEnv (\m _ -> f m) ccs_e + } + type PkgsLoaded = UniqDFM UnitId LoadedPkgInfo data LoadedPkgInfo ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -64,6 +64,7 @@ import GHCi.RemoteTypes import GHC.ByteCode.Types import GHC.Linker.Loader as Loader +import GHC.Linker.Types (LinkedBreaks (..)) import GHC.Hs @@ -126,6 +127,7 @@ import GHC.Tc.Utils.Instantiate (instDFunType) import GHC.Tc.Utils.Monad import GHC.IfaceToCore +import GHC.ByteCode.Breakpoints import Control.Monad import Data.Dynamic @@ -134,7 +136,7 @@ import Data.List (find,intercalate) import Data.List.NonEmpty (NonEmpty) import Unsafe.Coerce ( unsafeCoerce ) import qualified GHC.Unit.Home.Graph as HUG -import GHC.ByteCode.Breakpoints +import GHCi.BreakArray (BreakArray) -- ----------------------------------------------------------------------------- -- running a statement interactively @@ -348,13 +350,14 @@ handleRunStatus step expr bindings final_ids status history0 = do EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do let ibi = evalBreakpointToId eval_break let hug = hsc_HUG hsc_env - tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi) + tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi) + breakArray <- getBreakArray interp (toBreakpointId ibi) tick_brks let span = getBreakLoc ibi tick_brks decl = intercalate "." $ getBreakDecls ibi tick_brks -- Was this breakpoint explicitly enabled (ie. in @BreakArray@)? - bactive <- liftIO $ breakpointStatus interp (modBreaks_flags $ imodBreaks_modBreaks tick_brks) (ibi_tick_index ibi) + bactive <- liftIO $ breakpointStatus interp breakArray (ibi_tick_index ibi) apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt @@ -462,9 +465,24 @@ setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m () -- #191 setupBreakpoint interp bi cnt = do hug <- hsc_HUG <$> getSession modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi) - let breakarray = modBreaks_flags $ imodBreaks_modBreaks modBreaks - _ <- liftIO $ GHCi.storeBreakpoint interp breakarray (bi_tick_index bi) cnt - pure () + breakArray <- getBreakArray interp bi modBreaks + liftIO $ GHCi.storeBreakpoint interp breakArray (bi_tick_index bi) cnt + +getBreakArray :: GhcMonad m => Interp -> BreakpointId -> InternalModBreaks -> m (ForeignRef BreakArray) +getBreakArray interp BreakpointId{bi_tick_mod} imbs = do + + liftIO $ modifyLoaderState interp $ \ld_st -> do + let lb = linked_breaks ld_st + + -- Recall that BreakArrays are allocated only at BCO link time, so if we + -- haven't linked the BCOs we intend to break at yet, we allocate the arrays here. + ba_env <- allocateBreakArrays interp (breakarray_env lb) [imbs] + + return + ( ld_st { linked_breaks = lb{breakarray_env = ba_env} } + , expectJust {- just computed -} $ + lookupModuleEnv ba_env bi_tick_mod + ) back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan) back n = moveHist (+n) ===================================== compiler/GHC/Runtime/Interpreter.hs-boot deleted ===================================== @@ -1,10 +0,0 @@ -module GHC.Runtime.Interpreter where - -import {-# SOURCE #-} GHC.Runtime.Interpreter.Types -import Data.Int (Int) -import GHC.Base (IO) -import GHCi.BreakArray (BreakArray) -import GHCi.RemoteTypes (ForeignRef) - -newBreakArray :: Interp -> Int -> IO (ForeignRef BreakArray) - ===================================== compiler/GHC/Runtime/Interpreter/Types.hs-boot deleted ===================================== @@ -1,6 +0,0 @@ -module GHC.Runtime.Interpreter.Types where - -import Data.Bool - -data Interp -interpreterProfiled :: Interp -> Bool ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -5,6 +5,7 @@ GHC.Builtin.Types GHC.Builtin.Types.Literals GHC.Builtin.Types.Prim GHC.Builtin.Uniques +GHC.ByteCode.Breakpoints GHC.ByteCode.Types GHC.Cmm.BlockId GHC.Cmm.CLabel @@ -110,6 +111,8 @@ GHC.Hs.Pat GHC.Hs.Specificity GHC.Hs.Type GHC.Hs.Utils +GHC.HsToCore.Breakpoints +GHC.HsToCore.Ticks GHC.Iface.Errors.Types GHC.Iface.Ext.Fields GHC.Iface.Flags @@ -150,7 +153,6 @@ GHC.Tc.Zonk.Monad GHC.Types.Annotations GHC.Types.Avail GHC.Types.Basic -GHC.Types.Breakpoint GHC.Types.CostCentre GHC.Types.CostCentre.State GHC.Types.Cpr ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -5,6 +5,7 @@ GHC.Builtin.Types GHC.Builtin.Types.Literals GHC.Builtin.Types.Prim GHC.Builtin.Uniques +GHC.ByteCode.Breakpoints GHC.ByteCode.Types GHC.Cmm.BlockId GHC.Cmm.CLabel @@ -114,8 +115,10 @@ GHC.Hs.Pat GHC.Hs.Specificity GHC.Hs.Type GHC.Hs.Utils +GHC.HsToCore.Breakpoints GHC.HsToCore.Errors.Types GHC.HsToCore.Pmc.Solver.Types +GHC.HsToCore.Ticks GHC.Iface.Errors.Types GHC.Iface.Ext.Fields GHC.Iface.Flags @@ -171,7 +174,6 @@ GHC.Tc.Zonk.Monad GHC.Types.Annotations GHC.Types.Avail GHC.Types.Basic -GHC.Types.Breakpoint GHC.Types.CompleteMatch GHC.Types.CostCentre GHC.Types.CostCentre.State View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52490055d8f05e61489ee2ef8b57899… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52490055d8f05e61489ee2ef8b57899… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/stable-ipe-info] ipe: Use stable IDs for IPE entries
by Matthew Pickering (＠mpickering) 03 Jul '25

03 Jul '25

Matthew Pickering pushed to branch wip/stable-ipe-info at Glasgow Haskell Compiler / GHC Commits: 59f62065 by Matthew Pickering at 2025-07-03T16:01:26+01:00 ipe: Use stable IDs for IPE entries IPEs have historically been indexed and reported by their address. This makes it impossible to compare profiles between runs, since the addresses may change (due to ASLR) and also makes it tricky to separate out the IPE map from the binary. This small patch adds a stable identifier for each IPE entry. The stable identifier is a single 64 bit word. The high-bits are a per-module identifier and the low bits identify which entry in each module. 1. When a node is added into the IPE buffer it is assigned a unique identifier from an incrementing global counter. 2. Each entry already has an index by it's position in the `IpeBufferListNode`. The two are combined together by the `IPE_ENTRY_KEY` macro. Info table profiling uses the stable identifier rather than the address of the info table. The benefits of this change are: * Profiles from different runs can be easily compared * The metadata can be extracted from the binary (via the eventlog for example) and then stripped from the executable. Fixes #21766 - - - - - 5 changed files: - compiler/GHC/StgToCmm/InfoTableProv.hs - rts/IPE.c - rts/ProfHeap.c - rts/eventlog/EventLog.c - rts/include/rts/IPE.h Changes: ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -158,6 +158,9 @@ emitIpeBufferListNode this_mod ents dus0 = do [ -- 'next' field zeroCLit platform + -- 'node_id' field + , zeroCLit platform + -- 'compressed' field , int do_compress ===================================== rts/IPE.c ===================================== @@ -62,6 +62,22 @@ entry's containing IpeBufferListNode and its index in that node. When the user looks up an IPE entry, we convert it to the user-facing InfoProvEnt representation. +Note [Stable identifiers for IPE entries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Each IPE entry is given a stable identifier which remains the same across +different runs of the executable (unlike the address of the info table). + +The identifier is a 64-bit word which consists of two parts. + +* The high 32-bits are a per-node identifier. +* The low 32-bits are the index of the entry in the node. + +When a node is queued in the pending list by `registerInfoProvList` it is +given a unique identifier from an incrementing global variable. + +The unique key can be computed by using the `IPE_ENTRY_KEY` macro. + */ typedef struct { @@ -69,6 +85,13 @@ typedef struct { uint32_t idx; } IpeMapEntry; +// See Note [Stable identifiers for IPE entries] +#define IPE_ENTRY_KEY(entry) \ + MAKE_IPE_KEY((entry).node->node_id, (entry).idx) + +#define MAKE_IPE_KEY(module_id, idx) \ + ((((uint64_t)(module_id)) << 32) | ((uint64_t)(idx))) + #if defined(THREADED_RTS) static Mutex ipeMapLock; #endif @@ -78,6 +101,9 @@ static HashTable *ipeMap = NULL; // Accessed atomically static IpeBufferListNode *ipeBufferList = NULL; +// A global counter which is used to give an IPE entry a unique value across runs. +static StgWord next_module_id = 1; // Start at 1 to reserve 0 as "invalid" + static void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode*); static void updateIpeMap(void); @@ -114,6 +140,7 @@ static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, uint32_t i return (InfoProvEnt) { .info = node->tables[idx], .prov = { + .info_prov_id = MAKE_IPE_KEY(node->node_id, idx), .table_name = &strings[ent->table_name], .closure_desc = ent->closure_desc, .ty_desc = &strings[ent->ty_desc], @@ -181,9 +208,22 @@ A performance test for IPE registration and lookup can be found here: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/5724#note_370806 */ void registerInfoProvList(IpeBufferListNode *node) { + + // Grab a fresh module_id + uint32_t module_id; + StgWord temp_module_id; + while (true) { + temp_module_id = next_module_id; + if (cas(&next_module_id, temp_module_id, temp_module_id+1) == temp_module_id) { + module_id = (uint32_t) temp_module_id; + break; + } + + } while (true) { IpeBufferListNode *old = RELAXED_LOAD(&ipeBufferList); node->next = old; + node->node_id = module_id; if (cas_ptr((volatile void **) &ipeBufferList, old, node) == (void *) old) { return; } @@ -205,6 +245,18 @@ bool lookupIPE(const StgInfoTable *info, InfoProvEnt *out) { } } +// Returns 0 when the info table is not present in the info table map. +// See Note [Stable identifiers for IPE entries] +uint64_t lookupIPEId(const StgInfoTable *info) { + updateIpeMap(); + IpeMapEntry *map_ent = (IpeMapEntry *) lookupHashTable(ipeMap, (StgWord)(info)); + if (map_ent){ + return IPE_ENTRY_KEY(*map_ent); + } else { + return 0; + } +} + void updateIpeMap(void) { // Check if there's any work at all. If not so, we can circumvent locking, // which decreases performance. ===================================== rts/ProfHeap.c ===================================== @@ -23,6 +23,7 @@ #include "Printer.h" #include "Trace.h" #include "sm/GCThread.h" +#include "IPE.h" #include <fs_rts.h> #include <string.h> @@ -230,9 +231,10 @@ closureIdentity( const StgClosure *p ) return closure_type_names[info->type]; } } - case HEAP_BY_INFO_TABLE: { - return get_itbl(p); - } + case HEAP_BY_INFO_TABLE: + { + return (void *) (p->header.info); + } default: barf("closureIdentity"); @@ -853,6 +855,20 @@ aggregateCensusInfo( void ) } #endif +static void +recordIPEHeapSample(FILE *hp_file, uint64_t table_id, size_t count) +{ + // Print to heap profile file + fprintf(hp_file, "0x%" PRIx64, table_id); + + // Create label string for tracing + char str[100]; + sprintf(str, "0x%" PRIx64, table_id); + + // Emit the profiling sample (convert count to bytes) + traceHeapProfSampleString(0, str, count * sizeof(W_)); +} + /* ----------------------------------------------------------------------------- * Print out the results of a heap census. * -------------------------------------------------------------------------- */ @@ -915,6 +931,11 @@ dumpCensus( Census *census ) } #endif + // Census entries which we need to group together. + // Used by IPE profiling to group together bands which don't have IPE information. + // Printing at the end in the 0 band + uint64_t uncategorised_count = 0; + for (ctr = census->ctrs; ctr != NULL; ctr = ctr->next) { #if defined(PROFILING) @@ -944,12 +965,15 @@ dumpCensus( Census *census ) traceHeapProfSampleString(0, (char *)ctr->identity, count * sizeof(W_)); break; - case HEAP_BY_INFO_TABLE: - fprintf(hp_file, "%p", ctr->identity); - char str[100]; - sprintf(str, "%p", ctr->identity); - traceHeapProfSampleString(0, str, count * sizeof(W_)); + case HEAP_BY_INFO_TABLE: { + uint64_t table_id = lookupIPEId(ctr->identity); + if (! table_id) { + uncategorised_count += count; + continue; + } + recordIPEHeapSample(hp_file, table_id, count); break; + } #if defined(PROFILING) case HEAP_BY_CCS: fprint_ccs(hp_file, (CostCentreStack *)ctr->identity, @@ -999,9 +1023,21 @@ dumpCensus( Census *census ) barf("dumpCensus; doHeapProfile"); } + + fprintf(hp_file, "\t%" FMT_Word "\n", (W_)count * sizeof(W_)); } + // Print the unallocated data into the 0 band for info table profiling. + switch (RtsFlags.ProfFlags.doHeapProfile) { + case HEAP_BY_INFO_TABLE: + recordIPEHeapSample(hp_file, 0, uncategorised_count); + break; + default: + ASSERT(uncategorised_count == 0); + break; + } + traceHeapProfSampleEnd(era); printSample(false, census->time); ===================================== rts/eventlog/EventLog.c ===================================== @@ -1472,7 +1472,7 @@ void postIPE(const InfoProvEnt *ipe) CHECK(!ensureRoomForVariableEvent(&eventBuf, len)); postEventHeader(&eventBuf, EVENT_IPE); postPayloadSize(&eventBuf, len); - postWord64(&eventBuf, (StgWord) INFO_PTR_TO_STRUCT(ipe->info)); + postWord64(&eventBuf, (StgWord) (ipe->prov.info_prov_id)); postStringLen(&eventBuf, ipe->prov.table_name, table_name_len); postStringLen(&eventBuf, closure_desc_buf, closure_desc_len); postStringLen(&eventBuf, ipe->prov.ty_desc, ty_desc_len); ===================================== rts/include/rts/IPE.h ===================================== @@ -14,6 +14,7 @@ #pragma once typedef struct InfoProv_ { + uint64_t info_prov_id; const char *table_name; uint32_t closure_desc; // closure type const char *ty_desc; @@ -67,19 +68,33 @@ GHC_STATIC_ASSERT(sizeof(IpeBufferEntry) % (WORD_SIZE_IN_BITS / 8) == 0, "sizeof // See Note [IPE Stripping and magic words] #define IPE_MAGIC_WORD 0x4950450049504500UL +// Heap profiling currently requires a 32 bit pointer.. so for now just truncate +// the key to fit. It should still be big enough. +#if SIZEOF_VOID_P == 4 +// On 32-bit systems: keep lower 16 bits of module_id and idx +#define IPE_PROF_KEY(key64) \ + (uint32_t)((((key64) >> 16) & 0xFFFF0000) | ((key64) & 0x0000FFFF)) +#else +// On 64-bit systems: use full key +#define IPE_PROF_KEY(key64) (key64) +#endif + typedef struct { - StgWord magic; // Must be IPE_MAGIC_WORD + StgWord64 magic; // Must be IPE_MAGIC_WORD IpeBufferEntry entries[]; // Flexible array member } IpeBufferEntryBlock; typedef struct { - StgWord magic; // Must be IPE_MAGIC_WORD + StgWord64 magic; // Must be IPE_MAGIC_WORD char string_table[]; // Flexible array member for string table } IpeStringTableBlock; typedef struct IpeBufferListNode_ { struct IpeBufferListNode_ *next; + // This field is filled in when the node is registered. + uint32_t node_id; + // Everything below is read-only and generated by the codegen // This flag should be treated as a boolean @@ -112,6 +127,8 @@ void formatClosureDescIpe(const InfoProvEnt *ipe_buf, char *str_buf); // Returns true on success, initializes `out`. bool lookupIPE(const StgInfoTable *info, InfoProvEnt *out); +uint64_t lookupIPEId(const StgInfoTable *info); + #if defined(DEBUG) void printIPE(const StgInfoTable *info); #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59f62065392ec54603b879b8800b0d4… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59f62065392ec54603b879b8800b0d4… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/stable-ipe-info] 5 commits: Tick uses of wildcard/pun field binds as if using the record selector function
by Matthew Pickering (＠mpickering) 03 Jul '25

03 Jul '25

Matthew Pickering pushed to branch wip/stable-ipe-info at Glasgow Haskell Compiler / GHC Commits: 43b606bb by Florian Ragwitz at 2025-06-27T16:31:26-04:00 Tick uses of wildcard/pun field binds as if using the record selector function Fixes #17834. See Note [Record-selector ticks] for additional reasoning behind this as well as an overview of the implementation details and future improvements. - - - - - d4952549 by Ben Gamari at 2025-06-27T16:32:08-04:00 testsuite/caller-cc: Make CallerCc[123] less sensitive These were previously sensitive to irrelevant changes in program structure. To avoid this we filter out all by lines emitted by the -fcaller-cc from the profile. - - - - - 9b299678 by Matthew Pickering at 2025-07-03T11:36:32+01:00 ipe: Place strings and metadata into specific .ipe section By placing the .ipe metadata into a specific section it can be stripped from the final binary if desired. ``` objcopy --remove-section .ipe <binary> upx <binary> ``` Towards #21766 - - - - - fec3fd0a by Matthew Pickering at 2025-07-03T11:36:32+01:00 ipe: Place magic word at the start of entries in the .ipe section The magic word "IPE\nIPE\n" is placed at the start of .ipe sections, then if the section is stripped, we can check whether the section starts with the magic word or not to determine whether there is metadata present or not. Towards #21766 - - - - - eefb8f46 by Matthew Pickering at 2025-07-03T14:55:35+01:00 ipe: Use stable IDs for IPE entries IPEs have historically been indexed and reported by their address. This makes it impossible to compare profiles between runs, since the addresses may change (due to ASLR) and also makes it tricky to separate out the IPE map from the binary. This small patch adds a stable identifier for each IPE entry. The stable identifier is a single 64 bit word. The high-bits are a per-module identifier and the low bits identify which entry in each module. 1. When a node is added into the IPE buffer it is assigned a unique identifier from an incrementing global counter. 2. Each entry already has an index by it's position in the `IpeBufferListNode`. The two are combined together by the `IPE_ENTRY_KEY` macro. Info table profiling uses the stable identifier rather than the address of the info table. The benefits of this change are: * Profiles from different runs can be easily compared * The metadata can be extracted from the binary (via the eventlog for example) and then stripped from the executable. Fixes #21766 - - - - - 18 changed files: - compiler/GHC/Cmm.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToLlvm/Data.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - docs/users_guide/9.14.1-notes.rst - rts/IPE.c - rts/ProfHeap.c - rts/eventlog/EventLog.c - rts/include/rts/IPE.h - + testsuite/tests/hpc/recsel/Makefile - + testsuite/tests/hpc/recsel/recsel.hs - + testsuite/tests/hpc/recsel/recsel.stdout - + testsuite/tests/hpc/recsel/test.T - testsuite/tests/profiling/should_run/caller-cc/all.T - testsuite/tests/rts/ipe/ipeMap.c - testsuite/tests/rts/ipe/ipe_lib.c Changes: ===================================== compiler/GHC/Cmm.hs ===================================== @@ -278,6 +278,7 @@ data SectionType | InitArray -- .init_array on ELF, .ctor on Windows | FiniArray -- .fini_array on ELF, .dtor on Windows | CString + | IPE | OtherSection String deriving (Show) @@ -298,6 +299,7 @@ sectionProtection (Section t _) = case t of CString -> ReadOnlySection Data -> ReadWriteSection UninitialisedData -> ReadWriteSection + IPE -> ReadWriteSection (OtherSection _) -> ReadWriteSection {- @@ -557,4 +559,5 @@ pprSectionType s = doubleQuotes $ case s of InitArray -> text "initarray" FiniArray -> text "finiarray" CString -> text "cstring" + IPE -> text "ipe" OtherSection s' -> text s' ===================================== compiler/GHC/CmmToAsm/PPC/Ppr.hs ===================================== @@ -285,6 +285,9 @@ pprAlignForSection platform seg = line $ Data | ppc64 -> text ".align 3" | otherwise -> text ".align 2" + IPE + | ppc64 -> text ".align 3" + | otherwise -> text ".align 2" ReadOnlyData | ppc64 -> text ".align 3" | otherwise -> text ".align 2" ===================================== compiler/GHC/CmmToAsm/Ppr.hs ===================================== @@ -236,6 +236,10 @@ pprGNUSectionHeader config t suffix = | OSMinGW32 <- platformOS platform -> text ".rdata" | otherwise -> text ".rodata.str" + IPE + | OSMinGW32 <- platformOS platform + -> text ".rdata" + | otherwise -> text ".ipe" OtherSection _ -> panic "PprBase.pprGNUSectionHeader: unknown section type" flags = case t of @@ -248,6 +252,10 @@ pprGNUSectionHeader config t suffix = | OSMinGW32 <- platformOS platform -> empty | otherwise -> text ",\"aMS\"," <> sectionType platform "progbits" <> text ",1" + IPE + | OSMinGW32 <- platformOS platform + -> empty + | otherwise -> text ",\"a\"," <> sectionType platform "progbits" _ -> empty {-# SPECIALIZE pprGNUSectionHeader :: NCGConfig -> SectionType -> CLabel -> SDoc #-} {-# SPECIALIZE pprGNUSectionHeader :: NCGConfig -> SectionType -> CLabel -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable @@ -262,6 +270,7 @@ pprXcoffSectionHeader t = case t of RelocatableReadOnlyData -> text ".csect .text[PR] # RelocatableReadOnlyData" CString -> text ".csect .text[PR] # CString" UninitialisedData -> text ".csect .data[BS]" + IPE -> text ".csect .text[PR] #IPE" _ -> panic "pprXcoffSectionHeader: unknown section type" {-# SPECIALIZE pprXcoffSectionHeader :: SectionType -> SDoc #-} {-# SPECIALIZE pprXcoffSectionHeader :: SectionType -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable @@ -276,6 +285,7 @@ pprDarwinSectionHeader t = case t of InitArray -> text ".section\t__DATA,__mod_init_func,mod_init_funcs" FiniArray -> panic "pprDarwinSectionHeader: fini not supported" CString -> text ".section\t__TEXT,__cstring,cstring_literals" + IPE -> text ".const" OtherSection _ -> panic "pprDarwinSectionHeader: unknown section type" {-# SPECIALIZE pprDarwinSectionHeader :: SectionType -> SDoc #-} {-# SPECIALIZE pprDarwinSectionHeader :: SectionType -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable ===================================== compiler/GHC/CmmToLlvm/Data.hs ===================================== @@ -145,7 +145,7 @@ llvmSectionType p t = case t of CString -> case platformOS p of OSMinGW32 -> fsLit ".rdata$str" _ -> fsLit ".rodata.str" - + IPE -> fsLit ".ipe" InitArray -> panic "llvmSectionType: InitArray" FiniArray -> panic "llvmSectionType: FiniArray" OtherSection _ -> panic "llvmSectionType: unknown section type" ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -1,12 +1,11 @@ -{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE NondecreasingIndentation #-} -{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} {- (c) Galois, 2006 (c) University of Glasgow, 2007 +(c) Florian Ragwitz, 2025 -} module GHC.HsToCore.Ticks @@ -38,7 +37,9 @@ import GHC.Utils.Logger import GHC.Types.SrcLoc import GHC.Types.Basic import GHC.Types.Id +import GHC.Types.Id.Info import GHC.Types.Var.Set +import GHC.Types.Var.Env import GHC.Types.Name.Set hiding (FreeVars) import GHC.Types.Name import GHC.Types.CostCentre @@ -48,6 +49,7 @@ import GHC.Types.ProfAuto import Control.Monad import Data.List (isSuffixOf, intersperse) +import Data.Foldable (toList) import Trace.Hpc.Mix @@ -123,6 +125,7 @@ addTicksToBinds logger cfg , density = mkDensity tickish $ ticks_profAuto cfg , this_mod = mod , tickishType = tickish + , recSelBinds = emptyVarEnv } (binds',_,st') = unTM (addTickLHsBinds binds) env st in (binds', st') @@ -224,8 +227,7 @@ addTickLHsBind :: LHsBind GhcTc -> TM (LHsBind GhcTc) addTickLHsBind (L pos (XHsBindsLR bind@(AbsBinds { abs_binds = binds , abs_exports = abs_exports }))) = - withEnv add_exports $ - withEnv add_inlines $ do + withEnv (add_rec_sels . add_inlines . add_exports) $ do binds' <- addTickLHsBinds binds return $ L pos $ XHsBindsLR $ bind { abs_binds = binds' } where @@ -247,6 +249,12 @@ addTickLHsBind (L pos (XHsBindsLR bind@(AbsBinds { abs_binds = binds | ABE{ abe_poly = pid, abe_mono = mid } <- abs_exports , isInlinePragma (idInlinePragma pid) ] } + add_rec_sels env = + env{ recSelBinds = recSelBinds env `extendVarEnvList` + [ (abe_mono, abe_poly) + | ABE{ abe_poly, abe_mono } <- abs_exports + , RecSelId{} <- [idDetails abe_poly] ] } + addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches }))) = do let name = getOccString id decl_path <- getPathEntry @@ -261,6 +269,10 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches tickish <- tickishType `liftM` getEnv case tickish of { ProfNotes | inline -> return (L pos funBind); _ -> do + -- See Note [Record-selector ticks] + selTick <- recSelTick id + case selTick of { Just tick -> tick_rec_sel tick; _ -> do + (fvs, mg) <- getFreeVars $ addPathEntry name $ @@ -288,7 +300,40 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id, fun_matches = matches let mbCons = maybe Prelude.id (:) return $ L pos $ funBind { fun_matches = mg , fun_ext = second (tick `mbCons`) (fun_ext funBind) } - } + } } + where + -- See Note [Record-selector ticks] + tick_rec_sel tick = + pure $ L pos $ funBind { fun_ext = second (tick :) (fun_ext funBind) } + + +-- Note [Record-selector ticks] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Users expect (see #17834) that accessing a record field by its name using +-- NamedFieldPuns or RecordWildCards will mark it as covered. This is very +-- reasonable, because otherwise the use of those two language features will +-- produce unnecessary noise in coverage reports, distracting from real +-- coverage problems. +-- +-- Because of that, GHC chooses to treat record selectors specially for +-- coverage purposes to improve the developer experience. +-- +-- This is done by keeping track of which 'Id's are effectively bound to +-- record fields (using NamedFieldPuns or RecordWildCards) in 'TickTransEnv's +-- 'recSelBinds', and making 'HsVar's corresponding to those fields tick the +-- appropriate box when executed. +-- +-- To enable that, we also treat 'FunBind's for record selector functions +-- specially. We only create a TopLevelBox for the record selector function, +-- skipping the ExpBox that'd normally be created. This simplifies the re-use +-- of ticks for the same record selector, and is done by not recursing into +-- the fun_matches match group for record selector functions. +-- +-- This scheme could be extended further in the future, making coverage for +-- constructor fields (named or even positional) mean that the field was +-- accessed at run-time. For the time being, we only cover NamedFieldPuns and +-- RecordWildCards binds to cover most practical use-cases while keeping it +-- simple. -- TODO: Revisit this addTickLHsBind (L pos (pat@(PatBind { pat_lhs = lhs @@ -471,7 +516,10 @@ addBinTickLHsExpr boxLabel e@(L pos e0) -- in the addTickLHsExpr family of functions.) addTickHsExpr :: HsExpr GhcTc -> TM (HsExpr GhcTc) -addTickHsExpr e@(HsVar _ (L _ id)) = do freeVar id; return e +-- See Note [Record-selector ticks] +addTickHsExpr e@(HsVar _ (L _ id)) = + freeVar id >> recSelTick id >>= pure . maybe e wrap + where wrap tick = XExpr . HsTick tick . noLocA $ e addTickHsExpr e@(HsIPVar {}) = return e addTickHsExpr e@(HsOverLit {}) = return e addTickHsExpr e@(HsOverLabel{}) = return e @@ -532,7 +580,7 @@ addTickHsExpr (HsMultiIf ty alts) ; alts' <- mapM (traverse $ addTickGRHS isOneOfMany False False) alts ; return $ HsMultiIf ty alts' } addTickHsExpr (HsLet x binds e) = - bindLocals (collectLocalBinders CollNoDictBinders binds) $ do + bindLocals binds $ do binds' <- addTickHsLocalBinds binds -- to think about: !patterns. e' <- addTickLHsExprLetBody e return (HsLet x binds' e') @@ -580,6 +628,7 @@ addTickHsExpr e@(HsUntypedSplice{}) = return e addTickHsExpr e@(HsGetField {}) = return e addTickHsExpr e@(HsProjection {}) = return e addTickHsExpr (HsProc x pat cmdtop) = + bindLocals pat $ liftM2 (HsProc x) (addTickLPat pat) (traverse (addTickHsCmdTop) cmdtop) @@ -646,19 +695,17 @@ addTickMatch :: Bool -> Bool -> Bool {-Is this Do Expansion-} -> Match GhcTc (L -> TM (Match GhcTc (LHsExpr GhcTc)) addTickMatch isOneOfMany isLambda isDoExp match@(Match { m_pats = L _ pats , m_grhss = gRHSs }) = - bindLocals (collectPatsBinders CollNoDictBinders pats) $ do + bindLocals pats $ do gRHSs' <- addTickGRHSs isOneOfMany isLambda isDoExp gRHSs return $ match { m_grhss = gRHSs' } addTickGRHSs :: Bool -> Bool -> Bool -> GRHSs GhcTc (LHsExpr GhcTc) -> TM (GRHSs GhcTc (LHsExpr GhcTc)) addTickGRHSs isOneOfMany isLambda isDoExp (GRHSs x guarded local_binds) = - bindLocals binders $ do + bindLocals local_binds $ do local_binds' <- addTickHsLocalBinds local_binds guarded' <- mapM (traverse (addTickGRHS isOneOfMany isLambda isDoExp)) guarded return $ GRHSs x guarded' local_binds' - where - binders = collectLocalBinders CollNoDictBinders local_binds addTickGRHS :: Bool -> Bool -> Bool -> GRHS GhcTc (LHsExpr GhcTc) -> TM (GRHS GhcTc (LHsExpr GhcTc)) @@ -697,7 +744,7 @@ addTickLStmts isGuard stmts = do addTickLStmts' :: (Maybe (Bool -> BoxLabel)) -> [ExprLStmt GhcTc] -> TM a -> TM ([ExprLStmt GhcTc], a) addTickLStmts' isGuard lstmts res - = bindLocals (collectLStmtsBinders CollNoDictBinders lstmts) $ + = bindLocals lstmts $ do { lstmts' <- mapM (traverse (addTickStmt isGuard)) lstmts ; a <- res ; return (lstmts', a) } @@ -710,6 +757,7 @@ addTickStmt _isGuard (LastStmt x e noret ret) = (pure noret) (addTickSyntaxExpr hpcSrcSpan ret) addTickStmt _isGuard (BindStmt xbs pat e) = + bindLocals pat $ liftM4 (\b f -> BindStmt $ XBindStmtTc { xbstc_bindOp = b , xbstc_boundResultType = xbstc_boundResultType xbs @@ -770,17 +818,19 @@ addTickApplicativeArg isGuard (op, arg) = liftM2 (,) (addTickSyntaxExpr hpcSrcSpan op) (addTickArg arg) where addTickArg (ApplicativeArgOne m_fail pat expr isBody) = - ApplicativeArgOne - <$> mapM (addTickSyntaxExpr hpcSrcSpan) m_fail - <*> addTickLPat pat - <*> addTickLHsExpr expr - <*> pure isBody + bindLocals pat $ + ApplicativeArgOne + <$> mapM (addTickSyntaxExpr hpcSrcSpan) m_fail + <*> addTickLPat pat + <*> addTickLHsExpr expr + <*> pure isBody addTickArg (ApplicativeArgMany x stmts ret pat ctxt) = - (ApplicativeArgMany x) - <$> addTickLStmts isGuard stmts - <*> (unLoc <$> addTickLHsExpr (L (noAnnSrcSpan hpcSrcSpan) ret)) - <*> addTickLPat pat - <*> pure ctxt + bindLocals pat $ + ApplicativeArgMany x + <$> addTickLStmts isGuard stmts + <*> (unLoc <$> addTickLHsExpr (L (noAnnSrcSpan hpcSrcSpan) ret)) + <*> addTickLPat pat + <*> pure ctxt addTickStmtAndBinders :: Maybe (Bool -> BoxLabel) -> ParStmtBlock GhcTc GhcTc -> TM (ParStmtBlock GhcTc GhcTc) @@ -871,7 +921,7 @@ addTickHsCmd (HsCmdIf x cnd e1 c2 c3) = (addTickLHsCmd c2) (addTickLHsCmd c3) addTickHsCmd (HsCmdLet x binds c) = - bindLocals (collectLocalBinders CollNoDictBinders binds) $ do + bindLocals binds $ do binds' <- addTickHsLocalBinds binds -- to think about: !patterns. c' <- addTickLHsCmd c return (HsCmdLet x binds' c') @@ -907,18 +957,16 @@ addTickCmdMatchGroup mg@(MG { mg_alts = (L l matches) }) = do addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc)) addTickCmdMatch match@(Match { m_pats = L _ pats, m_grhss = gRHSs }) = - bindLocals (collectPatsBinders CollNoDictBinders pats) $ do + bindLocals pats $ do gRHSs' <- addTickCmdGRHSs gRHSs return $ match { m_grhss = gRHSs' } addTickCmdGRHSs :: GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc)) addTickCmdGRHSs (GRHSs x guarded local_binds) = - bindLocals binders $ do + bindLocals local_binds $ do local_binds' <- addTickHsLocalBinds local_binds guarded' <- mapM (traverse addTickCmdGRHS) guarded return $ GRHSs x guarded' local_binds' - where - binders = collectLocalBinders CollNoDictBinders local_binds addTickCmdGRHS :: GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc)) -- The *guards* are *not* Cmds, although the body is @@ -937,15 +985,14 @@ addTickLCmdStmts stmts = do addTickLCmdStmts' :: [LStmt GhcTc (LHsCmd GhcTc)] -> TM a -> TM ([LStmt GhcTc (LHsCmd GhcTc)], a) addTickLCmdStmts' lstmts res - = bindLocals binders $ do + = bindLocals lstmts $ do lstmts' <- mapM (traverse addTickCmdStmt) lstmts a <- res return (lstmts', a) - where - binders = collectLStmtsBinders CollNoDictBinders lstmts addTickCmdStmt :: Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc)) addTickCmdStmt (BindStmt x pat c) = + bindLocals pat $ liftM2 (BindStmt x) (addTickLPat pat) (addTickLHsCmd c) @@ -1006,11 +1053,13 @@ addTickArithSeqInfo (FromThenTo e1 e2 e3) = data TickTransState = TT { ticks :: !(SizedSeq Tick) , ccIndices :: !CostCentreState + , recSelTicks :: !(IdEnv CoreTickish) } initTTState :: TickTransState initTTState = TT { ticks = emptySS , ccIndices = newCostCentreState + , recSelTicks = emptyVarEnv } addMixEntry :: Tick -> TM Int @@ -1021,6 +1070,10 @@ addMixEntry ent = do } return c +addRecSelTick :: Id -> CoreTickish -> TM () +addRecSelTick sel tick = + setState $ \s -> s{ recSelTicks = extendVarEnv (recSelTicks s) sel tick } + data TickTransEnv = TTE { fileName :: FastString , density :: TickDensity , tte_countEntries :: !Bool @@ -1033,6 +1086,7 @@ data TickTransEnv = TTE { fileName :: FastString , blackList :: Set RealSrcSpan , this_mod :: Module , tickishType :: TickishType + , recSelBinds :: IdEnv Id } -- deriving Show @@ -1154,12 +1208,13 @@ ifGoodTickSrcSpan pos then_code else_code = do good <- isGoodTickSrcSpan pos if good then then_code else else_code -bindLocals :: [Id] -> TM a -> TM a -bindLocals new_ids (TM m) - = TM $ \ env st -> - case m env{ inScope = inScope env `extendVarSetList` new_ids } st of - (r, fv, st') -> (r, fv `delListFromOccEnv` occs, st') - where occs = [ nameOccName (idName id) | id <- new_ids ] +bindLocals :: (CollectBinders bndr, CollectFldBinders bndr) => bndr -> TM a -> TM a +bindLocals from (TM m) = TM $ \env st -> + case m (with_bnds env) st of + (r, fv, st') -> (r, fv `delListFromOccEnv` (map (nameOccName . idName) new_bnds), st') + where with_bnds e = e{ inScope = inScope e `extendVarSetList` new_bnds + , recSelBinds = recSelBinds e `plusVarEnv` collectFldBinds from } + new_bnds = collectBinds from withBlackListed :: SrcSpan -> TM a -> TM a withBlackListed (RealSrcSpan ss _) = withEnv (\ env -> env { blackList = Set.insert ss (blackList env) }) @@ -1186,6 +1241,17 @@ allocTickBox boxLabel countEntries topOnly pos m tickish <- mkTickish boxLabel countEntries topOnly pos fvs (declPath env) return (this_loc (XExpr $ HsTick tickish $ this_loc e)) +recSelTick :: Id -> TM (Maybe CoreTickish) +recSelTick id = ifDensity TickForCoverage maybe_tick (pure Nothing) + where + maybe_tick = getEnv >>= + maybe (pure Nothing) tick . (`lookupVarEnv` id) . recSelBinds + tick sel = getState >>= + maybe (alloc sel) (pure . Just) . (`lookupVarEnv` sel) . recSelTicks + alloc sel = allocATickBox (box sel) False False (getSrcSpan sel) noFVs + >>= traverse (\t -> t <$ addRecSelTick sel t) + box sel = TopLevelBox [getOccString sel] + -- the tick application inherits the source position of its -- expression argument to support nested box allocations allocATickBox :: BoxLabel -> Bool -> Bool -> SrcSpan -> FreeVars @@ -1288,3 +1354,98 @@ matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1 matchCount :: LMatch GhcTc body -> Int matchCount (L _ (Match { m_grhss = GRHSs _ grhss _ })) = length grhss + +-- | Convenience class used by 'bindLocals' to collect new bindings from +-- various parts of he AST. Just delegates to +-- 'collect{Pat,Pats,Local,LStmts}Binders' from 'GHC.Hs.Utils' as appropriate. +class CollectBinders a where + collectBinds :: a -> [Id] + +-- | Variant of 'CollectBinders' which collects information on which locals +-- are bound to record fields (currently only via 'RecordWildCards' or +-- 'NamedFieldPuns') to enable better coverage support for record selectors. +-- +-- See Note [Record-selector ticks]. +class CollectFldBinders a where + collectFldBinds :: a -> IdEnv Id + +instance CollectBinders (LocatedA (Pat GhcTc)) where + collectBinds = collectPatBinders CollNoDictBinders +instance CollectBinders [LocatedA (Pat GhcTc)] where + collectBinds = collectPatsBinders CollNoDictBinders +instance CollectBinders (HsLocalBinds GhcTc) where + collectBinds = collectLocalBinders CollNoDictBinders +instance CollectBinders [LocatedA (Stmt GhcTc (LocatedA (HsExpr GhcTc)))] where + collectBinds = collectLStmtsBinders CollNoDictBinders +instance CollectBinders [LocatedA (Stmt GhcTc (LocatedA (HsCmd GhcTc)))] where + collectBinds = collectLStmtsBinders CollNoDictBinders + +instance (CollectFldBinders a) => CollectFldBinders [a] where + collectFldBinds = foldr (flip plusVarEnv . collectFldBinds) emptyVarEnv +instance (CollectFldBinders e) => CollectFldBinders (GenLocated l e) where + collectFldBinds = collectFldBinds . unLoc +instance CollectFldBinders (Pat GhcTc) where + collectFldBinds ConPat{ pat_args = RecCon HsRecFields{ rec_flds, rec_dotdot } } = + collectFldBinds rec_flds `plusVarEnv` plusVarEnvList (zipWith fld_bnds [0..] rec_flds) + where n_explicit | Just (L _ (RecFieldsDotDot n)) <- rec_dotdot = n + | otherwise = length rec_flds + fld_bnds n (L _ HsFieldBind{ hfbLHS = L _ FieldOcc{ foLabel = L _ sel } + , hfbRHS = L _ (VarPat _ (L _ var)) + , hfbPun }) + | hfbPun || n >= n_explicit = unitVarEnv var sel + fld_bnds _ _ = emptyVarEnv + collectFldBinds ConPat{ pat_args = PrefixCon pats } = collectFldBinds pats + collectFldBinds ConPat{ pat_args = InfixCon p1 p2 } = collectFldBinds [p1, p2] + collectFldBinds (LazyPat _ pat) = collectFldBinds pat + collectFldBinds (BangPat _ pat) = collectFldBinds pat + collectFldBinds (AsPat _ _ pat) = collectFldBinds pat + collectFldBinds (ViewPat _ _ pat) = collectFldBinds pat + collectFldBinds (ParPat _ pat) = collectFldBinds pat + collectFldBinds (ListPat _ pats) = collectFldBinds pats + collectFldBinds (TuplePat _ pats _) = collectFldBinds pats + collectFldBinds (SumPat _ pats _ _) = collectFldBinds pats + collectFldBinds (SigPat _ pat _) = collectFldBinds pat + collectFldBinds (XPat exp) = collectFldBinds exp + collectFldBinds VarPat{} = emptyVarEnv + collectFldBinds WildPat{} = emptyVarEnv + collectFldBinds OrPat{} = emptyVarEnv + collectFldBinds LitPat{} = emptyVarEnv + collectFldBinds NPat{} = emptyVarEnv + collectFldBinds NPlusKPat{} = emptyVarEnv + collectFldBinds SplicePat{} = emptyVarEnv + collectFldBinds EmbTyPat{} = emptyVarEnv + collectFldBinds InvisPat{} = emptyVarEnv +instance (CollectFldBinders r) => CollectFldBinders (HsFieldBind l r) where + collectFldBinds = collectFldBinds . hfbRHS +instance CollectFldBinders XXPatGhcTc where + collectFldBinds (CoPat _ pat _) = collectFldBinds pat + collectFldBinds (ExpansionPat _ pat) = collectFldBinds pat +instance CollectFldBinders (HsLocalBinds GhcTc) where + collectFldBinds (HsValBinds _ bnds) = collectFldBinds bnds + collectFldBinds HsIPBinds{} = emptyVarEnv + collectFldBinds EmptyLocalBinds{} = emptyVarEnv +instance CollectFldBinders (HsValBinds GhcTc) where + collectFldBinds (ValBinds _ bnds _) = collectFldBinds bnds + collectFldBinds (XValBindsLR (NValBinds bnds _)) = collectFldBinds (map snd bnds) +instance CollectFldBinders (HsBind GhcTc) where + collectFldBinds PatBind{ pat_lhs } = collectFldBinds pat_lhs + collectFldBinds (XHsBindsLR AbsBinds{ abs_exports, abs_binds }) = + mkVarEnv [ (abe_poly, sel) + | ABE{ abe_poly, abe_mono } <- abs_exports + , Just sel <- [lookupVarEnv monos abe_mono] ] + where monos = collectFldBinds abs_binds + collectFldBinds VarBind{} = emptyVarEnv + collectFldBinds FunBind{} = emptyVarEnv + collectFldBinds PatSynBind{} = emptyVarEnv +instance CollectFldBinders (Stmt GhcTc e) where + collectFldBinds (BindStmt _ pat _) = collectFldBinds pat + collectFldBinds (LetStmt _ bnds) = collectFldBinds bnds + collectFldBinds (ParStmt _ xs _ _) = collectFldBinds [s | ParStmtBlock _ ss _ _ <- toList xs, s <- ss] + collectFldBinds TransStmt{ trS_stmts } = collectFldBinds trS_stmts + collectFldBinds RecStmt{ recS_stmts } = collectFldBinds recS_stmts + collectFldBinds (XStmtLR (ApplicativeStmt _ args _)) = collectFldBinds (map snd args) + collectFldBinds LastStmt{} = emptyVarEnv + collectFldBinds BodyStmt{} = emptyVarEnv +instance CollectFldBinders (ApplicativeArg GhcTc) where + collectFldBinds ApplicativeArgOne{ app_arg_pattern } = collectFldBinds app_arg_pattern + collectFldBinds ApplicativeArgMany{ bv_pattern } = collectFldBinds bv_pattern ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -66,6 +66,28 @@ construction, the 'compressed' field of each IPE buffer list node is examined. If the field indicates that the data has been compressed, the entry data and strings table are decompressed before continuing with the normal IPE map construction. + +Note [IPE Stripping and magic words] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +For systems which support ELF executables: + +The metadata part of IPE info is placed into a separate ELF section (.ipe). +This can then be stripped afterwards if you don't require the metadata + +``` +-- Remove the section +objcopy --remove-section .ipe <your-exe> +-- Repack and compress the executable +upx <your-exe> +``` + +The .ipe section starts with a magic 64-bit word "IPE\nIPE\n`, encoded as ascii. + +The RTS checks to see if the .ipe section starts with the magic word. If the +section has been stripped then it won't start with the magic word and the +metadata won't be accessible for the info tables. + -} emitIpeBufferListNode :: @@ -124,11 +146,21 @@ emitIpeBufferListNode this_mod ents dus0 = do ipe_buffer_lbl :: CLabel ipe_buffer_lbl = mkIPELabel this_mod + -- A magic word we can use to see if the IPE information has been stripped + -- or not + -- See Note [IPE Stripping and magic words] + -- "IPE\nIPE\n", null terminated. + ipe_header :: CmmStatic + ipe_header = CmmStaticLit (CmmInt 0x4950450049504500 W64) + ipe_buffer_node :: [CmmStatic] ipe_buffer_node = map CmmStaticLit [ -- 'next' field zeroCLit platform + -- 'node_id' field + , zeroCLit platform + -- 'compressed' field , int do_compress @@ -164,13 +196,13 @@ emitIpeBufferListNode this_mod ents dus0 = do -- Emit the strings table emitDecl $ CmmData - (Section Data strings_lbl) - (CmmStaticsRaw strings_lbl strings) + (Section IPE strings_lbl) + (CmmStaticsRaw strings_lbl (ipe_header : strings)) -- Emit the list of IPE buffer entries emitDecl $ CmmData - (Section Data entries_lbl) - (CmmStaticsRaw entries_lbl entries) + (Section IPE entries_lbl) + (CmmStaticsRaw entries_lbl (ipe_header : entries)) -- Emit the IPE buffer list node emitDecl $ CmmData ===================================== docs/users_guide/9.14.1-notes.rst ===================================== @@ -138,6 +138,11 @@ Compiler uses of the now deprecated ``pattern`` namespace specifier in import/export lists. See `GHC Proposal #581, section 2.3 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0581-n…>`_. +- Code coverage (:ghc-flag:`-fhpc`) now treats uses of record fields via + :extension:`RecordWildCards` or :extension:`NamedFieldPuns` as if the fields + were accessed using the generated record selector functions, marking the fields + as covered in coverage reports (:ghc-ticket:`17834`). + GHCi ~~~~ ===================================== rts/IPE.c ===================================== @@ -62,6 +62,22 @@ entry's containing IpeBufferListNode and its index in that node. When the user looks up an IPE entry, we convert it to the user-facing InfoProvEnt representation. +Note [Stable identifiers for IPE entries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Each IPE entry is given a stable identifier which remains the same across +different runs of the executable (unlike the address of the info table). + +The identifier is a 64-bit word which consists of two parts. + +* The high 32-bits are a per-node identifier. +* The low 32-bits are the index of the entry in the node. + +When a node is queued in the pending list by `registerInfoProvList` it is +given a unique identifier from an incrementing global variable. + +The unique key can be computed by using the `IPE_ENTRY_KEY` macro. + */ typedef struct { @@ -69,6 +85,13 @@ typedef struct { uint32_t idx; } IpeMapEntry; +// See Note [Stable identifiers for IPE entries] +#define IPE_ENTRY_KEY(entry) \ + MAKE_IPE_KEY((entry).node->node_id, (entry).idx) + +#define MAKE_IPE_KEY(module_id, idx) \ + ((((uint64_t)(module_id)) << 32) | ((uint64_t)(idx))) + #if defined(THREADED_RTS) static Mutex ipeMapLock; #endif @@ -78,9 +101,22 @@ static HashTable *ipeMap = NULL; // Accessed atomically static IpeBufferListNode *ipeBufferList = NULL; +// A global counter which is used to give an IPE entry a unique value across runs. +static StgWord next_module_id = 1; // Start at 1 to reserve 0 as "invalid" + static void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode*); static void updateIpeMap(void); +// Check whether the IpeBufferListNode has the relevant magic words. +// See Note [IPE Stripping and magic words] +static inline bool ipe_node_valid(const IpeBufferListNode *node) { + return node && + node->entries_block && + node->string_table_block && + node->entries_block->magic == IPE_MAGIC_WORD && + node->string_table_block->magic == IPE_MAGIC_WORD; +} + #if defined(THREADED_RTS) void initIpe(void) { initMutex(&ipeMapLock); } @@ -99,11 +135,12 @@ static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, uint32_t i { CHECK(idx < node->count); CHECK(!node->compressed); - const char *strings = node->string_table; - const IpeBufferEntry *ent = &node->entries[idx]; + const char *strings = node->string_table_block->string_table; + const IpeBufferEntry *ent = &node->entries_block->entries[idx]; return (InfoProvEnt) { .info = node->tables[idx], .prov = { + .info_prov_id = MAKE_IPE_KEY(node->node_id, idx), .table_name = &strings[ent->table_name], .closure_desc = ent->closure_desc, .ty_desc = &strings[ent->ty_desc], @@ -121,19 +158,23 @@ static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, uint32_t i static void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED, const void *value) { const IpeMapEntry *map_ent = (const IpeMapEntry *)value; - const InfoProvEnt ipe = ipeBufferEntryToIpe(map_ent->node, map_ent->idx); - traceIPE(&ipe); + if (ipe_node_valid(map_ent->node)){ + const InfoProvEnt ipe = ipeBufferEntryToIpe(map_ent->node, map_ent->idx); + traceIPE(&ipe); + } } void dumpIPEToEventLog(void) { // Dump pending entries IpeBufferListNode *node = RELAXED_LOAD(&ipeBufferList); while (node != NULL) { - decompressIPEBufferListNodeIfCompressed(node); + if (ipe_node_valid(node)){ + decompressIPEBufferListNodeIfCompressed(node); - for (uint32_t i = 0; i < node->count; i++) { - const InfoProvEnt ent = ipeBufferEntryToIpe(node, i); - traceIPE(&ent); + for (uint32_t i = 0; i < node->count; i++) { + const InfoProvEnt ent = ipeBufferEntryToIpe(node, i); + traceIPE(&ent); + } } node = node->next; } @@ -167,9 +208,22 @@ A performance test for IPE registration and lookup can be found here: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/5724#note_370806 */ void registerInfoProvList(IpeBufferListNode *node) { + + // Grab a fresh module_id + uint32_t module_id; + StgWord temp_module_id; + while (true) { + temp_module_id = next_module_id; + if (cas(&next_module_id, temp_module_id, temp_module_id+1) == temp_module_id) { + module_id = (uint32_t) temp_module_id; + break; + } + + } while (true) { IpeBufferListNode *old = RELAXED_LOAD(&ipeBufferList); node->next = old; + node->node_id = module_id; if (cas_ptr((volatile void **) &ipeBufferList, old, node) == (void *) old) { return; } @@ -183,7 +237,7 @@ void formatClosureDescIpe(const InfoProvEnt *ipe_buf, char *str_buf) { bool lookupIPE(const StgInfoTable *info, InfoProvEnt *out) { updateIpeMap(); IpeMapEntry *map_ent = (IpeMapEntry *) lookupHashTable(ipeMap, (StgWord)info); - if (map_ent) { + if (map_ent && ipe_node_valid(map_ent->node)) { *out = ipeBufferEntryToIpe(map_ent->node, map_ent->idx); return true; } else { @@ -191,6 +245,18 @@ bool lookupIPE(const StgInfoTable *info, InfoProvEnt *out) { } } +// Returns 0 when the info table is not present in the info table map. +// See Note [Stable identifiers for IPE entries] +uint64_t lookupIPEId(const StgInfoTable *info) { + updateIpeMap(); + IpeMapEntry *map_ent = (IpeMapEntry *) lookupHashTable(ipeMap, (StgWord)(info)); + if (map_ent){ + return IPE_ENTRY_KEY(*map_ent); + } else { + return 0; + } +} + void updateIpeMap(void) { // Check if there's any work at all. If not so, we can circumvent locking, // which decreases performance. ===================================== rts/ProfHeap.c ===================================== @@ -23,6 +23,7 @@ #include "Printer.h" #include "Trace.h" #include "sm/GCThread.h" +#include "IPE.h" #include <fs_rts.h> #include <string.h> @@ -230,9 +231,10 @@ closureIdentity( const StgClosure *p ) return closure_type_names[info->type]; } } - case HEAP_BY_INFO_TABLE: { - return get_itbl(p); - } + case HEAP_BY_INFO_TABLE: + { + return (void *) (p->header.info); + } default: barf("closureIdentity"); @@ -853,6 +855,20 @@ aggregateCensusInfo( void ) } #endif +static void +recordIPEHeapSample(FILE *hp_file, uint64_t table_id, size_t count) +{ + // Print to heap profile file + fprintf(hp_file, "0x%" PRIx64, table_id); + + // Create label string for tracing + char str[100]; + sprintf(str, "0x%" PRIx64, table_id); + + // Emit the profiling sample (convert count to bytes) + traceHeapProfSampleString(0, str, count * sizeof(W_)); +} + /* ----------------------------------------------------------------------------- * Print out the results of a heap census. * -------------------------------------------------------------------------- */ @@ -915,6 +931,11 @@ dumpCensus( Census *census ) } #endif + // Census entries which we need to group together. + // Used by IPE profiling to group together bands which don't have IPE information. + // Printing at the end in the 0 band + uint64_t uncategorised_count = 0; + for (ctr = census->ctrs; ctr != NULL; ctr = ctr->next) { #if defined(PROFILING) @@ -945,10 +966,13 @@ dumpCensus( Census *census ) count * sizeof(W_)); break; case HEAP_BY_INFO_TABLE: - fprintf(hp_file, "%p", ctr->identity); - char str[100]; - sprintf(str, "%p", ctr->identity); - traceHeapProfSampleString(0, str, count * sizeof(W_)); + + uint64_t table_id = lookupIPEId(ctr->identity); + if (! table_id) { + uncategorised_count += count; + continue; + } + recordIPEHeapSample(hp_file, table_id, count); break; #if defined(PROFILING) case HEAP_BY_CCS: @@ -999,9 +1023,21 @@ dumpCensus( Census *census ) barf("dumpCensus; doHeapProfile"); } + + fprintf(hp_file, "\t%" FMT_Word "\n", (W_)count * sizeof(W_)); } + // Print the unallocated data into the 0 band for info table profiling. + switch (RtsFlags.ProfFlags.doHeapProfile) { + case HEAP_BY_INFO_TABLE: + recordIPEHeapSample(hp_file, 0, uncategorised_count); + break; + default: + ASSERT(uncategorised_count == 0); + break; + } + traceHeapProfSampleEnd(era); printSample(false, census->time); ===================================== rts/eventlog/EventLog.c ===================================== @@ -1472,7 +1472,7 @@ void postIPE(const InfoProvEnt *ipe) CHECK(!ensureRoomForVariableEvent(&eventBuf, len)); postEventHeader(&eventBuf, EVENT_IPE); postPayloadSize(&eventBuf, len); - postWord64(&eventBuf, (StgWord) INFO_PTR_TO_STRUCT(ipe->info)); + postWord64(&eventBuf, (StgWord) (ipe->prov.info_prov_id)); postStringLen(&eventBuf, ipe->prov.table_name, table_name_len); postStringLen(&eventBuf, closure_desc_buf, closure_desc_len); postStringLen(&eventBuf, ipe->prov.ty_desc, ty_desc_len); ===================================== rts/include/rts/IPE.h ===================================== @@ -14,6 +14,7 @@ #pragma once typedef struct InfoProv_ { + uint64_t info_prov_id; const char *table_name; uint32_t closure_desc; // closure type const char *ty_desc; @@ -63,9 +64,37 @@ typedef struct { GHC_STATIC_ASSERT(sizeof(IpeBufferEntry) % (WORD_SIZE_IN_BITS / 8) == 0, "sizeof(IpeBufferEntry) must be a multiple of the word size"); +// The magic word is IPE\nIPE\n, which occupies the full 64 bit width of a word. +// See Note [IPE Stripping and magic words] +#define IPE_MAGIC_WORD 0x4950450049504500UL + +// Heap profiling currently requires a 32 bit pointer.. so for now just truncate +// the key to fit. It should still be big enough. +#if SIZEOF_VOID_P == 4 +// On 32-bit systems: keep lower 16 bits of module_id and idx +#define IPE_PROF_KEY(key64) \ + (uint32_t)((((key64) >> 16) & 0xFFFF0000) | ((key64) & 0x0000FFFF)) +#else +// On 64-bit systems: use full key +#define IPE_PROF_KEY(key64) (key64) +#endif + +typedef struct { + StgWord64 magic; // Must be IPE_MAGIC_WORD + IpeBufferEntry entries[]; // Flexible array member +} IpeBufferEntryBlock; + +typedef struct { + StgWord64 magic; // Must be IPE_MAGIC_WORD + char string_table[]; // Flexible array member for string table +} IpeStringTableBlock; + typedef struct IpeBufferListNode_ { struct IpeBufferListNode_ *next; + // This field is filled in when the node is registered. + uint32_t node_id; + // Everything below is read-only and generated by the codegen // This flag should be treated as a boolean @@ -76,10 +105,10 @@ typedef struct IpeBufferListNode_ { // When TNTC is enabled, these will point to the entry code // not the info table itself. const StgInfoTable **tables; - IpeBufferEntry *entries; + IpeBufferEntryBlock *entries_block; StgWord entries_size; // decompressed size - const char *string_table; + const IpeStringTableBlock *string_table_block; StgWord string_table_size; // decompressed size // Shared by all entries @@ -98,6 +127,8 @@ void formatClosureDescIpe(const InfoProvEnt *ipe_buf, char *str_buf); // Returns true on success, initializes `out`. bool lookupIPE(const StgInfoTable *info, InfoProvEnt *out); +uint64_t lookupIPEId(const StgInfoTable *info); + #if defined(DEBUG) void printIPE(const StgInfoTable *info); #endif ===================================== testsuite/tests/hpc/recsel/Makefile ===================================== @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk ===================================== testsuite/tests/hpc/recsel/recsel.hs ===================================== @@ -0,0 +1,49 @@ +{-# LANGUAGE RecordWildCards, NamedFieldPuns, Arrows #-} + +import Control.Monad.Identity +import Control.Arrow (runKleisli, arr, returnA) +import Data.Maybe +import Data.List +import Data.Bifunctor +import Trace.Hpc.Mix +import Trace.Hpc.Tix +import Trace.Hpc.Reflect + +data Foo = Foo { fooA, fooB, fooC, fooD, fooE, fooF, fooG, fooH, fooI + , fooJ, fooK, fooL, fooM, fooN, fooO :: Int } +data Bar = Bar { barFoo :: Foo } + +fAB Foo{..} = fooA + fooB +fC Foo{fooC} = fooC +fD x Foo{..} = fromMaybe 0 $ if x then Just fooD else Nothing +fE Bar{barFoo = Foo{..}} = fooE +fF Foo{fooF = f} = f +fG f = let Foo{..} = f in fooG +fH f = runIdentity $ do + Foo{..} <- pure f + return fooH +fI f = runIdentity $ do + let Foo{..} = f + return fooI +fJ f = [ fooJ | let Foo{..} = f ] !! 0 +fK = runIdentity . runKleisli (proc f -> do + Foo{..} <- arr id -< f + returnA -< fooK) +fL = runIdentity . runKleisli (proc f -> do + let Foo{..} = f; + returnA -< fooL) +fM f | Foo{..} <- f = fooM +fN f = fooN f +fO = runIdentity . runKleisli (proc Foo{..} -> returnA -< fooO) + +recSel (n, TopLevelBox [s]) | any (`isPrefixOf` s) ["foo", "bar"] = Just (n, s) +recSel _ = Nothing + +main = do + let foo = Foo 42 23 0 1 2 3 4 5 6 7 0xaffe 9 10 11 12 + mapM_ (print . ($ foo)) + [fAB, fC, fD False, fE . Bar, fF, fG, fH, fI, fJ, fK, fL, fM, fN, fO] + (Mix _ _ _ _ mixs) <- readMix [".hpc"] (Left "Main") + let sels = mapMaybe recSel . zip [0..] $ map snd mixs + (Tix [TixModule "Main" _ _ tix]) <- examineTix + mapM_ print . sortOn snd $ map (first (tix !!)) sels ===================================== testsuite/tests/hpc/recsel/recsel.stdout ===================================== @@ -0,0 +1,30 @@ +65 +0 +0 +2 +3 +4 +5 +6 +7 +45054 +9 +10 +11 +12 +(0,"barFoo") +(1,"fooA") +(1,"fooB") +(1,"fooC") +(0,"fooD") +(1,"fooE") +(0,"fooF") +(1,"fooG") +(1,"fooH") +(1,"fooI") +(1,"fooJ") +(1,"fooK") +(1,"fooL") +(1,"fooM") +(1,"fooN") +(1,"fooO") ===================================== testsuite/tests/hpc/recsel/test.T ===================================== @@ -0,0 +1,7 @@ +setTestOpts([omit_ghci, when(fast(), skip), js_skip]) + +test('recsel', + [ignore_extension, + when(arch('wasm32'), fragile(23243))], + compile_and_run, ['-fhpc']) + ===================================== testsuite/tests/profiling/should_run/caller-cc/all.T ===================================== @@ -8,6 +8,7 @@ setTestOpts(only_ways(prof_ways)) setTestOpts(extra_files(['Main.hs'])) setTestOpts(extra_run_opts('7')) setTestOpts(grep_prof("Main.hs")) +setTestOpts(grep_prof("calling:")) # N.B. Main.hs is stolen from heapprof001. ===================================== testsuite/tests/rts/ipe/ipeMap.c ===================================== @@ -48,7 +48,8 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { // Allocate buffers for IPE buffer list node IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); node->tables = malloc(sizeof(StgInfoTable *)); - node->entries = malloc(sizeof(IpeBufferEntry)); + node->entries_block = malloc(sizeof(StgWord64) + sizeof(IpeBufferEntry)); + node->entries_block->magic = IPE_MAGIC_WORD; StringTable st; init_string_table(&st); @@ -61,9 +62,13 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { node->compressed = 0; node->count = 1; node->tables[0] = get_itbl(fortyTwo); - node->entries[0] = makeAnyProvEntry(cap, &st, 42); + node->entries_block->entries[0] = makeAnyProvEntry(cap, &st, 42); node->entries_size = sizeof(IpeBufferEntry); - node->string_table = st.buffer; + + IpeStringTableBlock *string_table_block = malloc(sizeof(StgWord64) + st.size); + string_table_block->magic = IPE_MAGIC_WORD; + memcpy(string_table_block->string_table, st.buffer, st.size); + node->string_table_block = string_table_block; node->string_table_size = st.size; registerInfoProvList(node); @@ -90,7 +95,8 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, // Allocate buffers for IPE buffer list node IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); node->tables = malloc(sizeof(StgInfoTable *)); - node->entries = malloc(sizeof(IpeBufferEntry)); + node->entries_block = malloc(sizeof(StgWord64) + sizeof(IpeBufferEntry)); + node->entries_block->magic = IPE_MAGIC_WORD; StringTable st; init_string_table(&st); @@ -103,9 +109,12 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, node->compressed = 0; node->count = 1; node->tables[0] = get_itbl(twentyThree); - node->entries[0] = makeAnyProvEntry(cap, &st, 23); + node->entries_block->entries[0] = makeAnyProvEntry(cap, &st, 23); node->entries_size = sizeof(IpeBufferEntry); - node->string_table = st.buffer; + IpeStringTableBlock *string_table_block = malloc(sizeof(StgWord64) + st.size); + string_table_block->magic = IPE_MAGIC_WORD; + memcpy(string_table_block->string_table, st.buffer, st.size); + node->string_table_block = string_table_block; node->string_table_size = st.size; registerInfoProvList(node); @@ -121,7 +130,8 @@ void shouldFindTwoFromTheSameList(Capability *cap) { // Allocate buffers for IPE buffer list node IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); node->tables = malloc(sizeof(StgInfoTable *) * 2); - node->entries = malloc(sizeof(IpeBufferEntry) * 2); + node->entries_block = malloc(sizeof(StgWord64) + sizeof(IpeBufferEntry) * 2); + node->entries_block->magic = IPE_MAGIC_WORD; StringTable st; init_string_table(&st); @@ -133,10 +143,13 @@ void shouldFindTwoFromTheSameList(Capability *cap) { node->count = 2; node->tables[0] = get_itbl(one); node->tables[1] = get_itbl(two); - node->entries[0] = makeAnyProvEntry(cap, &st, 1); - node->entries[1] = makeAnyProvEntry(cap, &st, 2); + node->entries_block->entries[0] = makeAnyProvEntry(cap, &st, 1); + node->entries_block->entries[1] = makeAnyProvEntry(cap, &st, 2); node->entries_size = sizeof(IpeBufferEntry) * 2; - node->string_table = st.buffer; + IpeStringTableBlock *string_table_block = malloc(sizeof(StgWord64) + st.size); + string_table_block->magic = IPE_MAGIC_WORD; + memcpy(string_table_block->string_table, st.buffer, st.size); + node->string_table_block = string_table_block; node->string_table_size = st.size; registerInfoProvList(node); @@ -152,7 +165,11 @@ void shouldDealWithAnEmptyList(Capability *cap, HaskellObj fortyTwo) { IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); node->count = 0; node->next = NULL; - node->string_table = ""; + IpeStringTableBlock *string_table_block = malloc(sizeof(StgWord64)); + string_table_block->magic = IPE_MAGIC_WORD; + + node->entries_block = malloc(sizeof(StgWord64)); + node->entries_block->magic = IPE_MAGIC_WORD; registerInfoProvList(node); ===================================== testsuite/tests/rts/ipe/ipe_lib.c ===================================== @@ -64,7 +64,8 @@ IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) { // Allocate buffers for IpeBufferListNode IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); node->tables = malloc(sizeof(StgInfoTable *) * n); - node->entries = malloc(sizeof(IpeBufferEntry) * n); + node->entries_block = malloc(sizeof(StgWord64) + sizeof(IpeBufferEntry) * n); + node->entries_block->magic = IPE_MAGIC_WORD; StringTable st; init_string_table(&st); @@ -83,14 +84,19 @@ IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) { for (int i=start; i < end; i++) { HaskellObj closure = rts_mkInt(cap, 42); node->tables[i] = get_itbl(closure); - node->entries[i] = makeAnyProvEntry(cap, &st, i); + node->entries_block->entries[i] = makeAnyProvEntry(cap, &st, i); } // Set the rest of the fields node->next = NULL; node->compressed = 0; node->count = n; - node->string_table = st.buffer; + + IpeStringTableBlock *string_table_block = + malloc(sizeof(StgWord64) + st.size); + string_table_block->magic = IPE_MAGIC_WORD; + memcpy(string_table_block->string_table, st.buffer, st.size); + node->string_table_block = string_table_block; return node; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fef9d9707057c81cf97f9bf4799128… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fef9d9707057c81cf97f9bf4799128… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/stable-ipe-info] 31 commits: MachRegs.h: Don't define NO_ARG_REGS when a XMM register is defined
by Matthew Pickering (＠mpickering) 03 Jul '25

03 Jul '25

Matthew Pickering pushed to branch wip/stable-ipe-info at Glasgow Haskell Compiler / GHC Commits: e64b3f16 by ARATA Mizuki at 2025-06-17T10:13:42+09:00 MachRegs.h: Don't define NO_ARG_REGS when a XMM register is defined On i386, MAX_REAL_VANILLA_REG is 1, but MAX_REAL_XMM_REG is 4. If we define NO_ARG_REGS on i386, programs that use SIMD vectors may segfault. Closes #25985 A couple of notes on the BROKEN_TESTS field: * This fixes the segfault from T25062_V16. * The failure from T22187_run was fixed in an earlier commit (see #25561), but BROKEN_TESTS was missed at that time. Now should be a good time to mark it fixed. - - - - - 3e7c6b4d by Matthew Pickering at 2025-06-18T15:34:04-04:00 Improve error messages when implicit lifting fails This patch concerns programs which automatically try to fix level errors by inserting `Lift`. For example: ``` foo x = [| x |] ~> foo x = [| $(lift x) |] ``` Before, there were two problems with the message. 1. (#26031), the location of the error was reported as the whole quotation. 2. (#26035), the message just mentions there is no Lift instance, but gives no indicate why the user program needed a Lift instance in the first place. This problem is especially bad when you disable `ImplicitStagePersistence`, so you just end up with a confusing "No instance for" message rather than an error message about levels This patch fixes both these issues. Firstly, `PendingRnSplice` differentiates between a user-written splice and an implicit lift. Then, the Lift instance is precisely requested with a specific origin in the typechecker. If the instance fails to be solved, the message is reported using the `TcRnBadlyLevelled` constructor (like a normal level error). Fixes #26031, #26035 - - - - - 44b8cee2 by Cheng Shao at 2025-06-18T15:34:46-04:00 testsuite: add T26120 marked as broken - - - - - 894a04f3 by Cheng Shao at 2025-06-18T15:34:46-04:00 compiler: fix GHC.SysTools.Ar archive member size writing logic This patch fixes a long-standing bug in `GHC.SysTools.Ar` that emits the wrong archive member size in each archive header. It should encode the exact length of the member payload, excluding any padding byte, otherwise malformed archive that extracts a broken object with an extra trailing byte could be created. Apart from the in-tree `T26120` test, I've also created an out-of-tree testsuite at https://github.com/TerrorJack/ghc-ar-quickcheck that contains QuickCheck roundtrip tests for `GHC.SysTools.Ar`. With this fix, simple roundtrip tests and `writeGNUAr`/GNU `ar` roundtrip test passes. There might be more bugs lurking in here, but this patch is still a critical bugfix already. Fixes #26120 #22586. Co-authored-by: Codex <codex(a)openai.com> - - - - - f677ab5f by Lauren Yim at 2025-06-18T15:35:37-04:00 fix some typos in the warnings page in the user guide - - - - - b968e1c1 by Rodrigo Mesquita at 2025-06-18T15:36:18-04:00 Add a frozen callstack to throwGhcException Fixes #25956 - - - - - a5e0c3a3 by fendor at 2025-06-18T15:36:59-04:00 Update using.rst to advertise full mhu support for GHCi - - - - - d3e60e97 by Ryan Scott at 2025-06-18T22:29:21-04:00 Deprecate -Wdata-kinds-tc, make DataKinds issues in typechecker become errors !11314 introduced the `-Wdata-kinds-tc` warning as part of a fix for #22141. This was a temporary stopgap measure to allow users who were accidentally relying on code which needed the `DataKinds` extension in order to typecheck without having to explicitly enable the extension. Now that some amount of time has passed, this patch deprecates `-Wdata-kinds-tc` and upgrades any `DataKinds`-related issues in the typechecker (which were previously warnings) into errors. - - - - - fd5b5177 by Ryan Hendrickson at 2025-06-18T22:30:06-04:00 haddock: Add redact-type-synonyms pragma `{-# OPTIONS_HADDOCK redact-type-synonyms #-}` pragma will hide the RHS of type synonyms, and display the result kind instead, if the RHS contains any unexported types. - - - - - fbc0b92a by Vladislav Zavialov at 2025-06-22T04:25:16+03:00 Visible forall in GADTs (#25127) Add support for visible dependent quantification `forall a -> t` in types of data constructors, e.g. data KindVal a where K :: forall k. forall (a::k) -> -- now allowed! k -> KindVal a For details, see docs/users_guide/exts/required_type_arguments.rst, which has gained a new subsection. DataCon in compiler/GHC/Core/DataCon.hs --------------------------------------- The main change in this patch is that DataCon, the Core representation of a data constructor, now uses a different type to store user-written type variable binders: - dcUserTyVarBinders :: [InvisTVBinder] + dcUserTyVarBinders :: [TyVarBinder] where type TyVarBinder = VarBndr TyVar ForAllTyFlag type InvisTVBinder = VarBndr TyVar Specificity and data Specificity = InferredSpec | SpecifiedSpec data ForAllTyFlag = Invisible Specificity | Required This change necessitates some boring, mechanical changes scattered throughout the diff: ... is now used in place of ... -----------------+--------------- TyVarBinder | InvisTVBinder IfaceForAllBndr | IfaceForAllSpecBndr Specified | SpecifiedSpec Inferred | InferredSpec mkForAllTys | mkInvisForAllTys additionally, tyVarSpecToBinders -- added or removed calls ifaceForAllSpecToBndrs -- removed calls Visibility casts in mkDataConRep -------------------------------- Type abstractions in Core (/\a. e) always have type (forall a. t) because coreTyLamForAllTyFlag = Specified. This is also true of data constructor workers. So we may be faced with the following: data con worker: (forall a. blah) data con wrapper: (forall a -> blah) In this case the wrapper must use a visibility cast (e |> ForAllCo ...) with appropriately set fco_vis{L,R}. Relevant functions: mkDataConRep in compiler/GHC/Types/Id/Make.hs dataConUserTyVarBindersNeedWrapper in compiler/GHC/Core/DataCon.hs mkForAllVisCos in compiler/GHC/Core/Coercion.hs mkCoreTyLams in compiler/GHC/Core/Make.hs mkWpForAllCast in compiler/GHC/Tc/Types/Evidence.hs More specifically: - dataConUserTyVarBindersNeedWrapper has been updated to answer "yes" if there are visible foralls in the type of the data constructor. - mkDataConRep now uses mkCoreTyLams to generate the big lambda abstractions (/\a b c. e) in the data con wrapper. - mkCoreTyLams is a variant of mkCoreLams that applies visibility casts as needed. It similar in purpose to the pre-existing mkWpForAllCast, so the common bits have been factored out into mkForAllVisCos. ConDecl in compiler/Language/Haskell/Syntax/Decls.hs ---------------------------------------------------- The surface syntax representation of a data constructor declaration is ConDecl. In accordance with the proposal, only GADT syntax is extended with support for visible forall, so we are interested in ConDeclGADT. ConDeclGADT's field con_bndrs has been renamed to con_outer_bndrs and is now accompanied by con_inner_bndrs: con_outer_bndrs :: XRec pass (HsOuterSigTyVarBndrs pass) con_inner_bndrs :: [HsForAllTelescope pass] Visible foralls always end up in con_inner_bndrs. The outer binders are stored and processed separately to support implicit quantification and the forall-or-nothing rule, a design established by HsSigType. A side effect of this change is that even in absence of visible foralls, GHC now permits multiple invisible foralls, e.g. data T a where { MkT :: forall a b. forall c d. ... -> T a } But of course, this is done in service of making at least some of these foralls visible. The entire compiler front-end has been updated to deal with con_inner_bndrs. See the following modified or added functions: Parser: mkGadtDecl in compiler/GHC/Parser/PostProcess.hs splitLHsGadtTy in compiler/GHC/Hs/Type.hs Pretty-printer: pprConDecl in compiler/GHC/Hs/Decls.hs pprHsForAllTelescope in compiler/GHC/Hs/Type.hs Renamer: rnConDecl in compiler/GHC/Rename/Module.hs bindHsForAllTelescopes in compiler/GHC/Rename/HsType.hs extractHsForAllTelescopes in compiler/GHC/Rename/HsType.hs Type checker: tcConDecl in compiler/GHC/Tc/TyCl.hs tcGadtConTyVarBndrs in compiler/GHC/Tc/Gen/HsType.hs Template Haskell ---------------- The TH AST is left unchanged for the moment to avoid breakage. An attempt to quote or reify a data constructor declaration with visible forall in its type will result an error: data ThRejectionReason -- in GHC/HsToCore/Errors/Types.hs = ... | ThDataConVisibleForall -- new error constructor However, as noted in the previous section, GHC now permits multiple invisible foralls, and TH was updated accordingly. Updated code: repC in compiler/GHC/HsToCore/Quote.hs reifyDataCon in compiler/GHC/Tc/Gen/Splice.hs ppr @Con in libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs Pattern matching ---------------- Everything described above concerns data constructor declarations, but what about their use sites? Now it is trickier to type check a pattern match fn(Con a b c)=... because we can no longer assume that a,b,c are all value arguments. Indeed, some or all of them may very well turn out to be required type arguments. To that end, see the changes to: tcDataConPat in compiler/GHC/Tc/Gen/Pat.hs splitConTyArgs in compiler/GHC/Tc/Gen/Pat.hs and the new helpers split_con_ty_args, zip_pats_bndrs. This is also the reason the TcRnTooManyTyArgsInConPattern error constructor has been removed. The new code emits TcRnArityMismatch or TcRnIllegalInvisibleTypePattern. Summary ------- DataCon, ConDecl, as well as all related functions have been updated to support required type arguments in data constructors. Test cases: HieGadtConSigs GadtConSigs_th_dump1 GadtConSigs_th_pprint1 T25127_data T25127_data_inst T25127_infix T25127_newtype T25127_fail_th_quote T25127_fail_arity TyAppPat_Tricky Co-authored-by: mniip <mniip(a)mniip.com> - - - - - ae003a3a by Teo Camarasu at 2025-06-23T05:21:48-04:00 linters: lint-whitespace: bump upper-bound for containers The version of containers was bumped in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/13989 - - - - - 0fb37893 by Matthew Pickering at 2025-06-23T13:55:10-04:00 Move ModuleGraph into UnitEnv The ModuleGraph is a piece of information associated with the ExternalPackageState and HomeUnitGraph. Therefore we should store it inside the HomeUnitEnv. - - - - - 3bf6720e by soulomoon at 2025-06-23T13:55:52-04:00 Remove hptAllFamInstances usage during upsweep Fixes #26118 This change eliminates the use of hptAllFamInstances during the upsweep phase, as it could access non-below modules from the home package table. The following updates were made: * Updated checkFamInstConsistency to accept an explicit ModuleEnv FamInstEnv parameter and removed the call to hptAllFamInstances. * Adjusted hugInstancesBelow so we can construct ModuleEnv FamInstEnv from its result, * hptAllFamInstances and allFamInstances functions are removed. - - - - - 83ee7b78 by Ben Gamari at 2025-06-24T05:02:07-04:00 configure: Don't force value of OTOOL, etc. if not present Previously if `otool` and `install_name_tool` were not present they would be overridden by `fp_settings.m4`. This logic was introduced in 4ff93292243888545da452ea4d4c1987f2343591 without explanation. - - - - - 9329c9e1 by Ben Gamari at 2025-06-24T05:02:07-04:00 ghc-toolchain: Add support for otool, install_name_tool Fixes part of ghc#23675. - - - - - 25f5c998 by Ben Gamari at 2025-06-24T05:02:08-04:00 ghc-toolchain: Add support for llc, opt, llvm-as Fixes #23675. - - - - - 51d150dd by Rodrigo Mesquita at 2025-06-24T05:02:08-04:00 hadrian: Use settings-use-distro-mingw directly The type `ToolchainSetting` only made sense when we had more settings to fetch from the system config file. Even then "settings-use-distro-mingw" is arguably not a toolchain setting. With the fix for #23675, all toolchain tools were moved to the `ghc-toolchain` `Toolchain` format. Therefore, we can inline `settings-use-distro-mingw` accesses and delete `ToolchainSetting`. - - - - - dcf68a83 by Rodrigo Mesquita at 2025-06-24T05:02:08-04:00 configure: Check LlvmTarget exists for LlvmAsFlags If LlvmTarget was empty, LlvmAsFlags would be just "--target=". If it is empty now, simply keep LlvmAsFlags empty. ghc-toolchain already does this right. This fix makes the two configurations match up. - - - - - 580a3353 by Ben Gamari at 2025-06-24T05:02:51-04:00 rts/linker/LoadArchive: Use bool Improve type precision by using `bool` instead of `int` and `StgBool`. - - - - - 76d1041d by Ben Gamari at 2025-06-24T05:02:51-04:00 rts/linker/LoadArchive: Don't rely on file extensions for identification Previously archive members would be identified via their file extension, as described in #13103. We now instead use a more principled approach, relying on the magic number in the member's header. As well, we refactor treatment of archive format detection to improve code clarity and error handling. Closes #13103. - - - - - 4b748a99 by Teo Camarasu at 2025-06-24T15:31:07-04:00 template-haskell: improve changelog stable -> more stable, just to clarify that this interface isn't fully stable. errornously -> mistakenly: I typod this and also let's go for a simpler word - - - - - e358e477 by Sylvain Henry at 2025-06-24T15:31:58-04:00 Bump stack resolver to use GHC 9.6.7 Cf #26139 - - - - - 4bf5eb63 by fendor at 2025-06-25T17:05:43-04:00 Teach `:reload` about multiple home units `:reload` needs to lookup the `ModuleName` and must not assume the given `ModuleName` is in the current `HomeUnit`. We add a new utility function which allows us to find a `HomeUnitModule` instead of a `Module`. Further, we introduce the `GhciCommandError` type which can be used to abort the execution of a GHCi command. This error is caught and printed in a human readable fashion. - - - - - b3d97bb3 by fendor at 2025-06-25T17:06:25-04:00 Implement `-fno-load-initial-targets` flag We add the new flag `-fno-load-initial-targets` which doesn't load all `Target`s immediately but only computes the module graph for all `Target`s. The user can then decide to load modules from that module graph using the syntax: ghci> :reload <Mod> This will load everything in the module graph up to `Mod`. The user can return to the initial state by using the builtin target `none` to unload all modules. ghci> :reload none Is in principle identical to starting a new session with the `-fno-load-initial-targets` flag. The `-fno-load-initial-targets` flag allows for faster startup time of GHCi when a user has lots of `Target`s. We additionally extend the `:reload` command to accept multiple `ModuleName`s. For example: ghci> :reload <Mod1> <Mod2> Loads all modules up to the modules `Mod1` and `Mod2`. - - - - - 49f44e52 by Teo Camarasu at 2025-06-26T04:19:51-04:00 Expose ghc-internal unit id through the settings file This in combination with the unit id of the compiler library allows cabal to know of the two unit ids that should not be reinstalled (in specific circumstances) as: - when using plugins, we want to link against exactly the compiler unit id - when using TemplateHaskell we want to link against exactly the package that contains the TemplateHaskell interfaces, which is `ghc-internal` See: <https://github.com/haskell/cabal/issues/10087> Resolves #25282 - - - - - 499c4efe by Bryan Richter at 2025-06-26T04:20:33-04:00 CI: Fix and clean up capture of timings * Fixes the typo that caused 'cat ci-timings' to report "no such file or directory" * Gave ci_timings.txt a file extension so it may play better with other systems * Fixed the use of time_it so all times are recorded * Fixed time_it to print name along with timing - - - - - 86c90c9e by Bryan Richter at 2025-06-26T04:20:33-04:00 CI: Update collapsible section usage The syntax apparently changed at some point. - - - - - 04308ee4 by Bryan Richter at 2025-06-26T04:20:33-04:00 CI: Add more collapsible sections - - - - - c660d84b by Matthew Pickering at 2025-07-03T10:43:44+01:00 ipe: Place strings and metadata into specific .ipe section By placing the .ipe metadata into a specific section it can be stripped from the final binary if desired. ``` objcopy --remove-section .ipe <binary> upx <binary> ``` Towards #21766 - - - - - 66e7f104 by Matthew Pickering at 2025-07-03T10:43:44+01:00 ipe: Place magic word at the start of entries in the .ipe section The magic word "IPE\nIPE\n" is placed at the start of .ipe sections, then if the section is stripped, we can check whether the section starts with the magic word or not to determine whether there is metadata present or not. Towards #21766 - - - - - fef9d970 by Matthew Pickering at 2025-07-03T10:43:44+01:00 ipe: Use stable IDs for IPE entries IPEs have historically been indexed and reported by their address. This makes it impossible to compare profiles between runs, since the addresses may change (due to ASLR) and also makes it tricky to separate out the IPE map from the binary. This small patch adds a stable identifier for each IPE entry. The stable identifier is a single 64 bit word. The high-bits are a per-module identifier and the low bits identify which entry in each module. 1. When a node is added into the IPE buffer it is assigned a unique identifier from an incrementing global counter. 2. Each entry already has an index by it's position in the `IpeBufferListNode`. The two are combined together by the `IPE_ENTRY_KEY` macro. Info table profiling uses the stable identifier rather than the address of the info table. The benefits of this change are: * Profiles from different runs can be easily compared * The metadata can be extracted from the binary (via the eventlog for example) and then stripped from the executable. Fixes #21766 - - - - - 252 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/common.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Cmm.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToLlvm/Data.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/PatSyn.hs - compiler/GHC/Core/TyCo/Ppr.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/SysTools/Ar.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/Var.hs-boot - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Home/Graph.hs - compiler/GHC/Unit/Home/PackageTable.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/GHC/Utils/Panic.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Pat.hs - compiler/Setup.hs - distrib/configure.ac.in - docs/users_guide/9.14.1-notes.rst - docs/users_guide/exts/gadt_syntax.rst - docs/users_guide/exts/required_type_arguments.rst - docs/users_guide/ghci.rst - docs/users_guide/using-warnings.rst - docs/users_guide/using.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Exception.hs - ghc/GHCi/UI/Print.hs - hadrian/cfg/default.host.target.in - hadrian/cfg/default.target.in - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/stack.yaml - hadrian/stack.yaml.lock - libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs - libraries/template-haskell/changelog.md - linters/lint-whitespace/lint-whitespace.cabal - m4/fp_settings.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - rts/IPE.c - rts/ProfHeap.c - rts/eventlog/EventLog.c - rts/include/rts/IPE.h - rts/include/stg/MachRegs.h - rts/linker/LoadArchive.c - testsuite/tests/annotations/should_fail/annfail03.stderr - testsuite/tests/annotations/should_fail/annfail09.stderr - testsuite/tests/dependent/should_fail/T16326_Fail6.stderr - + testsuite/tests/ghc-api/T26120.hs - + testsuite/tests/ghc-api/T26120.stdout - testsuite/tests/ghc-api/all.T - testsuite/tests/ghc-e/should_fail/T18441fail5.stderr - testsuite/tests/ghci/prog-mhu003/prog-mhu003.stderr - testsuite/tests/ghci/prog-mhu004/prog-mhu004a.stderr - + testsuite/tests/ghci/prog-mhu005/Makefile - + testsuite/tests/ghci/prog-mhu005/a/A.hs - + testsuite/tests/ghci/prog-mhu005/all.T - + testsuite/tests/ghci/prog-mhu005/b/B.hs - + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.script - + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stderr - + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stdout - + testsuite/tests/ghci/prog-mhu005/unitA - + testsuite/tests/ghci/prog-mhu005/unitB - + testsuite/tests/ghci/prog021/A.hs - + testsuite/tests/ghci/prog021/B.hs - + testsuite/tests/ghci/prog021/Makefile - + testsuite/tests/ghci/prog021/all.T - + testsuite/tests/ghci/prog021/prog021a.script - + testsuite/tests/ghci/prog021/prog021a.stderr - + testsuite/tests/ghci/prog021/prog021a.stdout - + testsuite/tests/ghci/prog021/prog021b.script - + testsuite/tests/ghci/prog021/prog021b.stderr - + testsuite/tests/ghci/prog021/prog021b.stdout - + testsuite/tests/ghci/prog022/A.hs - + testsuite/tests/ghci/prog022/B.hs - + testsuite/tests/ghci/prog022/Makefile - + testsuite/tests/ghci/prog022/all.T - + testsuite/tests/ghci/prog022/ghci.prog022a.script - + testsuite/tests/ghci/prog022/ghci.prog022a.stderr - + testsuite/tests/ghci/prog022/ghci.prog022a.stdout - + testsuite/tests/ghci/prog022/ghci.prog022b.script - + testsuite/tests/ghci/prog022/ghci.prog022b.stderr - + testsuite/tests/ghci/prog022/ghci.prog022b.stdout - testsuite/tests/ghci/scripts/ghci021.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - + testsuite/tests/hiefile/should_run/HieGadtConSigs.hs - + testsuite/tests/hiefile/should_run/HieGadtConSigs.stdout - testsuite/tests/hiefile/should_run/all.T - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/T15323.stderr - testsuite/tests/printer/T18791.stderr - testsuite/tests/quasiquotation/qq001/qq001.stderr - testsuite/tests/quasiquotation/qq002/qq002.stderr - testsuite/tests/quasiquotation/qq003/qq003.stderr - testsuite/tests/quasiquotation/qq004/qq004.stderr - + testsuite/tests/quotes/LiftErrMsg.hs - + testsuite/tests/quotes/LiftErrMsg.stderr - + testsuite/tests/quotes/LiftErrMsgDefer.hs - + testsuite/tests/quotes/LiftErrMsgDefer.stderr - + testsuite/tests/quotes/LiftErrMsgTyped.hs - + testsuite/tests/quotes/LiftErrMsgTyped.stderr - testsuite/tests/quotes/T10384.stderr - testsuite/tests/quotes/TH_localname.stderr - testsuite/tests/quotes/all.T - testsuite/tests/rts/ipe/ipeMap.c - testsuite/tests/rts/ipe/ipe_lib.c - testsuite/tests/splice-imports/SI03.stderr - testsuite/tests/splice-imports/SI05.stderr - testsuite/tests/splice-imports/SI16.stderr - testsuite/tests/splice-imports/SI18.stderr - testsuite/tests/splice-imports/SI20.stderr - testsuite/tests/splice-imports/SI25.stderr - testsuite/tests/splice-imports/SI28.stderr - testsuite/tests/splice-imports/SI31.stderr - + testsuite/tests/th/GadtConSigs_th_dump1.hs - + testsuite/tests/th/GadtConSigs_th_dump1.stderr - + testsuite/tests/th/GadtConSigs_th_pprint1.hs - + testsuite/tests/th/GadtConSigs_th_pprint1.stderr - testsuite/tests/th/T16976z.stderr - testsuite/tests/th/T17820a.stderr - testsuite/tests/th/T17820b.stderr - testsuite/tests/th/T17820c.stderr - testsuite/tests/th/T17820d.stderr - testsuite/tests/th/T17820e.stderr - testsuite/tests/th/T20868.stdout - testsuite/tests/th/T23829_hasty.stderr - testsuite/tests/th/T23829_hasty_b.stderr - testsuite/tests/th/T5795.stderr - testsuite/tests/th/all.T - + testsuite/tests/typecheck/should_compile/T20873c.hs - − testsuite/tests/typecheck/should_compile/T22141a.stderr - − testsuite/tests/typecheck/should_compile/T22141b.stderr - − testsuite/tests/typecheck/should_compile/T22141c.stderr - − testsuite/tests/typecheck/should_compile/T22141d.stderr - − testsuite/tests/typecheck/should_compile/T22141e.stderr - testsuite/tests/typecheck/should_compile/T23739a.hs - + testsuite/tests/typecheck/should_compile/TyAppPat_Tricky.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T20443b.stderr - − testsuite/tests/typecheck/should_fail/T20873c.hs - − testsuite/tests/typecheck/should_fail/T20873c.stderr - testsuite/tests/typecheck/should_compile/T22141a.hs → testsuite/tests/typecheck/should_fail/T22141a.hs - testsuite/tests/typecheck/should_fail/T22141a.stderr - testsuite/tests/typecheck/should_compile/T22141b.hs → testsuite/tests/typecheck/should_fail/T22141b.hs - testsuite/tests/typecheck/should_fail/T22141b.stderr - testsuite/tests/typecheck/should_compile/T22141c.hs → testsuite/tests/typecheck/should_fail/T22141c.hs - testsuite/tests/typecheck/should_fail/T22141c.stderr - testsuite/tests/typecheck/should_compile/T22141d.hs → testsuite/tests/typecheck/should_fail/T22141d.hs - testsuite/tests/typecheck/should_fail/T22141d.stderr - testsuite/tests/typecheck/should_compile/T22141e.hs → testsuite/tests/typecheck/should_fail/T22141e.hs - testsuite/tests/typecheck/should_fail/T22141e.stderr - testsuite/tests/typecheck/should_compile/T22141e_Aux.hs → testsuite/tests/typecheck/should_fail/T22141e_Aux.hs - testsuite/tests/typecheck/should_fail/TyAppPat_TooMany.stderr - testsuite/tests/typecheck/should_fail/all.T - + testsuite/tests/vdq-rta/should_compile/T25127_data.hs - + testsuite/tests/vdq-rta/should_compile/T25127_data_inst.hs - + testsuite/tests/vdq-rta/should_compile/T25127_infix.hs - + testsuite/tests/vdq-rta/should_compile/T25127_newtype.hs - testsuite/tests/vdq-rta/should_compile/all.T - testsuite/tests/vdq-rta/should_fail/T23739_fail_case.hs - testsuite/tests/vdq-rta/should_fail/T23739_fail_case.stderr - testsuite/tests/vdq-rta/should_fail/T24159_type_syntax_th_fail.script - + testsuite/tests/vdq-rta/should_fail/T25127_fail_arity.hs - + testsuite/tests/vdq-rta/should_fail/T25127_fail_arity.stderr - + testsuite/tests/vdq-rta/should_fail/T25127_fail_th_quote.hs - + testsuite/tests/vdq-rta/should_fail/T25127_fail_th_quote.stderr - testsuite/tests/vdq-rta/should_fail/all.T - utils/check-exact/ExactPrint.hs - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/haddock/CHANGES.md - utils/haddock/doc/cheatsheet/haddocks.md - utils/haddock/doc/markup.rst - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs - utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs - utils/haddock/haddock-api/src/Haddock/Interface.hs - utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs - utils/haddock/haddock-api/src/Haddock/Interface/Create.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs - utils/haddock/haddock-api/src/Haddock/Types.hs - + utils/haddock/html-test/ref/RedactTypeSynonyms.html - + utils/haddock/html-test/src/RedactTypeSynonyms.hs - + utils/haddock/latex-test/ref/RedactTypeSynonyms/RedactTypeSynonyms.tex - + utils/haddock/latex-test/src/RedactTypeSynonyms/RedactTypeSynonyms.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d4ce6f7aaf2cf8ac431a77c4151d9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3d4ce6f7aaf2cf8ac431a77c4151d9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/step-out-9] ghci: Allocate BreakArrays at link time only
by Rodrigo Mesquita (＠alt-romes) 03 Jul '25

03 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/step-out-9 at Glasgow Haskell Compiler / GHC Commits: af76b3d2 by Rodrigo Mesquita at 2025-07-03T10:32:38+01:00 ghci: Allocate BreakArrays at link time only Previously, a BreakArray would be allocated with a slot for every tick in a module at `mkModBreaks`, in HsToCore. However, this approach has a few downsides: - It interleaves interpreter behaviour (allocating arrays for breakpoints) within the desugarer - It is inflexible in the sense it is impossible for the bytecode generator to add "internal" breakpoints that can be triggered at runtime, because those wouldn't have a source tick. (This is relevant for our intended implementation plan of step-out in #26042) - It ties the BreakArray indices to the *tick* indexes, while at runtime we would rather just have the *info* indexes (currently we have both because BreakArrays are indexed by the *tick* one). Paving the way for #26042 and #26064, this commit moves the allocation of BreakArrays to bytecode-loading time -- akin to what is done for CCS arrays. Since a BreakArray is allocated only when bytecode is linked, if a breakpoint is set (e.g. `:break 10`) before the bytecode is linked, there will exist no BreakArray to trigger the breakpoint in. Therefore, the function to allocate break arrays (`allocateBreakArrays`) is exposed and also used in GHC.Runtime.Eval to allocate a break array when a breakpoint is set, if it doesn't exist yet (in the linker env). - - - - - 10 changed files: - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Linker/Types.hs - compiler/GHC/Runtime/Eval.hs - − compiler/GHC/Runtime/Interpreter.hs-boot - − compiler/GHC/Runtime/Interpreter/Types.hs-boot - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== compiler/GHC/ByteCode/Linker.hs ===================================== @@ -58,15 +58,16 @@ linkBCO :: Interp -> PkgsLoaded -> LinkerEnv + -> LinkedBreaks -> NameEnv Int -> UnlinkedBCO -> IO ResolvedBCO -linkBCO interp pkgs_loaded le bco_ix +linkBCO interp pkgs_loaded le lb bco_ix (UnlinkedBCO _ arity insns bitmap lits0 ptrs0) = do -- fromIntegral Word -> Word64 should be a no op if Word is Word64 -- otherwise it will result in a cast to longlong on 32bit systems. - (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le) (elemsFlatBag lits0) - ptrs <- mapM (resolvePtr interp pkgs_loaded le bco_ix) (elemsFlatBag ptrs0) + (lits :: [Word]) <- mapM (fmap fromIntegral . lookupLiteral interp pkgs_loaded le lb) (elemsFlatBag lits0) + ptrs <- mapM (resolvePtr interp pkgs_loaded le lb bco_ix) (elemsFlatBag ptrs0) let lits' = listArray (0 :: Int, fromIntegral (sizeFlatBag lits0)-1) lits return $ ResolvedBCO { resolvedBCOIsLE = isLittleEndian , resolvedBCOArity = arity @@ -76,8 +77,8 @@ linkBCO interp pkgs_loaded le bco_ix , resolvedBCOPtrs = addListToSS emptySS ptrs } -lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> BCONPtr -> IO Word -lookupLiteral interp pkgs_loaded le ptr = case ptr of +lookupLiteral :: Interp -> PkgsLoaded -> LinkerEnv -> LinkedBreaks -> BCONPtr -> IO Word +lookupLiteral interp pkgs_loaded le lb ptr = case ptr of BCONPtrWord lit -> return lit BCONPtrLbl sym -> do Ptr a# <- lookupStaticPtr interp sym @@ -99,7 +100,7 @@ lookupLiteral interp pkgs_loaded le ptr = case ptr of pure $ fromIntegral p BCONPtrCostCentre BreakpointId{..} | interpreterProfiled interp -> do - case expectJust (lookupModuleEnv (ccs_env le) bi_tick_mod) ! bi_tick_index of + case expectJust (lookupModuleEnv (ccs_env lb) bi_tick_mod) ! bi_tick_index of RemotePtr p -> pure $ fromIntegral p | otherwise -> case toRemotePtr nullPtr of @@ -158,10 +159,11 @@ resolvePtr :: Interp -> PkgsLoaded -> LinkerEnv + -> LinkedBreaks -> NameEnv Int -> BCOPtr -> IO ResolvedBCOPtr -resolvePtr interp pkgs_loaded le bco_ix ptr = case ptr of +resolvePtr interp pkgs_loaded le lb bco_ix ptr = case ptr of BCOPtrName nm | Just ix <- lookupNameEnv bco_ix nm -> return (ResolvedBCORef ix) -- ref to another BCO in this group @@ -182,10 +184,10 @@ resolvePtr interp pkgs_loaded le bco_ix ptr = case ptr of -> ResolvedBCOStaticPtr <$> lookupPrimOp interp pkgs_loaded op BCOPtrBCO bco - -> ResolvedBCOPtrBCO <$> linkBCO interp pkgs_loaded le bco_ix bco + -> ResolvedBCOPtrBCO <$> linkBCO interp pkgs_loaded le lb bco_ix bco BCOPtrBreakArray tick_mod -> - withForeignRef (expectJust (lookupModuleEnv (breakarray_env le) tick_mod)) $ + withForeignRef (expectJust (lookupModuleEnv (breakarray_env lb) tick_mod)) $ \ba -> pure $ ResolvedBCOPtrBreakArray ba -- | Look up the address of a Haskell symbol in the currently ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -97,8 +97,8 @@ import GHC.Unit.Module.Deps import Data.List (partition) import Data.IORef -import Data.Traversable (for) import GHC.Iface.Make (mkRecompUsageInfo) +import GHC.Runtime.Interpreter (interpreterProfiled) {- ************************************************************************ @@ -162,13 +162,12 @@ deSugar hsc_env mod mod_loc export_set (typeEnvTyCons type_env) binds else return (binds, Nothing) - ; modBreaks <- for - [ (i, s) - | i <- hsc_interp hsc_env - , (_, s) <- m_tickInfo - , breakpointsAllowed dflags - ] - $ \(interp, specs) -> mkModBreaks interp mod specs + ; let modBreaks + | Just (_, specs) <- m_tickInfo + , breakpointsAllowed dflags + = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod specs + | otherwise + = Nothing ; ds_hpc_info <- case m_tickInfo of Just (orig_file2, ticks) ===================================== compiler/GHC/HsToCore/Breakpoints.hs ===================================== @@ -33,14 +33,6 @@ import GHC.Unit.Module (Module) import GHC.Utils.Outputable import Data.List (intersperse) -import GHCi.BreakArray (BreakArray) -import GHCi.RemoteTypes (ForeignRef) - --- TODO: Break this cycle -import {-# SOURCE #-} GHC.Runtime.Interpreter.Types (Interp, interpreterProfiled) -import {-# SOURCE #-} qualified GHC.Runtime.Interpreter as GHCi (newBreakArray) -import Data.Array.Base (numElements) - -------------------------------------------------------------------------------- -- ModBreaks -------------------------------------------------------------------------------- @@ -58,10 +50,7 @@ import Data.Array.Base (numElements) -- and 'modBreaks_decls'. data ModBreaks = ModBreaks - { modBreaks_flags :: ForeignRef BreakArray - -- ^ The array of flags, one per breakpoint, - -- indicating which breakpoints are enabled. - , modBreaks_locs :: !(Array BreakTickIndex SrcSpan) + { modBreaks_locs :: !(Array BreakTickIndex SrcSpan) -- ^ An array giving the source span of each breakpoint. , modBreaks_vars :: !(Array BreakTickIndex [OccName]) -- ^ An array giving the names of the free variables at each breakpoint. @@ -83,40 +72,31 @@ data ModBreaks -- generator needs to encode this information for each expression, the data is -- allocated remotely in GHCi's address space and passed to the codegen as -- foreign pointers. -mkModBreaks :: Interp -> Module -> SizedSeq Tick -> IO ModBreaks -mkModBreaks interp mod extendedMixEntries - = do - let count = fromIntegral $ sizeSS extendedMixEntries +mkModBreaks :: Bool {-^ Whether the interpreter is profiled and thus if we should include store a CCS array -} + -> Module -> SizedSeq Tick -> ModBreaks +mkModBreaks interpreterProfiled modl extendedMixEntries + = let count = fromIntegral $ sizeSS extendedMixEntries entries = ssElts extendedMixEntries - let - locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ] - varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ] - declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ] - ccs - | interpreterProfiled interp = - listArray - (0, count - 1) - [ ( concat $ intersperse "." $ tick_path t, - renderWithContext defaultSDocContext $ ppr $ tick_loc t - ) - | t <- entries - ] - | otherwise = listArray (0, -1) [] - hydrateModBreaks interp $ - ModBreaks - { modBreaks_flags = undefined, - modBreaks_locs = locsTicks, - modBreaks_vars = varsTicks, - modBreaks_decls = declsTicks, - modBreaks_ccs = ccs, - modBreaks_module = mod - } - -hydrateModBreaks :: Interp -> ModBreaks -> IO ModBreaks -hydrateModBreaks interp ModBreaks {..} = do - let count = numElements modBreaks_locs - modBreaks_flags <- GHCi.newBreakArray interp count - pure ModBreaks {..} + locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ] + varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ] + declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ] + ccs + | interpreterProfiled = + listArray + (0, count - 1) + [ ( concat $ intersperse "." $ tick_path t, + renderWithContext defaultSDocContext $ ppr $ tick_loc t + ) + | t <- entries + ] + | otherwise = listArray (0, -1) [] + in ModBreaks + { modBreaks_locs = locsTicks + , modBreaks_vars = varsTicks + , modBreaks_decls = declsTicks + , modBreaks_ccs = ccs + , modBreaks_module = modl + } {- Note [Field modBreaks_decls] ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -28,6 +28,7 @@ module GHC.Linker.Loader , extendLoadedEnv , deleteFromLoadedEnv -- * Internals + , allocateBreakArrays , rmDupLinkables , modifyLoaderState , initLinkDepsOpts @@ -122,8 +123,8 @@ import System.Win32.Info (getSystemDirectory) import GHC.Utils.Exception import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey) import GHC.Driver.Downsweep - - +import qualified GHC.Runtime.Interpreter as GHCi +import Data.Array.Base (numElements) -- Note [Linkers and loaders] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -177,13 +178,15 @@ emptyLoaderState = LoaderState { closure_env = emptyNameEnv , itbl_env = emptyNameEnv , addr_env = emptyNameEnv - , breakarray_env = emptyModuleEnv - , ccs_env = emptyModuleEnv } , pkgs_loaded = init_pkgs , bcos_loaded = emptyModuleEnv , objs_loaded = emptyModuleEnv , temp_sos = [] + , linked_breaks = LinkedBreaks + { breakarray_env = emptyModuleEnv + , ccs_env = emptyModuleEnv + } } -- Packages that don't need loading, because the compiler -- shares them with the interpreted program. @@ -694,28 +697,22 @@ loadDecls interp hsc_env span linkable = do else do -- Link the expression itself let le = linker_env pls + let lb = linked_breaks pls le2_itbl_env <- linkITbls interp (itbl_env le) (concat $ map bc_itbls cbcs) le2_addr_env <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le) cbcs - le2_breakarray_env <- - allocateBreakArrays - interp - (catMaybes $ map bc_breaks cbcs) - (breakarray_env le) - le2_ccs_env <- - allocateCCS - interp - (catMaybes $ map bc_breaks cbcs) - (ccs_env le) + le2_breakarray_env <- allocateBreakArrays interp (breakarray_env lb) (catMaybes $ map bc_breaks cbcs) + le2_ccs_env <- allocateCCS interp (ccs_env lb) (catMaybes $ map bc_breaks cbcs) let le2 = le { itbl_env = le2_itbl_env - , addr_env = le2_addr_env - , breakarray_env = le2_breakarray_env + , addr_env = le2_addr_env } + let lb2 = lb { breakarray_env = le2_breakarray_env , ccs_env = le2_ccs_env } -- Link the necessary packages and linkables - new_bindings <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs + new_bindings <- linkSomeBCOs interp (pkgs_loaded pls) le2 lb2 cbcs nms_fhvs <- makeForeignNamedHValueRefs interp new_bindings let ce2 = extendClosureEnv (closure_env le2) nms_fhvs - !pls2 = pls { linker_env = le2 { closure_env = ce2 } } + !pls2 = pls { linker_env = le2 { closure_env = ce2 } + , linked_breaks = lb2 } return (pls2, (nms_fhvs, links_needed, units_needed)) where cbcs = linkableBCOs linkable @@ -931,17 +928,15 @@ dynLinkBCOs interp pls bcos = do le1 = linker_env pls + lb1 = linked_breaks pls ie2 <- linkITbls interp (itbl_env le1) (concatMap bc_itbls cbcs) ae2 <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le1) cbcs - be2 <- - allocateBreakArrays - interp - (catMaybes $ map bc_breaks cbcs) - (breakarray_env le1) - ce2 <- allocateCCS interp (catMaybes $ map bc_breaks cbcs) (ccs_env le1) - let le2 = le1 { itbl_env = ie2, addr_env = ae2, breakarray_env = be2, ccs_env = ce2 } + be2 <- allocateBreakArrays interp (breakarray_env lb1) (catMaybes $ map bc_breaks cbcs) + ce2 <- allocateCCS interp (ccs_env lb1) (catMaybes $ map bc_breaks cbcs) + let le2 = le1 { itbl_env = ie2, addr_env = ae2 } + let lb2 = lb1 { breakarray_env = be2, ccs_env = ce2 } - names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs + names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 lb2 cbcs -- We only want to add the external ones to the ClosureEnv let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs @@ -958,13 +953,14 @@ dynLinkBCOs interp pls bcos = do linkSomeBCOs :: Interp -> PkgsLoaded -> LinkerEnv + -> LinkedBreaks -> [CompiledByteCode] -> IO [(Name,HValueRef)] -- The returned HValueRefs are associated 1-1 with -- the incoming unlinked BCOs. Each gives the -- value of the corresponding unlinked BCO -linkSomeBCOs interp pkgs_loaded le mods = foldr fun do_link mods [] +linkSomeBCOs interp pkgs_loaded le lb mods = foldr fun do_link mods [] where fun CompiledByteCode{..} inner accum = inner (Foldable.toList bc_bcos : accum) @@ -974,7 +970,7 @@ linkSomeBCOs interp pkgs_loaded le mods = foldr fun do_link mods [] let flat = [ bco | bcos <- mods, bco <- bcos ] names = map unlinkedBCOName flat bco_ix = mkNameEnv (zip names [0..]) - resolved <- sequence [ linkBCO interp pkgs_loaded le bco_ix bco | bco <- flat ] + resolved <- sequence [ linkBCO interp pkgs_loaded le lb bco_ix bco | bco <- flat ] hvrefs <- createBCOs interp resolved return (zip names hvrefs) @@ -1072,9 +1068,13 @@ unload_wkr interp keep_linkables pls@LoaderState{..} = do keep_name n = isExternalName n && nameModule n `elemModuleEnv` remaining_bcos_loaded - !new_pls = pls { linker_env = filterLinkerEnv keep_name linker_env, - bcos_loaded = remaining_bcos_loaded, - objs_loaded = remaining_objs_loaded } + keep_mod :: Module -> Bool + keep_mod m = m `elemModuleEnv` remaining_bcos_loaded + + !new_pls = pls { linker_env = filterLinkerEnv keep_name linker_env, + linked_breaks = filterLinkedBreaks keep_mod linked_breaks, + bcos_loaded = remaining_bcos_loaded, + objs_loaded = remaining_objs_loaded } return new_pls where @@ -1656,30 +1656,34 @@ allocateTopStrings interp topStrings prev_env = do where mk_entry nm ptr = (nm, (nm, AddrPtr ptr)) --- | Given a list of 'ModBreaks' collected from a list of --- 'CompiledByteCode', allocate the 'BreakArray'. +-- | Given a list of 'InternalModBreaks' collected from a list of +-- 'CompiledByteCode', allocate the 'BreakArray' used to trigger breakpoints. allocateBreakArrays :: Interp -> - [InternalModBreaks] -> ModuleEnv (ForeignRef BreakArray) -> + [InternalModBreaks] -> IO (ModuleEnv (ForeignRef BreakArray)) -allocateBreakArrays _interp mbs be = +allocateBreakArrays interp = foldlM - ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> - evaluate $ extendModuleEnv be0 modBreaks_module modBreaks_flags + ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do + -- If no BreakArray is assigned to this module yet, create one + if not $ elemModuleEnv modBreaks_module be0 then do + let count = numElements modBreaks_locs + breakArray <- GHCi.newBreakArray interp count + evaluate $ extendModuleEnv be0 modBreaks_module breakArray + else + return be0 ) - be - mbs --- | Given a list of 'ModBreaks' collected from a list of --- 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling --- is enabled. +-- | Given a list of 'InternalModBreaks' collected from a list +-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is +-- enabled. allocateCCS :: Interp -> - [InternalModBreaks] -> ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) -> + [InternalModBreaks] -> IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) -allocateCCS interp mbs ce +allocateCCS interp ce mbss | interpreterProfiled interp = foldlM ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do @@ -1688,12 +1692,15 @@ allocateCCS interp mbs ce interp (moduleNameString $ moduleName modBreaks_module) (elems modBreaks_ccs) - evaluate $ - extendModuleEnv ce0 modBreaks_module $ - listArray - (0, length ccs - 1) - ccs + if not $ elemModuleEnv modBreaks_module ce0 then do + evaluate $ + extendModuleEnv ce0 modBreaks_module $ + listArray + (0, length ccs - 1) + ccs + else + return ce0 ) ce - mbs + mbss | otherwise = pure ce ===================================== compiler/GHC/Linker/Types.hs ===================================== @@ -18,6 +18,8 @@ module GHC.Linker.Types , ClosureEnv , emptyClosureEnv , extendClosureEnv + , LinkedBreaks(..) + , filterLinkedBreaks , LinkableSet , mkLinkableSet , unionLinkableSet @@ -159,6 +161,9 @@ data LoaderState = LoaderState , temp_sos :: ![(FilePath, String)] -- ^ We need to remember the name of previous temporary DLL/.so -- libraries so we can link them (see #10322) + + , linked_breaks :: !LinkedBreaks + -- ^ Mapping from loaded modules to their breakpoint arrays } uninitializedLoader :: IO Loader @@ -184,20 +189,13 @@ data LinkerEnv = LinkerEnv , addr_env :: !AddrEnv -- ^ Like 'closure_env' and 'itbl_env', but for top-level 'Addr#' literals, -- see Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode. - - , breakarray_env :: !(ModuleEnv (ForeignRef BreakArray)) - -- ^ Each 'Module's remote pointer of 'BreakArray'. - - , ccs_env :: !(ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) - -- ^ Each 'Module's array of remote pointers of 'CostCentre'. - -- Untouched when not profiling. } filterLinkerEnv :: (Name -> Bool) -> LinkerEnv -> LinkerEnv -filterLinkerEnv f le = le - { closure_env = filterNameEnv (f . fst) (closure_env le) - , itbl_env = filterNameEnv (f . fst) (itbl_env le) - , addr_env = filterNameEnv (f . fst) (addr_env le) +filterLinkerEnv f (LinkerEnv closure_e itbl_e addr_e) = LinkerEnv + { closure_env = filterNameEnv (f . fst) closure_e + , itbl_env = filterNameEnv (f . fst) itbl_e + , addr_env = filterNameEnv (f . fst) addr_e } type ClosureEnv = NameEnv (Name, ForeignHValue) @@ -209,6 +207,29 @@ extendClosureEnv :: ClosureEnv -> [(Name,ForeignHValue)] -> ClosureEnv extendClosureEnv cl_env pairs = extendNameEnvList cl_env [ (n, (n,v)) | (n,v) <- pairs] +-- | 'BreakArray's and CCSs are allocated per-module at link-time. +-- +-- Specifically, a module's 'BreakArray' is allocated either: +-- - When a BCO for that module is linked +-- - When :break is used on a given module *before* the BCO has been linked. +-- +-- We keep this structure in the 'LoaderState' +data LinkedBreaks + = LinkedBreaks + { breakarray_env :: !(ModuleEnv (ForeignRef BreakArray)) + -- ^ Each 'Module's remote pointer of 'BreakArray'. + + , ccs_env :: !(ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) + -- ^ Each 'Module's array of remote pointers of 'CostCentre'. + -- Untouched when not profiling. + } + +filterLinkedBreaks :: (Module -> Bool) -> LinkedBreaks -> LinkedBreaks +filterLinkedBreaks f (LinkedBreaks ba_e ccs_e) = LinkedBreaks + { breakarray_env = filterModuleEnv (\m _ -> f m) ba_e + , ccs_env = filterModuleEnv (\m _ -> f m) ccs_e + } + type PkgsLoaded = UniqDFM UnitId LoadedPkgInfo data LoadedPkgInfo ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -64,6 +64,7 @@ import GHCi.RemoteTypes import GHC.ByteCode.Types import GHC.Linker.Loader as Loader +import GHC.Linker.Types (LinkedBreaks (..)) import GHC.Hs @@ -126,6 +127,7 @@ import GHC.Tc.Utils.Instantiate (instDFunType) import GHC.Tc.Utils.Monad import GHC.IfaceToCore +import GHC.ByteCode.Breakpoints import Control.Monad import Data.Dynamic @@ -134,7 +136,7 @@ import Data.List (find,intercalate) import Data.List.NonEmpty (NonEmpty) import Unsafe.Coerce ( unsafeCoerce ) import qualified GHC.Unit.Home.Graph as HUG -import GHC.ByteCode.Breakpoints +import GHCi.BreakArray (BreakArray) -- ----------------------------------------------------------------------------- -- running a statement interactively @@ -348,13 +350,14 @@ handleRunStatus step expr bindings final_ids status history0 = do EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do let ibi = evalBreakpointToId eval_break let hug = hsc_HUG hsc_env - tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi) + tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi) + breakArray <- getBreakArray interp (toBreakpointId ibi) tick_brks let span = getBreakLoc ibi tick_brks decl = intercalate "." $ getBreakDecls ibi tick_brks -- Was this breakpoint explicitly enabled (ie. in @BreakArray@)? - bactive <- liftIO $ breakpointStatus interp (modBreaks_flags $ imodBreaks_modBreaks tick_brks) (ibi_tick_index ibi) + bactive <- liftIO $ breakpointStatus interp breakArray (ibi_tick_index ibi) apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt @@ -462,9 +465,24 @@ setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m () -- #191 setupBreakpoint interp bi cnt = do hug <- hsc_HUG <$> getSession modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi) - let breakarray = modBreaks_flags $ imodBreaks_modBreaks modBreaks - _ <- liftIO $ GHCi.storeBreakpoint interp breakarray (bi_tick_index bi) cnt - pure () + breakArray <- getBreakArray interp bi modBreaks + liftIO $ GHCi.storeBreakpoint interp breakArray (bi_tick_index bi) cnt + +getBreakArray :: GhcMonad m => Interp -> BreakpointId -> InternalModBreaks -> m (ForeignRef BreakArray) +getBreakArray interp BreakpointId{bi_tick_mod} imbs = do + + liftIO $ modifyLoaderState interp $ \ld_st -> do + let lb = linked_breaks ld_st + + -- Recall that BreakArrays are allocated only at BCO link time, so if we + -- haven't linked the BCOs we intend to break at yet, we allocate the arrays here. + ba_env <- allocateBreakArrays interp (breakarray_env lb) [imbs] + + return + ( ld_st { linked_breaks = lb{breakarray_env = ba_env} } + , expectJust {- just computed -} $ + lookupModuleEnv ba_env bi_tick_mod + ) back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan) back n = moveHist (+n) ===================================== compiler/GHC/Runtime/Interpreter.hs-boot deleted ===================================== @@ -1,10 +0,0 @@ -module GHC.Runtime.Interpreter where - -import {-# SOURCE #-} GHC.Runtime.Interpreter.Types -import Data.Int (Int) -import GHC.Base (IO) -import GHCi.BreakArray (BreakArray) -import GHCi.RemoteTypes (ForeignRef) - -newBreakArray :: Interp -> Int -> IO (ForeignRef BreakArray) - ===================================== compiler/GHC/Runtime/Interpreter/Types.hs-boot deleted ===================================== @@ -1,6 +0,0 @@ -module GHC.Runtime.Interpreter.Types where - -import Data.Bool - -data Interp -interpreterProfiled :: Interp -> Bool ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -5,6 +5,7 @@ GHC.Builtin.Types GHC.Builtin.Types.Literals GHC.Builtin.Types.Prim GHC.Builtin.Uniques +GHC.ByteCode.Breakpoints GHC.ByteCode.Types GHC.Cmm.BlockId GHC.Cmm.CLabel @@ -110,6 +111,8 @@ GHC.Hs.Pat GHC.Hs.Specificity GHC.Hs.Type GHC.Hs.Utils +GHC.HsToCore.Breakpoints +GHC.HsToCore.Ticks GHC.Iface.Errors.Types GHC.Iface.Ext.Fields GHC.Iface.Flags @@ -150,7 +153,6 @@ GHC.Tc.Zonk.Monad GHC.Types.Annotations GHC.Types.Avail GHC.Types.Basic -GHC.Types.Breakpoint GHC.Types.CostCentre GHC.Types.CostCentre.State GHC.Types.Cpr ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -5,6 +5,7 @@ GHC.Builtin.Types GHC.Builtin.Types.Literals GHC.Builtin.Types.Prim GHC.Builtin.Uniques +GHC.ByteCode.Breakpoints GHC.ByteCode.Types GHC.Cmm.BlockId GHC.Cmm.CLabel @@ -114,8 +115,10 @@ GHC.Hs.Pat GHC.Hs.Specificity GHC.Hs.Type GHC.Hs.Utils +GHC.HsToCore.Breakpoints GHC.HsToCore.Errors.Types GHC.HsToCore.Pmc.Solver.Types +GHC.HsToCore.Ticks GHC.Iface.Errors.Types GHC.Iface.Ext.Fields GHC.Iface.Flags @@ -171,7 +174,6 @@ GHC.Tc.Zonk.Monad GHC.Types.Annotations GHC.Types.Avail GHC.Types.Basic -GHC.Types.Breakpoint GHC.Types.CompleteMatch GHC.Types.CostCentre GHC.Types.CostCentre.State View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/af76b3d2fc321983df7be559ad5cca3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/af76b3d2fc321983df7be559ad5cca3… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/spj-apporv-Oct24] 2 commits: fix unused do binding warning error location
by Apoorv Ingle (＠ani) 02 Jul '25

02 Jul '25

Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: bde2465e by Apoorv Ingle at 2025-07-02T16:02:03-05:00 fix unused do binding warning error location - - - - - e199446b by Apoorv Ingle at 2025-07-02T16:11:44-05:00 FRRRecordUpdate message change - - - - - 3 changed files: - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Types/Origin.hs - testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr Changes: ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -1234,8 +1234,8 @@ Other places that requires from the same treatment: -- Warn about certain types of values discarded in monadic bindings (#3263) warnDiscardedDoBindings :: LHsExpr GhcTc -> Type -> Type -> DsM () -warnDiscardedDoBindings rhs m_ty elt_ty - = do { warn_unused <- woptM Opt_WarnUnusedDoBind +warnDiscardedDoBindings rhs@(L rhs_loc _) m_ty elt_ty + = putSrcSpanDsA rhs_loc $ do { warn_unused <- woptM Opt_WarnUnusedDoBind ; warn_wrong <- woptM Opt_WarnWrongDoBind ; when (warn_unused || warn_wrong) $ do { fam_inst_envs <- dsGetFamInstEnvs ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -1229,11 +1229,10 @@ mkFRRUnboxedSum = FRRUnboxedSum -- and is reported separately. pprFixedRuntimeRepContext :: FixedRuntimeRepContext -> SDoc pprFixedRuntimeRepContext (FRRRecordCon lbl _arg) - = sep [ text "The field", quotes (ppr lbl) + = sep [ text "The field", quotes (ppr lbl) -- TODO ANI: Where does this get used? Add missing test? , text "of the record constructor" ] -pprFixedRuntimeRepContext (FRRRecordUpdate lbl _arg) - = sep [ text "The record update at field" - , quotes (ppr lbl) ] +pprFixedRuntimeRepContext (FRRRecordUpdate lbl _) + = sep [ text "The field", quotes (ppr lbl) ] pprFixedRuntimeRepContext (FRRBinder binder) = sep [ text "The binder" , quotes (ppr binder) ] ===================================== testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr ===================================== @@ -13,8 +13,7 @@ RepPolyRecordUpdate.hs:7:35: error: [GHC-55287] X a :: TYPE rep RepPolyRecordUpdate.hs:13:9: error: [GHC-55287] - • The argument ‘fld’ of ‘MkX’ - does not have a fixed runtime representation. + • The field ‘fld’ does not have a fixed runtime representation. Its type is: a0 :: TYPE rep0 When unifying: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d37adc6944a6cf04e1e57dafea3e33… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d37adc6944a6cf04e1e57dafea3e33… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/bump-win32-tarballs] rts: Fix link order between ucrt and mingwex
by Tamar Christina (＠Phyx) 02 Jul '25

02 Jul '25

Tamar Christina pushed to branch wip/bump-win32-tarballs at Glasgow Haskell Compiler / GHC Commits: 1221221c by Tamar Christina at 2025-07-02T21:28:11+01:00 rts: Fix link order between ucrt and mingwex - - - - - 1 changed file: - libraries/ghc-internal/ghc-internal.cabal.in Changes: ===================================== libraries/ghc-internal/ghc-internal.cabal.in ===================================== @@ -493,7 +493,7 @@ Library -- on Windows. Required because of mingw32. extra-libraries: wsock32, user32, shell32, mingw32, kernel32, advapi32, - mingwex, ws2_32, shlwapi, ole32, rpcrt4, ntdll, ucrt + ucrt, mingwex, ws2_32, shlwapi, ole32, rpcrt4, ntdll -- Minimum supported Windows version. -- These numbers can be found at: -- https://msdn.microsoft.com/en-us/library/windows/desktop/aa383745(v=vs.85).… View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1221221c41c35a71e444ba52b1bc255… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1221221c41c35a71e444ba52b1bc255… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sand-witch/make-set-field] 23 commits: Visible forall in GADTs (#25127)
by Andrei Borzenkov (＠sand-witch) 02 Jul '25

02 Jul '25

Andrei Borzenkov pushed to branch wip/sand-witch/make-set-field at Glasgow Haskell Compiler / GHC Commits: fbc0b92a by Vladislav Zavialov at 2025-06-22T04:25:16+03:00 Visible forall in GADTs (#25127) Add support for visible dependent quantification `forall a -> t` in types of data constructors, e.g. data KindVal a where K :: forall k. forall (a::k) -> -- now allowed! k -> KindVal a For details, see docs/users_guide/exts/required_type_arguments.rst, which has gained a new subsection. DataCon in compiler/GHC/Core/DataCon.hs --------------------------------------- The main change in this patch is that DataCon, the Core representation of a data constructor, now uses a different type to store user-written type variable binders: - dcUserTyVarBinders :: [InvisTVBinder] + dcUserTyVarBinders :: [TyVarBinder] where type TyVarBinder = VarBndr TyVar ForAllTyFlag type InvisTVBinder = VarBndr TyVar Specificity and data Specificity = InferredSpec | SpecifiedSpec data ForAllTyFlag = Invisible Specificity | Required This change necessitates some boring, mechanical changes scattered throughout the diff: ... is now used in place of ... -----------------+--------------- TyVarBinder | InvisTVBinder IfaceForAllBndr | IfaceForAllSpecBndr Specified | SpecifiedSpec Inferred | InferredSpec mkForAllTys | mkInvisForAllTys additionally, tyVarSpecToBinders -- added or removed calls ifaceForAllSpecToBndrs -- removed calls Visibility casts in mkDataConRep -------------------------------- Type abstractions in Core (/\a. e) always have type (forall a. t) because coreTyLamForAllTyFlag = Specified. This is also true of data constructor workers. So we may be faced with the following: data con worker: (forall a. blah) data con wrapper: (forall a -> blah) In this case the wrapper must use a visibility cast (e |> ForAllCo ...) with appropriately set fco_vis{L,R}. Relevant functions: mkDataConRep in compiler/GHC/Types/Id/Make.hs dataConUserTyVarBindersNeedWrapper in compiler/GHC/Core/DataCon.hs mkForAllVisCos in compiler/GHC/Core/Coercion.hs mkCoreTyLams in compiler/GHC/Core/Make.hs mkWpForAllCast in compiler/GHC/Tc/Types/Evidence.hs More specifically: - dataConUserTyVarBindersNeedWrapper has been updated to answer "yes" if there are visible foralls in the type of the data constructor. - mkDataConRep now uses mkCoreTyLams to generate the big lambda abstractions (/\a b c. e) in the data con wrapper. - mkCoreTyLams is a variant of mkCoreLams that applies visibility casts as needed. It similar in purpose to the pre-existing mkWpForAllCast, so the common bits have been factored out into mkForAllVisCos. ConDecl in compiler/Language/Haskell/Syntax/Decls.hs ---------------------------------------------------- The surface syntax representation of a data constructor declaration is ConDecl. In accordance with the proposal, only GADT syntax is extended with support for visible forall, so we are interested in ConDeclGADT. ConDeclGADT's field con_bndrs has been renamed to con_outer_bndrs and is now accompanied by con_inner_bndrs: con_outer_bndrs :: XRec pass (HsOuterSigTyVarBndrs pass) con_inner_bndrs :: [HsForAllTelescope pass] Visible foralls always end up in con_inner_bndrs. The outer binders are stored and processed separately to support implicit quantification and the forall-or-nothing rule, a design established by HsSigType. A side effect of this change is that even in absence of visible foralls, GHC now permits multiple invisible foralls, e.g. data T a where { MkT :: forall a b. forall c d. ... -> T a } But of course, this is done in service of making at least some of these foralls visible. The entire compiler front-end has been updated to deal with con_inner_bndrs. See the following modified or added functions: Parser: mkGadtDecl in compiler/GHC/Parser/PostProcess.hs splitLHsGadtTy in compiler/GHC/Hs/Type.hs Pretty-printer: pprConDecl in compiler/GHC/Hs/Decls.hs pprHsForAllTelescope in compiler/GHC/Hs/Type.hs Renamer: rnConDecl in compiler/GHC/Rename/Module.hs bindHsForAllTelescopes in compiler/GHC/Rename/HsType.hs extractHsForAllTelescopes in compiler/GHC/Rename/HsType.hs Type checker: tcConDecl in compiler/GHC/Tc/TyCl.hs tcGadtConTyVarBndrs in compiler/GHC/Tc/Gen/HsType.hs Template Haskell ---------------- The TH AST is left unchanged for the moment to avoid breakage. An attempt to quote or reify a data constructor declaration with visible forall in its type will result an error: data ThRejectionReason -- in GHC/HsToCore/Errors/Types.hs = ... | ThDataConVisibleForall -- new error constructor However, as noted in the previous section, GHC now permits multiple invisible foralls, and TH was updated accordingly. Updated code: repC in compiler/GHC/HsToCore/Quote.hs reifyDataCon in compiler/GHC/Tc/Gen/Splice.hs ppr @Con in libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs Pattern matching ---------------- Everything described above concerns data constructor declarations, but what about their use sites? Now it is trickier to type check a pattern match fn(Con a b c)=... because we can no longer assume that a,b,c are all value arguments. Indeed, some or all of them may very well turn out to be required type arguments. To that end, see the changes to: tcDataConPat in compiler/GHC/Tc/Gen/Pat.hs splitConTyArgs in compiler/GHC/Tc/Gen/Pat.hs and the new helpers split_con_ty_args, zip_pats_bndrs. This is also the reason the TcRnTooManyTyArgsInConPattern error constructor has been removed. The new code emits TcRnArityMismatch or TcRnIllegalInvisibleTypePattern. Summary ------- DataCon, ConDecl, as well as all related functions have been updated to support required type arguments in data constructors. Test cases: HieGadtConSigs GadtConSigs_th_dump1 GadtConSigs_th_pprint1 T25127_data T25127_data_inst T25127_infix T25127_newtype T25127_fail_th_quote T25127_fail_arity TyAppPat_Tricky Co-authored-by: mniip <mniip(a)mniip.com> - - - - - ae003a3a by Teo Camarasu at 2025-06-23T05:21:48-04:00 linters: lint-whitespace: bump upper-bound for containers The version of containers was bumped in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/13989 - - - - - 0fb37893 by Matthew Pickering at 2025-06-23T13:55:10-04:00 Move ModuleGraph into UnitEnv The ModuleGraph is a piece of information associated with the ExternalPackageState and HomeUnitGraph. Therefore we should store it inside the HomeUnitEnv. - - - - - 3bf6720e by soulomoon at 2025-06-23T13:55:52-04:00 Remove hptAllFamInstances usage during upsweep Fixes #26118 This change eliminates the use of hptAllFamInstances during the upsweep phase, as it could access non-below modules from the home package table. The following updates were made: * Updated checkFamInstConsistency to accept an explicit ModuleEnv FamInstEnv parameter and removed the call to hptAllFamInstances. * Adjusted hugInstancesBelow so we can construct ModuleEnv FamInstEnv from its result, * hptAllFamInstances and allFamInstances functions are removed. - - - - - 83ee7b78 by Ben Gamari at 2025-06-24T05:02:07-04:00 configure: Don't force value of OTOOL, etc. if not present Previously if `otool` and `install_name_tool` were not present they would be overridden by `fp_settings.m4`. This logic was introduced in 4ff93292243888545da452ea4d4c1987f2343591 without explanation. - - - - - 9329c9e1 by Ben Gamari at 2025-06-24T05:02:07-04:00 ghc-toolchain: Add support for otool, install_name_tool Fixes part of ghc#23675. - - - - - 25f5c998 by Ben Gamari at 2025-06-24T05:02:08-04:00 ghc-toolchain: Add support for llc, opt, llvm-as Fixes #23675. - - - - - 51d150dd by Rodrigo Mesquita at 2025-06-24T05:02:08-04:00 hadrian: Use settings-use-distro-mingw directly The type `ToolchainSetting` only made sense when we had more settings to fetch from the system config file. Even then "settings-use-distro-mingw" is arguably not a toolchain setting. With the fix for #23675, all toolchain tools were moved to the `ghc-toolchain` `Toolchain` format. Therefore, we can inline `settings-use-distro-mingw` accesses and delete `ToolchainSetting`. - - - - - dcf68a83 by Rodrigo Mesquita at 2025-06-24T05:02:08-04:00 configure: Check LlvmTarget exists for LlvmAsFlags If LlvmTarget was empty, LlvmAsFlags would be just "--target=". If it is empty now, simply keep LlvmAsFlags empty. ghc-toolchain already does this right. This fix makes the two configurations match up. - - - - - 580a3353 by Ben Gamari at 2025-06-24T05:02:51-04:00 rts/linker/LoadArchive: Use bool Improve type precision by using `bool` instead of `int` and `StgBool`. - - - - - 76d1041d by Ben Gamari at 2025-06-24T05:02:51-04:00 rts/linker/LoadArchive: Don't rely on file extensions for identification Previously archive members would be identified via their file extension, as described in #13103. We now instead use a more principled approach, relying on the magic number in the member's header. As well, we refactor treatment of archive format detection to improve code clarity and error handling. Closes #13103. - - - - - 4b748a99 by Teo Camarasu at 2025-06-24T15:31:07-04:00 template-haskell: improve changelog stable -> more stable, just to clarify that this interface isn't fully stable. errornously -> mistakenly: I typod this and also let's go for a simpler word - - - - - e358e477 by Sylvain Henry at 2025-06-24T15:31:58-04:00 Bump stack resolver to use GHC 9.6.7 Cf #26139 - - - - - 4bf5eb63 by fendor at 2025-06-25T17:05:43-04:00 Teach `:reload` about multiple home units `:reload` needs to lookup the `ModuleName` and must not assume the given `ModuleName` is in the current `HomeUnit`. We add a new utility function which allows us to find a `HomeUnitModule` instead of a `Module`. Further, we introduce the `GhciCommandError` type which can be used to abort the execution of a GHCi command. This error is caught and printed in a human readable fashion. - - - - - b3d97bb3 by fendor at 2025-06-25T17:06:25-04:00 Implement `-fno-load-initial-targets` flag We add the new flag `-fno-load-initial-targets` which doesn't load all `Target`s immediately but only computes the module graph for all `Target`s. The user can then decide to load modules from that module graph using the syntax: ghci> :reload <Mod> This will load everything in the module graph up to `Mod`. The user can return to the initial state by using the builtin target `none` to unload all modules. ghci> :reload none Is in principle identical to starting a new session with the `-fno-load-initial-targets` flag. The `-fno-load-initial-targets` flag allows for faster startup time of GHCi when a user has lots of `Target`s. We additionally extend the `:reload` command to accept multiple `ModuleName`s. For example: ghci> :reload <Mod1> <Mod2> Loads all modules up to the modules `Mod1` and `Mod2`. - - - - - 49f44e52 by Teo Camarasu at 2025-06-26T04:19:51-04:00 Expose ghc-internal unit id through the settings file This in combination with the unit id of the compiler library allows cabal to know of the two unit ids that should not be reinstalled (in specific circumstances) as: - when using plugins, we want to link against exactly the compiler unit id - when using TemplateHaskell we want to link against exactly the package that contains the TemplateHaskell interfaces, which is `ghc-internal` See: <https://github.com/haskell/cabal/issues/10087> Resolves #25282 - - - - - 499c4efe by Bryan Richter at 2025-06-26T04:20:33-04:00 CI: Fix and clean up capture of timings * Fixes the typo that caused 'cat ci-timings' to report "no such file or directory" * Gave ci_timings.txt a file extension so it may play better with other systems * Fixed the use of time_it so all times are recorded * Fixed time_it to print name along with timing - - - - - 86c90c9e by Bryan Richter at 2025-06-26T04:20:33-04:00 CI: Update collapsible section usage The syntax apparently changed at some point. - - - - - 04308ee4 by Bryan Richter at 2025-06-26T04:20:33-04:00 CI: Add more collapsible sections - - - - - 43b606bb by Florian Ragwitz at 2025-06-27T16:31:26-04:00 Tick uses of wildcard/pun field binds as if using the record selector function Fixes #17834. See Note [Record-selector ticks] for additional reasoning behind this as well as an overview of the implementation details and future improvements. - - - - - d4952549 by Ben Gamari at 2025-06-27T16:32:08-04:00 testsuite/caller-cc: Make CallerCc[123] less sensitive These were previously sensitive to irrelevant changes in program structure. To avoid this we filter out all by lines emitted by the -fcaller-cc from the profile. - - - - - 733583e3 by Andrei Borzenkov at 2025-07-02T22:13:12+04:00 Generate SetField instances on demand (16232) - - - - - 1d422ed1 by Andrei Borzenkov at 2025-07-02T22:14:12+04:00 Small fixes after intensive testing - - - - - 184 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/common.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/ConLike.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/PatSyn.hs - compiler/GHC/Core/TyCo/Ppr.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Data/List/SetOps.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Env.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Errors/Ppr.hs - compiler/GHC/HsToCore/Errors/Types.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Instance/Family.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Build.hs - compiler/GHC/Tc/TyCl/Utils.hs - + compiler/GHC/Tc/TyCl/Utils.hs-boot - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/Var.hs-boot - compiler/GHC/Unit/Env.hs - compiler/GHC/Unit/Home/Graph.hs - compiler/GHC/Unit/Home/PackageTable.hs - compiler/GHC/Unit/Module/Graph.hs - compiler/GHC/Unit/Module/ModDetails.hs - compiler/GHC/Unit/Module/ModGuts.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/Language/Haskell/Syntax/Basic.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Pat.hs - compiler/Setup.hs - distrib/configure.ac.in - docs/users_guide/9.14.1-notes.rst - docs/users_guide/exts/gadt_syntax.rst - docs/users_guide/exts/required_type_arguments.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - ghc/GHCi/UI/Exception.hs - ghc/GHCi/UI/Print.hs - hadrian/cfg/default.host.target.in - hadrian/cfg/default.target.in - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/RunTest.hs - hadrian/stack.yaml - hadrian/stack.yaml.lock - libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs - libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs - libraries/ghc-internal/src/GHC/Internal/Records.hs - libraries/template-haskell/changelog.md - linters/lint-whitespace/lint-whitespace.cabal - m4/fp_settings.m4 - m4/ghc_toolchain.m4 - m4/prep_target_file.m4 - rts/linker/LoadArchive.c - testsuite/tests/dependent/should_fail/T16326_Fail6.stderr - testsuite/tests/ghc-e/should_fail/T18441fail5.stderr - testsuite/tests/ghci/prog-mhu003/prog-mhu003.stderr - testsuite/tests/ghci/prog-mhu004/prog-mhu004a.stderr - + testsuite/tests/ghci/prog-mhu005/Makefile - + testsuite/tests/ghci/prog-mhu005/a/A.hs - + testsuite/tests/ghci/prog-mhu005/all.T - + testsuite/tests/ghci/prog-mhu005/b/B.hs - + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.script - + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stderr - + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stdout - + testsuite/tests/ghci/prog-mhu005/unitA - + testsuite/tests/ghci/prog-mhu005/unitB - + testsuite/tests/ghci/prog021/A.hs - + testsuite/tests/ghci/prog021/B.hs - + testsuite/tests/ghci/prog021/Makefile - + testsuite/tests/ghci/prog021/all.T - + testsuite/tests/ghci/prog021/prog021a.script - + testsuite/tests/ghci/prog021/prog021a.stderr - + testsuite/tests/ghci/prog021/prog021a.stdout - + testsuite/tests/ghci/prog021/prog021b.script - + testsuite/tests/ghci/prog021/prog021b.stderr - + testsuite/tests/ghci/prog021/prog021b.stdout - + testsuite/tests/ghci/prog022/A.hs - + testsuite/tests/ghci/prog022/B.hs - + testsuite/tests/ghci/prog022/Makefile - + testsuite/tests/ghci/prog022/all.T - + testsuite/tests/ghci/prog022/ghci.prog022a.script - + testsuite/tests/ghci/prog022/ghci.prog022a.stderr - + testsuite/tests/ghci/prog022/ghci.prog022a.stdout - + testsuite/tests/ghci/prog022/ghci.prog022b.script - + testsuite/tests/ghci/prog022/ghci.prog022b.stderr - + testsuite/tests/ghci/prog022/ghci.prog022b.stdout - testsuite/tests/ghci/scripts/ghci021.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - + testsuite/tests/hiefile/should_run/HieGadtConSigs.hs - + testsuite/tests/hiefile/should_run/HieGadtConSigs.stdout - testsuite/tests/hiefile/should_run/all.T - + testsuite/tests/hpc/recsel/Makefile - + testsuite/tests/hpc/recsel/recsel.hs - + testsuite/tests/hpc/recsel/recsel.stdout - + testsuite/tests/hpc/recsel/test.T - testsuite/tests/parser/should_compile/DumpParsedAst.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/parser/should_compile/T15323.stderr - testsuite/tests/printer/T18791.stderr - testsuite/tests/profiling/should_run/caller-cc/all.T - + testsuite/tests/th/GadtConSigs_th_dump1.hs - + testsuite/tests/th/GadtConSigs_th_dump1.stderr - + testsuite/tests/th/GadtConSigs_th_pprint1.hs - + testsuite/tests/th/GadtConSigs_th_pprint1.stderr - testsuite/tests/th/T20868.stdout - testsuite/tests/th/all.T - testsuite/tests/typecheck/should_compile/T23739a.hs - + testsuite/tests/typecheck/should_compile/TyAppPat_Tricky.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T20443b.stderr - testsuite/tests/typecheck/should_fail/TyAppPat_TooMany.stderr - + testsuite/tests/vdq-rta/should_compile/T25127_data.hs - + testsuite/tests/vdq-rta/should_compile/T25127_data_inst.hs - + testsuite/tests/vdq-rta/should_compile/T25127_infix.hs - + testsuite/tests/vdq-rta/should_compile/T25127_newtype.hs - testsuite/tests/vdq-rta/should_compile/all.T - testsuite/tests/vdq-rta/should_fail/T24159_type_syntax_th_fail.script - + testsuite/tests/vdq-rta/should_fail/T25127_fail_arity.hs - + testsuite/tests/vdq-rta/should_fail/T25127_fail_arity.stderr - + testsuite/tests/vdq-rta/should_fail/T25127_fail_th_quote.hs - + testsuite/tests/vdq-rta/should_fail/T25127_fail_th_quote.stderr - testsuite/tests/vdq-rta/should_fail/all.T - utils/check-exact/ExactPrint.hs - utils/ghc-toolchain/exe/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/88d6c41456df78c3c9529cc7e6b49f… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/88d6c41456df78c3c9529cc7e6b49f… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/sand-witch/make-set-field] Small fixes after intensive testing
by Andrei Borzenkov (＠sand-witch) 02 Jul '25

02 Jul '25

Andrei Borzenkov pushed to branch wip/sand-witch/make-set-field at Glasgow Haskell Compiler / GHC Commits: 88d6c414 by Andrei Borzenkov at 2025-07-02T22:10:04+04:00 Small fixes after intensive testing - - - - - 7 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types.hs - libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -2308,7 +2308,7 @@ wildCardKey, absentErrorIdKey, absentConstraintErrorIdKey, augmentIdKey, appendI noMethodBindingErrorIdKey, nonExhaustiveGuardsErrorIdKey, impossibleErrorIdKey, impossibleConstraintErrorIdKey, patErrorIdKey, voidPrimIdKey, - realWorldPrimIdKey, recConErrorIdKey, + realWorldPrimIdKey, recConErrorIdKey, recUpdErrorIdKey, unpackCStringUtf8IdKey, unpackCStringAppendUtf8IdKey, unpackCStringFoldrUtf8IdKey, unpackCStringIdKey, unpackCStringAppendIdKey, unpackCStringFoldrIdKey, typeErrorIdKey, divIntIdKey, modIntIdKey, @@ -2409,6 +2409,7 @@ rationalToFloatIdKey = mkPreludeMiscIdUnique 132 rationalToDoubleIdKey = mkPreludeMiscIdUnique 133 seqHashKey = mkPreludeMiscIdUnique 134 +recUpdErrorIdKey = mkPreludeMiscIdUnique 135 coerceKey :: Unique coerceKey = mkPreludeMiscIdUnique 157 ===================================== compiler/GHC/Core/Make.hs ===================================== @@ -42,7 +42,7 @@ module GHC.Core.Make ( -- * Error Ids mkRuntimeErrorApp, mkImpossibleExpr, mkAbsentErrorApp, errorIds, - rEC_CON_ERROR_ID, + rEC_CON_ERROR_ID, rEC_UPD_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, pAT_ERROR_ID, rEC_SEL_ERROR_ID, tYPE_ERROR_ID, aBSENT_SUM_FIELD_ERROR_ID @@ -897,6 +897,7 @@ errorIds nO_METHOD_BINDING_ERROR_ID, pAT_ERROR_ID, rEC_CON_ERROR_ID, + rEC_UPD_ERROR_ID, rEC_SEL_ERROR_ID, iMPOSSIBLE_ERROR_ID, iMPOSSIBLE_CONSTRAINT_ERROR_ID, aBSENT_ERROR_ID, aBSENT_CONSTRAINT_ERROR_ID, @@ -904,13 +905,14 @@ errorIds tYPE_ERROR_ID -- Used with Opt_DeferTypeErrors, see #10284 ] -recSelErrorName, recConErrorName, patErrorName :: Name +recSelErrorName, recConErrorName, patErrorName, recUpdErrorName :: Name nonExhaustiveGuardsErrorName, noMethodBindingErrorName :: Name typeErrorName :: Name absentSumFieldErrorName :: Name recSelErrorName = err_nm "recSelError" recSelErrorIdKey rEC_SEL_ERROR_ID recConErrorName = err_nm "recConError" recConErrorIdKey rEC_CON_ERROR_ID +recUpdErrorName = err_nm "recUpdError" recUpdErrorIdKey rEC_UPD_ERROR_ID patErrorName = err_nm "patError" patErrorIdKey pAT_ERROR_ID typeErrorName = err_nm "typeError" typeErrorIdKey tYPE_ERROR_ID @@ -922,11 +924,12 @@ nonExhaustiveGuardsErrorName = err_nm "nonExhaustiveGuardsError" err_nm :: String -> Unique -> Id -> Name err_nm str uniq id = mkWiredInIdName gHC_INTERNAL_CONTROL_EXCEPTION_BASE (fsLit str) uniq id -rEC_SEL_ERROR_ID, rEC_CON_ERROR_ID :: Id +rEC_SEL_ERROR_ID, rEC_CON_ERROR_ID, rEC_UPD_ERROR_ID :: Id pAT_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID :: Id tYPE_ERROR_ID, aBSENT_SUM_FIELD_ERROR_ID :: Id rEC_SEL_ERROR_ID = mkRuntimeErrorId TypeLike recSelErrorName rEC_CON_ERROR_ID = mkRuntimeErrorId TypeLike recConErrorName +rEC_UPD_ERROR_ID = mkRuntimeErrorId TypeLike recUpdErrorName pAT_ERROR_ID = mkRuntimeErrorId TypeLike patErrorName nO_METHOD_BINDING_ERROR_ID = mkRuntimeErrorId TypeLike noMethodBindingErrorName nON_EXHAUSTIVE_GUARDS_ERROR_ID = mkRuntimeErrorId TypeLike nonExhaustiveGuardsErrorName ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -1340,7 +1340,7 @@ matchSetField dflags short_cut clas tys mb_ct_loc -- Use the equality proof to cast the selector Id to -- type (r -> a), then use the newtype coercion to cast -- it to a HasField dictionary. - mk_ev (ev1:ev2:evs) = evDFunApp (dataConWrapId dCon) (tys ++ tvs) + mk_ev (ev1:ev2:evs) = evDFunApp (dataConWrapId dCon) tys [ evSelector modifier_id tvs evs `Cast` co ev2 , evSelector setter_id tvs evs `Cast` co ev1 ] @@ -1395,7 +1395,7 @@ matchSetField dflags short_cut clas tys mb_ct_loc pure (setter, modifier) Nothing -> do binds@((setter, _), (modifier,_)) <- mkSetFieldBinds tycon fl - writeTcRef req_flds ((fl, binds) : reqs) + updTcRef req_flds ((fl, binds) : ) pure (setter, modifier) tc_inst_setfield_binds setter_id modifier_id ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -579,12 +579,13 @@ tcRnSrcDecls explicit_mod_hdr export_ies decls -- Emit Typeable bindings ; tcg_env <- setGblEnv tcg_env $ mkTypeableBinds + ; (tcg_env, recs_lie) <- setGblEnv tcg_env $ captureTopConstraints $ tcRecSetterBinds ; rec_ev_binds <- restoreEnvs (tcg_env, tcl_env) $ - simplifyTop recs_lie -- Is that required? + simplifyTop recs_lie -- TODO sand-witch: Is that required? ; let new_ev_binds = main_ev_binds `mappend` rec_ev_binds ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -42,7 +42,7 @@ import GHC.Hs import GHC.Core.TyCo.Rep( Type(..), Coercion(..), MCoercion(..) ) import GHC.Core.Multiplicity import GHC.Core.Predicate -import GHC.Core.Make( rEC_SEL_ERROR_ID ) +import GHC.Core.Make( rEC_SEL_ERROR_ID, rEC_UPD_ERROR_ID ) import GHC.Core.Class import GHC.Core.Type import GHC.Core.TyCon @@ -868,19 +868,22 @@ mkRecSelBind (tycon, fl) mkOneRecordSelector :: [ConLike] -> RecSelParent -> FieldLabel -> FieldSelectors -> (Id, LHsBind GhcRn) mkOneRecordSelector all_cons idDetails fl has_sel - = collectFieldLabelInfo all_cons idDetails fl has_sel mkRecordSelectorBind + = collectFieldLabelInfo all_cons idDetails fl has_sel mkRecordSelectorBind mkRecordSelectorBind :: RecordBindBuilder (Id, LHsBind GhcRn) -mkRecordSelectorBind = mk_record_bind mk_sel_ty mk_match where +mkRecordSelectorBind fl = mk_record_bind 1 err_expr mk_sel_ty mk_match fl where + + err_expr = make_rec_error_expr fl rEC_SEL_ERROR_ID + mk_sel_ty :: Type -> Type -> Type - mk_sel_ty data_ty field_ty = + mk_sel_ty data_ty field_ty = mkVisFunTyMany data_ty $ -- Record selectors are always typed with Many. We -- could improve on it in the case where all the -- fields in all the constructor have multiplicity Many. field_ty - mk_match sel_name match_ctxt con = + mk_match sel_name match_ctxt con = mkSimpleMatch match_ctxt (L loc [L loc (mk_sel_pat con)]) (L loc (mkHsVar (L loc field_var))) @@ -915,7 +918,7 @@ tcRecSetterBinds = do where remove_binds (n, ((setter, _), (modifier, _))) = (flSelector n, (setter, modifier)) get_ids_to_check [] = [] - get_ids_to_check ( (_, (setter, modifier)) : flds) = + get_ids_to_check ( (_, (setter, modifier)) : flds) = setter : modifier : get_ids_to_check flds @@ -928,41 +931,44 @@ mkSetFieldBinds tycon fl = idDetails = RecSelData tycon mk_field_lbl prefix uniq = - let + let lbl = flLabel fl newOcc = mkOccNameFS varName (mkFastString prefix `mappend` field_label lbl) - in fl {flSelector = flSelector fl `setNameUnique` uniq `tidyNameOcc` newOcc} + in fl { flSelector = flSelector fl `setNameUnique` uniq `tidyNameOcc` newOcc } mk_binds cons_w_field rec_details ty_builder = do setter_fl <- mk_field_lbl "setter_" <$> newUnique - modifier_fd <- mk_field_lbl "modifier_" <$> newUnique + modifier_fl <- mk_field_lbl "modifier_" <$> newUnique let setter_bind = mkRecordSetterBind fl setter_fl all_cons cons_w_field rec_details ty_builder - modifier_bind = mkRecordModifierBind fl modifier_fd all_cons cons_w_field rec_details ty_builder + modifier_bind = mkRecordModifierBind fl modifier_fl all_cons cons_w_field rec_details ty_builder pure (setter_bind, modifier_bind) - mkRecordSetterBind :: FieldLabel -> RecordBindBuilder (Id, LHsBind GhcRn) -mkRecordSetterBind origFl fl = mk_record_bind mkRecordSetterType mk_match fl where +mkRecordSetterBind origFl fl = mk_record_bind 2 err_expr mkRecordSetterType mk_match fl where - mk_match = - mk_set_fld_match (getOccName $ flSelector fl) origFl $ + err_expr = make_rec_error_expr origFl rEC_UPD_ERROR_ID + + mk_match = + mk_set_fld_match (getOccName $ flSelector origFl) origFl $ \_ field_var -> (genWildPat, genLHsVar field_var) mkRecordSetterType :: Type -> Type -> Type -mkRecordSetterType data_ty field_ty = +mkRecordSetterType data_ty field_ty = mkVisFunTyMany field_ty $ mkVisFunTyMany data_ty data_ty mkRecordModifierBind :: FieldLabel -> RecordBindBuilder (Id, LHsBind GhcRn) -mkRecordModifierBind origFl fl = mk_record_bind mkRecordModifierType mk_match fl where +mkRecordModifierBind origFl fl = mk_record_bind 2 err_expr mkRecordModifierType mk_match fl where + + err_expr = make_rec_error_expr origFl rEC_UPD_ERROR_ID - mk_match = mk_set_fld_match (mkOccName varName "f") origFl $ \i fun_var -> + mk_match = mk_set_fld_match (mkOccName varName "f") origFl $ \i fun_var -> let fld_nm = mk_set_fld_bind i fl expr = wrapGenSpan $ HsPar noExtField $ genLHsApp (genHsVar fun_var) (genLHsVar fld_nm) in (genVarPat fld_nm, expr) mkRecordModifierType :: Type -> Type -> Type -mkRecordModifierType data_ty field_ty = +mkRecordModifierType data_ty field_ty = mkVisFunTyMany (mkVisFunTyMany field_ty field_ty) $ mkVisFunTyMany data_ty data_ty @@ -981,11 +987,11 @@ mk_set_fld_match occ_name fl on_fld setter_name match_ctxt con = loc = noAnnSrcSpan (getSrcSpan setter_name) - mk_con_arg i fld_lbl + mk_con_arg i fld_lbl | fl == fld_lbl = on_fld i arg_var | otherwise = let fld_nm = mk_set_fld_bind i fld_lbl - in (genVarPat fld_nm, genLHsVar fld_nm) + in (genVarPat fld_nm, genLHsVar fld_nm) arg_var = mkInternalName (mkBuiltinUnique 1) occ_name loc @@ -993,14 +999,14 @@ mk_set_fld_bind :: Int -> FieldLabel -> Name mk_set_fld_bind i fld_lbl = mkInternalName (mkBuiltinUnique i) (nameOccName $ flSelector $ fld_lbl) - generatedSrcSpan + generatedSrcSpan type ConLikeWithField = ConLike -type RecordBindBuilder r = +type RecordBindBuilder r = FieldLabel -> [ConLike] -> [ConLikeWithField] -> IdDetails -> ((Type -> Type -> Type) -> Type) -> r -type FldBindMatchBuilder = +type FldBindMatchBuilder = Name -> HsMatchContext (LocatedN Name) -> ConLikeWithField -> LMatch GhcRn (LHsExpr GhcRn) collectFieldLabelInfo :: [ConLike] -> @@ -1052,7 +1058,7 @@ collectFieldLabelInfo all_cons idDetails fl has_sel k -- A slight hack! sel_ty | is_naughty = \_ -> unitTy -- See Note [Naughty record selectors] - | otherwise = \mk_ty -> + | otherwise = \mk_ty -> mkForAllTys (tyVarSpecToBinders sel_tvbs) $ -- Urgh! See Note [The stupid context] in GHC.Core.DataCon mkPhiTy (conLikeStupidTheta con1) $ @@ -1060,11 +1066,21 @@ collectFieldLabelInfo all_cons idDetails fl has_sel k mkPhiTy req_theta $ mk_ty data_ty field_ty -mk_record_bind :: +make_rec_error_expr :: FieldLabel -> Id -> LHsExpr GhcRn +make_rec_error_expr fl err_id = + genLHsApp + (genHsVar (getName err_id)) + (genLHsLit msg_lit) + where + msg_lit = HsStringPrim NoSourceText (bytesFS (field_label (flLabel fl))) + +mk_record_bind :: + Int -> + LHsExpr GhcRn -> (Type -> Type -> Type) -> FldBindMatchBuilder -> RecordBindBuilder (Id, LHsBind GhcRn) -mk_record_bind mk_ty mk_match fl all_cons cons_w_field rec_details ty_builder +mk_record_bind num_args err_expr mk_ty mk_match fl all_cons cons_w_field rec_details ty_builder = (sel_id, L loc sel_bind) where sel_ty = ty_builder mk_ty @@ -1092,10 +1108,8 @@ mk_record_bind mk_ty mk_match fl all_cons cons_w_field rec_details ty_builder -- We do this explicitly so that we get a nice error message that -- mentions this particular record selector deflt | all dealt_with all_cons = [] - | otherwise = [mkSimpleMatch match_ctxt (wrapGenSpan [genWildPat]) - (genLHsApp - (genHsVar (getName rEC_SEL_ERROR_ID)) - (genLHsLit msg_lit))] + | otherwise = [mkSimpleMatch match_ctxt (wrapGenSpan (replicate num_args genWildPat)) + err_expr] -- Do not add a default case unless there are unmatched -- constructors. We must take account of GADTs, else we @@ -1114,7 +1128,6 @@ mk_record_bind mk_ty mk_match fl all_cons cons_w_field rec_details ty_builder inst_tys = dataConResRepTyArgs dc unit_rhs = mkLHsTupleExpr [] noExtField - msg_lit = HsStringPrim NoSourceText (bytesFS (field_label (flLabel fl))) {- Note [Polymorphic selectors] ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -561,7 +561,7 @@ data TcGblEnv -- they all have a non-empty gre_imp field. tcg_keep :: TcRef NameSet, - tcg_requested_fields :: TcRef [(FieldLabel, ((Id, LHsBind GhcRn), (Id, LHsBind GhcRn)))], + tcg_requested_fields :: TcRef [(FieldLabel, (FieldBind, FieldBind))], tcg_th_used :: TcRef Bool, -- ^ @True@ \<=> Template Haskell syntax used. @@ -706,7 +706,8 @@ data TcGblEnv -- ^ See Note [Generating fresh names for FFI wrappers] } -type FieldInstEnv = NameEnv (Id, Id) +type FieldInstEnv = NameEnv (Id, Id) +type FieldBind = (Id, LHsBind GhcRn) -- NB: topModIdentity, not topModSemantic! -- Definition sites of orphan identities will be identity modules, not semantic ===================================== libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs ===================================== @@ -104,7 +104,7 @@ module GHC.Internal.Control.Exception.Base ( finally, -- * Calls for GHC runtime - recSelError, recConError, + recSelError, recConError, recUpdError, impossibleError, impossibleConstraintError, nonExhaustiveGuardsError, patError, noMethodBindingError, typeError, @@ -422,12 +422,14 @@ instance Exception NoMatchingContinuationPrompt ----- -- See Note [Compiler error functions] in ghc-internal:GHC.Internal.Prim.Panic -recSelError, recConError, typeError, +recSelError, recUpdError, recConError, typeError, nonExhaustiveGuardsError, patError, noMethodBindingError :: Addr# -> a -- All take a UTF8-encoded C string recSelError s = throw (RecSelError ("No match in record selector " ++ unpackCStringUtf8# s)) -- No location info unfortunately +recUpdError s = throw (RecUpdError ("No match in record update " + ++ unpackCStringUtf8# s)) -- No location info unfortunately nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in")) recConError s = throw (RecConError (untangle s "Missing field in record construction")) noMethodBindingError s = throw (NoMethodError (untangle s "No instance nor default method for class operation")) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/88d6c41456df78c3c9529cc7e6b49f6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/88d6c41456df78c3c9529cc7e6b49f6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/step-out-9] Deleted 1 commit: ghci: Allocate BreakArrays at link time only
by Rodrigo Mesquita (＠alt-romes) 02 Jul '25

02 Jul '25

Rodrigo Mesquita pushed to branch wip/romes/step-out-9 at Glasgow Haskell Compiler / GHC WARNING: The push did not contain any new commits, but force pushed to delete the commits and changes below. Deleted commits: 5178fc25 by Rodrigo Mesquita at 2025-07-02T17:24:52+01:00 ghci: Allocate BreakArrays at link time only Previously, a BreakArray would be allocated with a slot for every tick in a module at `mkModBreaks`, in HsToCore. However, this approach has a few downsides: - It interleaves interpreter behaviour (allocating arrays for breakpoints) within the desugarer - It is inflexible in the sense it is impossible for the bytecode generator to add "internal" breakpoints that can be triggered at runtime, because those wouldn't have a source tick. (This is relevant for our intended implementation plan of step-out in #26042) - It ties the BreakArray indices to the *tick* indexes, while at runtime we would rather just have the *info* indexes (currently we have both because BreakArrays are indexed by the *tick* one). Paving the way for #26042 and #26064, this commit moves the allocation of BreakArrays to bytecode-loading time -- akin to what is done for CCS arrays. Since a BreakArray is allocated only when bytecode is linked, if a breakpoint is set (e.g. `:break 10`) before the bytecode is linked, there will exist no BreakArray to trigger the breakpoint in. Therefore, the function to allocate break arrays (`allocateBreakArrays`) is exposed and also used in GHC.Runtime.Eval to allocate a break array when a breakpoint is set, if it doesn't exist yet (in the linker env). - - - - - 8 changed files: - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Eval.hs - − compiler/GHC/Runtime/Interpreter.hs-boot - − compiler/GHC/Runtime/Interpreter/Types.hs-boot - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -97,8 +97,8 @@ import GHC.Unit.Module.Deps import Data.List (partition) import Data.IORef -import Data.Traversable (for) import GHC.Iface.Make (mkRecompUsageInfo) +import GHC.Runtime.Interpreter (interpreterProfiled) {- ************************************************************************ @@ -162,13 +162,12 @@ deSugar hsc_env mod mod_loc export_set (typeEnvTyCons type_env) binds else return (binds, Nothing) - ; modBreaks <- for - [ (i, s) - | i <- hsc_interp hsc_env - , (_, s) <- m_tickInfo - , breakpointsAllowed dflags - ] - $ \(interp, specs) -> mkModBreaks interp mod specs + ; let modBreaks + | Just (_, specs) <- m_tickInfo + , breakpointsAllowed dflags + = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod specs + | otherwise + = Nothing ; ds_hpc_info <- case m_tickInfo of Just (orig_file2, ticks) ===================================== compiler/GHC/HsToCore/Breakpoints.hs ===================================== @@ -33,14 +33,6 @@ import GHC.Unit.Module (Module) import GHC.Utils.Outputable import Data.List (intersperse) -import GHCi.BreakArray (BreakArray) -import GHCi.RemoteTypes (ForeignRef) - --- TODO: Break this cycle -import {-# SOURCE #-} GHC.Runtime.Interpreter.Types (Interp, interpreterProfiled) -import {-# SOURCE #-} qualified GHC.Runtime.Interpreter as GHCi (newBreakArray) -import Data.Array.Base (numElements) - -------------------------------------------------------------------------------- -- ModBreaks -------------------------------------------------------------------------------- @@ -58,10 +50,7 @@ import Data.Array.Base (numElements) -- and 'modBreaks_decls'. data ModBreaks = ModBreaks - { modBreaks_flags :: ForeignRef BreakArray - -- ^ The array of flags, one per breakpoint, - -- indicating which breakpoints are enabled. - , modBreaks_locs :: !(Array BreakTickIndex SrcSpan) + { modBreaks_locs :: !(Array BreakTickIndex SrcSpan) -- ^ An array giving the source span of each breakpoint. , modBreaks_vars :: !(Array BreakTickIndex [OccName]) -- ^ An array giving the names of the free variables at each breakpoint. @@ -83,40 +72,31 @@ data ModBreaks -- generator needs to encode this information for each expression, the data is -- allocated remotely in GHCi's address space and passed to the codegen as -- foreign pointers. -mkModBreaks :: Interp -> Module -> SizedSeq Tick -> IO ModBreaks -mkModBreaks interp mod extendedMixEntries - = do - let count = fromIntegral $ sizeSS extendedMixEntries +mkModBreaks :: Bool {-^ Whether the interpreter is profiled and thus if we should include store a CCS array -} + -> Module -> SizedSeq Tick -> ModBreaks +mkModBreaks interpreterProfiled modl extendedMixEntries + = let count = fromIntegral $ sizeSS extendedMixEntries entries = ssElts extendedMixEntries - let - locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ] - varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ] - declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ] - ccs - | interpreterProfiled interp = - listArray - (0, count - 1) - [ ( concat $ intersperse "." $ tick_path t, - renderWithContext defaultSDocContext $ ppr $ tick_loc t - ) - | t <- entries - ] - | otherwise = listArray (0, -1) [] - hydrateModBreaks interp $ - ModBreaks - { modBreaks_flags = undefined, - modBreaks_locs = locsTicks, - modBreaks_vars = varsTicks, - modBreaks_decls = declsTicks, - modBreaks_ccs = ccs, - modBreaks_module = mod - } - -hydrateModBreaks :: Interp -> ModBreaks -> IO ModBreaks -hydrateModBreaks interp ModBreaks {..} = do - let count = numElements modBreaks_locs - modBreaks_flags <- GHCi.newBreakArray interp count - pure ModBreaks {..} + locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ] + varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ] + declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ] + ccs + | interpreterProfiled = + listArray + (0, count - 1) + [ ( concat $ intersperse "." $ tick_path t, + renderWithContext defaultSDocContext $ ppr $ tick_loc t + ) + | t <- entries + ] + | otherwise = listArray (0, -1) [] + in ModBreaks + { modBreaks_locs = locsTicks + , modBreaks_vars = varsTicks + , modBreaks_decls = declsTicks + , modBreaks_ccs = ccs + , modBreaks_module = modl + } {- Note [Field modBreaks_decls] ===================================== compiler/GHC/Linker/Loader.hs ===================================== @@ -28,6 +28,7 @@ module GHC.Linker.Loader , extendLoadedEnv , deleteFromLoadedEnv -- * Internals + , allocateBreakArrays , rmDupLinkables , modifyLoaderState , initLinkDepsOpts @@ -122,8 +123,8 @@ import System.Win32.Info (getSystemDirectory) import GHC.Utils.Exception import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey) import GHC.Driver.Downsweep - - +import qualified GHC.Runtime.Interpreter as GHCi +import Data.Array.Base (numElements) -- Note [Linkers and loaders] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -696,16 +697,8 @@ loadDecls interp hsc_env span linkable = do let le = linker_env pls le2_itbl_env <- linkITbls interp (itbl_env le) (concat $ map bc_itbls cbcs) le2_addr_env <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le) cbcs - le2_breakarray_env <- - allocateBreakArrays - interp - (catMaybes $ map bc_breaks cbcs) - (breakarray_env le) - le2_ccs_env <- - allocateCCS - interp - (catMaybes $ map bc_breaks cbcs) - (ccs_env le) + le2_breakarray_env <- allocateBreakArrays interp (breakarray_env le) (catMaybes $ map bc_breaks cbcs) + le2_ccs_env <- allocateCCS interp (ccs_env le) (catMaybes $ map bc_breaks cbcs) let le2 = le { itbl_env = le2_itbl_env , addr_env = le2_addr_env , breakarray_env = le2_breakarray_env @@ -933,12 +926,8 @@ dynLinkBCOs interp pls bcos = do le1 = linker_env pls ie2 <- linkITbls interp (itbl_env le1) (concatMap bc_itbls cbcs) ae2 <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le1) cbcs - be2 <- - allocateBreakArrays - interp - (catMaybes $ map bc_breaks cbcs) - (breakarray_env le1) - ce2 <- allocateCCS interp (catMaybes $ map bc_breaks cbcs) (ccs_env le1) + be2 <- allocateBreakArrays interp (breakarray_env le1) (catMaybes $ map bc_breaks cbcs) + ce2 <- allocateCCS interp (ccs_env le1) (catMaybes $ map bc_breaks cbcs) let le2 = le1 { itbl_env = ie2, addr_env = ae2, breakarray_env = be2, ccs_env = ce2 } names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs @@ -1656,30 +1645,34 @@ allocateTopStrings interp topStrings prev_env = do where mk_entry nm ptr = (nm, (nm, AddrPtr ptr)) --- | Given a list of 'ModBreaks' collected from a list of --- 'CompiledByteCode', allocate the 'BreakArray'. +-- | Given a list of 'InternalModBreaks' collected from a list of +-- 'CompiledByteCode', allocate the 'BreakArray' used to trigger breakpoints. allocateBreakArrays :: Interp -> - [InternalModBreaks] -> ModuleEnv (ForeignRef BreakArray) -> + [InternalModBreaks] -> IO (ModuleEnv (ForeignRef BreakArray)) -allocateBreakArrays _interp mbs be = +allocateBreakArrays interp = foldlM - ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> - evaluate $ extendModuleEnv be0 modBreaks_module modBreaks_flags + ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do + -- If no BreakArray is assigned to this module yet, create one + if not $ elemModuleEnv modBreaks_module be0 then do + let count = numElements modBreaks_locs + breakArray <- GHCi.newBreakArray interp count + evaluate $ extendModuleEnv be0 modBreaks_module breakArray + else + return be0 ) - be - mbs --- | Given a list of 'ModBreaks' collected from a list of --- 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling --- is enabled. +-- | Given a list of 'InternalModBreaks' collected from a list +-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is +-- enabled. allocateCCS :: Interp -> - [InternalModBreaks] -> ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) -> + [InternalModBreaks] -> IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) -allocateCCS interp mbs ce +allocateCCS interp ce mbss | interpreterProfiled interp = foldlM ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do @@ -1688,12 +1681,15 @@ allocateCCS interp mbs ce interp (moduleNameString $ moduleName modBreaks_module) (elems modBreaks_ccs) - evaluate $ - extendModuleEnv ce0 modBreaks_module $ - listArray - (0, length ccs - 1) - ccs + if not $ elemModuleEnv modBreaks_module ce0 then do + evaluate $ + extendModuleEnv ce0 modBreaks_module $ + listArray + (0, length ccs - 1) + ccs + else + return ce0 ) ce - mbs + mbss | otherwise = pure ce ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -64,6 +64,7 @@ import GHCi.RemoteTypes import GHC.ByteCode.Types import GHC.Linker.Loader as Loader +import GHC.Linker.Types (LinkerEnv(..)) import GHC.Hs @@ -126,6 +127,7 @@ import GHC.Tc.Utils.Instantiate (instDFunType) import GHC.Tc.Utils.Monad import GHC.IfaceToCore +import GHC.ByteCode.Breakpoints import Control.Monad import Data.Dynamic @@ -134,7 +136,7 @@ import Data.List (find,intercalate) import Data.List.NonEmpty (NonEmpty) import Unsafe.Coerce ( unsafeCoerce ) import qualified GHC.Unit.Home.Graph as HUG -import GHC.ByteCode.Breakpoints +import GHCi.BreakArray (BreakArray) -- ----------------------------------------------------------------------------- -- running a statement interactively @@ -348,13 +350,14 @@ handleRunStatus step expr bindings final_ids status history0 = do EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do let ibi = evalBreakpointToId eval_break let hug = hsc_HUG hsc_env - tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi) + tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi) + breakArray <- getBreakArray interp (toBreakpointId ibi) tick_brks let span = getBreakLoc ibi tick_brks decl = intercalate "." $ getBreakDecls ibi tick_brks -- Was this breakpoint explicitly enabled (ie. in @BreakArray@)? - bactive <- liftIO $ breakpointStatus interp (modBreaks_flags $ imodBreaks_modBreaks tick_brks) (ibi_tick_index ibi) + bactive <- liftIO $ breakpointStatus interp breakArray (ibi_tick_index ibi) apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt @@ -462,9 +465,24 @@ setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m () -- #191 setupBreakpoint interp bi cnt = do hug <- hsc_HUG <$> getSession modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi) - let breakarray = modBreaks_flags $ imodBreaks_modBreaks modBreaks - _ <- liftIO $ GHCi.storeBreakpoint interp breakarray (bi_tick_index bi) cnt - pure () + breakArray <- getBreakArray interp bi modBreaks + liftIO $ GHCi.storeBreakpoint interp breakArray (bi_tick_index bi) cnt + +getBreakArray :: GhcMonad m => Interp -> BreakpointId -> InternalModBreaks -> m (ForeignRef BreakArray) +getBreakArray interp BreakpointId{bi_tick_mod} imbs = do + + liftIO $ modifyLoaderState interp $ \ld_st -> do + let le = linker_env ld_st + + -- Recall that BreakArrays are allocated only at BCO link time, so if we + -- haven't linked the BCOs we intend to break at yet, we allocate the arrays here. + ba_env <- allocateBreakArrays interp (breakarray_env le) [imbs] + + return + ( ld_st { linker_env = le{breakarray_env = ba_env} } + , expectJust {- just computed -} $ + lookupModuleEnv ba_env bi_tick_mod + ) back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan) back n = moveHist (+n) ===================================== compiler/GHC/Runtime/Interpreter.hs-boot deleted ===================================== @@ -1,10 +0,0 @@ -module GHC.Runtime.Interpreter where - -import {-# SOURCE #-} GHC.Runtime.Interpreter.Types -import Data.Int (Int) -import GHC.Base (IO) -import GHCi.BreakArray (BreakArray) -import GHCi.RemoteTypes (ForeignRef) - -newBreakArray :: Interp -> Int -> IO (ForeignRef BreakArray) - ===================================== compiler/GHC/Runtime/Interpreter/Types.hs-boot deleted ===================================== @@ -1,6 +0,0 @@ -module GHC.Runtime.Interpreter.Types where - -import Data.Bool - -data Interp -interpreterProfiled :: Interp -> Bool ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -5,6 +5,7 @@ GHC.Builtin.Types GHC.Builtin.Types.Literals GHC.Builtin.Types.Prim GHC.Builtin.Uniques +GHC.ByteCode.Breakpoints GHC.ByteCode.Types GHC.Cmm.BlockId GHC.Cmm.CLabel @@ -110,6 +111,8 @@ GHC.Hs.Pat GHC.Hs.Specificity GHC.Hs.Type GHC.Hs.Utils +GHC.HsToCore.Breakpoints +GHC.HsToCore.Ticks GHC.Iface.Errors.Types GHC.Iface.Ext.Fields GHC.Iface.Flags @@ -150,7 +153,6 @@ GHC.Tc.Zonk.Monad GHC.Types.Annotations GHC.Types.Avail GHC.Types.Basic -GHC.Types.Breakpoint GHC.Types.CostCentre GHC.Types.CostCentre.State GHC.Types.Cpr ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -5,6 +5,7 @@ GHC.Builtin.Types GHC.Builtin.Types.Literals GHC.Builtin.Types.Prim GHC.Builtin.Uniques +GHC.ByteCode.Breakpoints GHC.ByteCode.Types GHC.Cmm.BlockId GHC.Cmm.CLabel @@ -114,8 +115,10 @@ GHC.Hs.Pat GHC.Hs.Specificity GHC.Hs.Type GHC.Hs.Utils +GHC.HsToCore.Breakpoints GHC.HsToCore.Errors.Types GHC.HsToCore.Pmc.Solver.Types +GHC.HsToCore.Ticks GHC.Iface.Errors.Types GHC.Iface.Ext.Fields GHC.Iface.Flags @@ -171,7 +174,6 @@ GHC.Tc.Zonk.Monad GHC.Types.Annotations GHC.Types.Avail GHC.Types.Basic -GHC.Types.Breakpoint GHC.Types.CompleteMatch GHC.Types.CostCentre GHC.Types.CostCentre.State View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5178fc25ee63483c67ce10f3b2e57a7… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5178fc25ee63483c67ce10f3b2e57a7… You're receiving this email because of your account on gitlab.haskell.org.

1 0