Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e9de9e0b by Sylvain Henry at 2025-05-23T15:12:34-04:00 Remove emptyModBreaks Remove emptyModBreaks and track the absence of ModBreaks with `Maybe ModBreaks`. It avoids testing for null pointers... - - - - - 8 changed files: - compiler/GHC.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/Runtime/Debugger/Breakpoints.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToByteCode.hs - ghc/GHCi/UI.hs Changes: ===================================== compiler/GHC.hs ===================================== @@ -1307,7 +1307,7 @@ typecheckModule pmod = do minf_instances = fixSafeInstances safe $ instEnvElts $ md_insts details, minf_iface = Nothing, minf_safe = safe, - minf_modBreaks = emptyModBreaks + minf_modBreaks = Nothing }} -- | Desugar a typechecked module. @@ -1461,7 +1461,7 @@ data ModuleInfo = ModuleInfo { minf_instances :: [ClsInst], minf_iface :: Maybe ModIface, minf_safe :: SafeHaskellMode, - minf_modBreaks :: ModBreaks + minf_modBreaks :: Maybe ModBreaks } -- We don't want HomeModInfo here, because a ModuleInfo applies -- to package modules too. @@ -1490,7 +1490,7 @@ getPackageModuleInfo hsc_env mdl minf_instances = error "getModuleInfo: instances for package module unimplemented", minf_iface = Just iface, minf_safe = getSafeMode $ mi_trust iface, - minf_modBreaks = emptyModBreaks + minf_modBreaks = Nothing })) availsToGlobalRdrEnv :: HasDebugCallStack => HscEnv -> Module -> [AvailInfo] -> IfGlobalRdrEnv @@ -1567,7 +1567,7 @@ modInfoIface = minf_iface modInfoSafe :: ModuleInfo -> SafeHaskellMode modInfoSafe = minf_safe -modInfoModBreaks :: ModuleInfo -> ModBreaks +modInfoModBreaks :: ModuleInfo -> Maybe ModBreaks modInfoModBreaks = minf_modBreaks isDictonaryId :: Id -> Bool ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -19,7 +19,7 @@ module GHC.ByteCode.Types , ItblEnv, ItblPtr(..) , AddrEnv, AddrPtr(..) , CgBreakInfo(..) - , ModBreaks (..), BreakIndex, emptyModBreaks + , ModBreaks (..), BreakIndex , CCostCentre , FlatBag, sizeFlatBag, fromSmallArray, elemsFlatBag ) where @@ -45,12 +45,11 @@ import Foreign import Data.Array import Data.ByteString (ByteString) import Data.IntMap (IntMap) -import qualified Data.IntMap as IntMap import qualified GHC.Exts.Heap as Heap import GHC.Stack.CCS import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList ) import GHC.Iface.Syntax -import Language.Haskell.Syntax.Module.Name (ModuleName, mkModuleNameFS) +import Language.Haskell.Syntax.Module.Name (ModuleName) import GHC.Unit.Types (UnitId(..)) -- ----------------------------------------------------------------------------- @@ -250,7 +249,7 @@ data CCostCentre -- | All the information about the breakpoints for a module data ModBreaks = ModBreaks - { modBreaks_flags :: ForeignRef BreakArray + { modBreaks_flags :: !(ForeignRef BreakArray) -- ^ The array of flags, one per breakpoint, -- indicating which breakpoints are enabled. , modBreaks_locs :: !(Array BreakIndex SrcSpan) @@ -281,20 +280,6 @@ seqModBreaks ModBreaks{..} = rnf modBreaks_module `seq` rnf modBreaks_module_unitid --- | Construct an empty ModBreaks -emptyModBreaks :: ModBreaks -emptyModBreaks = ModBreaks - { modBreaks_flags = error "ModBreaks.modBreaks_array not initialised" - -- ToDo: can we avoid this? - , modBreaks_locs = array (0,-1) [] - , modBreaks_vars = array (0,-1) [] - , modBreaks_decls = array (0,-1) [] - , modBreaks_ccs = array (0,-1) [] - , modBreaks_breakInfo = IntMap.empty - , modBreaks_module = mkModuleNameFS nilFS - , modBreaks_module_unitid = UnitId nilFS - } - {- Note [Field modBreaks_decls] ~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/HsToCore/Breakpoints.hs ===================================== @@ -18,6 +18,7 @@ import GHC.Utils.Outputable as Outputable import Data.List (intersperse) import Data.Array +import qualified Data.IntMap as IntMap -- | Initialize memory for breakpoint data that is shared between the bytecode -- generator and the interpreter. @@ -38,15 +39,16 @@ mkModBreaks interp mod extendedMixEntries 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 ] - return $ emptyModBreaks - { modBreaks_flags = breakArray - , modBreaks_locs = locsTicks - , modBreaks_vars = varsTicks - , modBreaks_decls = declsTicks - , modBreaks_ccs = ccs - , modBreaks_module = moduleName mod - , modBreaks_module_unitid = toUnitId $ moduleUnit mod - } + return $ ModBreaks + { modBreaks_flags = breakArray + , modBreaks_locs = locsTicks + , modBreaks_vars = varsTicks + , modBreaks_decls = declsTicks + , modBreaks_ccs = ccs + , modBreaks_breakInfo = IntMap.empty + , modBreaks_module = moduleName mod + , modBreaks_module_unitid = toUnitId $ moduleUnit mod + } mkCCSArray :: Interp -> Module -> Int -> [Tick] ===================================== compiler/GHC/Runtime/Debugger/Breakpoints.hs ===================================== @@ -145,15 +145,17 @@ resolveFunctionBreakpoint inp = do validateBP _ "" (Just _) = pure $ Just $ text "Function name is missing" validateBP _ fun_str (Just modl) = do isInterpr <- GHC.moduleIsInterpreted modl - (_, decls) <- getModBreak modl mb_err_msg <- case isInterpr of - False -> pure $ Just $ text "Module" <+> quotes (ppr modl) - <+> text "is not interpreted" - True -> case fun_str `elem` (intercalate "." <$> elems decls) of - False -> pure $ Just $ - text "No breakpoint found for" <+> quotes (text fun_str) - <+> text "in module" <+> quotes (ppr modl) - True -> pure Nothing + False -> pure $ Just $ text "Module" <+> quotes (ppr modl) <+> text "is not interpreted" + True -> do + mb_modbreaks <- getModBreak modl + let found = case mb_modbreaks of + Nothing -> False + Just mb -> fun_str `elem` (intercalate "." <$> elems (GHC.modBreaks_decls mb)) + if found + then pure Nothing + else pure $ Just $ text "No breakpoint found for" <+> quotes (text fun_str) + <+> text "in module" <+> quotes (ppr modl) pure mb_err_msg -- | The aim of this function is to find the breakpoints for all the RHSs of @@ -184,8 +186,7 @@ type TickArray = Array Int [(GHC.BreakIndex,RealSrcSpan)] makeModuleLineMap :: GhcMonad m => Module -> m (Maybe TickArray) makeModuleLineMap m = do mi <- GHC.getModuleInfo m - return $ - mkTickArray . assocs . GHC.modBreaks_locs . GHC.modInfoModBreaks <$> mi + return $ mkTickArray . assocs . GHC.modBreaks_locs <$> (GHC.modInfoModBreaks =<< mi) where mkTickArray :: [(BreakIndex, SrcSpan)] -> TickArray mkTickArray ticks @@ -195,15 +196,12 @@ makeModuleLineMap m = do max_line = foldr max 0 [ GHC.srcSpanEndLine sp | (_, RealSrcSpan sp _) <- ticks ] srcSpanLines pan = [ GHC.srcSpanStartLine pan .. GHC.srcSpanEndLine pan ] --- | Get the 'modBreaks_locs' and 'modBreaks_decls' of the given 'Module' +-- | Get the 'ModBreaks' of the given 'Module' when available getModBreak :: GHC.GhcMonad m - => Module -> m (Array Int SrcSpan, Array Int [String]) + => Module -> m (Maybe ModBreaks) getModBreak m = do mod_info <- fromMaybe (panic "getModBreak") <$> GHC.getModuleInfo m - let modBreaks = GHC.modInfoModBreaks mod_info - let ticks = GHC.modBreaks_locs modBreaks - let decls = GHC.modBreaks_decls modBreaks - return (ticks, decls) + pure $ GHC.modInfoModBreaks mod_info -------------------------------------------------------------------------------- -- Getting current breakpoint information ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -522,9 +522,8 @@ result_fs = fsLit "_result" -- | Read the 'ModBreaks' of the given home 'Module' from the 'HomeUnitGraph'. readModBreaks :: HscEnv -> Module -> IO ModBreaks -readModBreaks hsc_env mod = - getModBreaks . expectJust <$> - HUG.lookupHugByModule mod (hsc_HUG hsc_env) +readModBreaks hsc_env mod = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule mod (hsc_HUG hsc_env) + bindLocalsAtBreakpoint :: HscEnv ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -435,22 +435,24 @@ handleSeqHValueStatus interp unit_env eval_status = resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt let put x = putStrLn ("*** Ignoring breakpoint " ++ (showSDocUnsafe x)) + let nothing_case = put $ brackets . ppr $ mkGeneralSrcSpan (fsLit "<unknown>") case maybe_break of - Nothing -> + Nothing -> nothing_case -- Nothing case - should not occur! -- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq - put $ brackets . ppr $ - mkGeneralSrcSpan (fsLit "<unknown>") Just break -> do let bi = evalBreakpointToId break -- Just case: Stopped at a breakpoint, extract SrcSpan information -- from the breakpoint. - breaks_tick <- getModBreaks . expectJust <$> + mb_modbreaks <- getModBreaks . expectJust <$> lookupHugByModule (ibi_tick_mod bi) (ue_home_unit_graph unit_env) - put $ brackets . ppr $ - (modBreaks_locs breaks_tick) ! ibi_tick_index bi + case mb_modbreaks of + -- Nothing case - should not occur! We should have the appropriate + -- breakpoint information + Nothing -> nothing_case + Just modbreaks -> put $ brackets . ppr $ (modBreaks_locs modbreaks) ! ibi_tick_index bi -- resume the seq (:force) processing in the iserv process withForeignRef resume_ctxt_fhv $ \hval -> do @@ -737,14 +739,14 @@ fromEvalResult :: EvalResult a -> IO a fromEvalResult (EvalException e) = throwIO (fromSerializableException e) fromEvalResult (EvalSuccess a) = return a -getModBreaks :: HomeModInfo -> ModBreaks +getModBreaks :: HomeModInfo -> Maybe ModBreaks getModBreaks hmi | Just linkable <- homeModInfoByteCode hmi, -- The linkable may have 'DotO's as well; only consider BCOs. See #20570. [cbc] <- linkableBCOs linkable - = fromMaybe emptyModBreaks (bc_breaks cbc) + = bc_breaks cbc | otherwise - = emptyModBreaks -- probably object code + = Nothing -- probably object code -- | Interpreter uses Profiling way interpreterProfiled :: Interp -> Bool ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -439,8 +439,8 @@ schemeER_wrk d p rhs = schemeE d 0 p rhs -- -- If the breakpoint is inlined from another module, look it up in the home -- package table. --- If the module doesn't exist there, or its module pointer is null (which means --- that the 'ModBreaks' value is uninitialized), skip the instruction. +-- If the module doesn't exist there, or if the 'ModBreaks' value is +-- uninitialized, skip the instruction (i.e. return Nothing). break_info :: HscEnv -> Module -> @@ -449,18 +449,11 @@ break_info :: BcM (Maybe ModBreaks) break_info hsc_env mod current_mod current_mod_breaks | mod == current_mod - = pure $ check_mod_ptr =<< current_mod_breaks + = pure current_mod_breaks | otherwise = ioToBc (lookupHpt (hsc_HPT hsc_env) (moduleName mod)) >>= \case - Just hp -> pure $ check_mod_ptr (getModBreaks hp) + Just hp -> pure $ getModBreaks hp Nothing -> pure Nothing - where - check_mod_ptr mb - | mod_ptr <- modBreaks_module mb - , not $ nullFS $ moduleNameFS mod_ptr - = Just mb - | otherwise - = Nothing getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)] getVarOffSets platform depth env = map getOffSet ===================================== ghc/GHCi/UI.hs ===================================== @@ -3629,8 +3629,10 @@ completeBreakpoint = wrapCompleter spaces $ \w -> do -- #3000 -- Return all possible bids for a given Module bidsByModule :: GhciMonad m => [ModuleName] -> Module -> m [String] bidsByModule nonquals mod = do - (_, decls) <- getModBreak mod - let bids = nub $ declPath <$> elems decls + mb_decls <- fmap GHC.modBreaks_decls <$> getModBreak mod + let bids = case mb_decls of + Just decls -> nub $ declPath <$> elems decls + Nothing -> [] pure $ case (moduleName mod) `elem` nonquals of True -> bids False -> (combineModIdent (showModule mod)) <$> bids @@ -3656,11 +3658,14 @@ completeBreakpoint = wrapCompleter spaces $ \w -> do -- #3000 -- declarations. See Note [Field modBreaks_decls] in GHC.ByteCode.Types addNestedDecls :: GhciMonad m => (String, Module) -> m [String] addNestedDecls (ident, mod) = do - (_, decls) <- getModBreak mod - let (mod_str, topLvl, _) = splitIdent ident - ident_decls = [ elm | elm@(el : _) <- elems decls, el == topLvl ] - bids = nub $ declPath <$> ident_decls - pure $ map (combineModIdent mod_str) bids + mb_decls <- fmap GHC.modBreaks_decls <$> getModBreak mod + case mb_decls of + Nothing -> pure [] + Just decls -> do + let (mod_str, topLvl, _) = splitIdent ident + ident_decls = [ elm | elm@(el : _) <- elems decls, el == topLvl ] + bids = nub $ declPath <$> ident_decls + pure $ map (combineModIdent mod_str) bids completeModule = wrapIdentCompleterMod $ \w -> do hsc_env <- GHC.getSession @@ -4066,7 +4071,7 @@ breakById inp = do case mb_error of Left sdoc -> printForUser sdoc Right (mod, mod_info, fun_str) -> do - let modBreaks = GHC.modInfoModBreaks mod_info + let modBreaks = expectJust (GHC.modInfoModBreaks mod_info) findBreakAndSet mod $ \_ -> findBreakForBind fun_str modBreaks breakSyntax :: a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9de9e0bc2ac0ad6273fe6ee59608017... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9de9e0bc2ac0ad6273fe6ee59608017... You're receiving this email because of your account on gitlab.haskell.org.