Rodrigo Mesquita pushed to branch wip/romes/step-out-11 at Glasgow Haskell Compiler / GHC

Commits:

11 changed files:

Changes:

  • compiler/GHC/ByteCode/Breakpoints.hs
    1 1 
     {-# LANGUAGE RecordWildCards #-}
    2 
    +{-# LANGUAGE DerivingStrategies #-}
    2 3
    3 4 
     -- | Breakpoint information constructed during ByteCode generation.
    4 5 
     --
    ... ... @@ -15,6 +16,7 @@ module GHC.ByteCode.Breakpoints
    15 16
    16 17 
         -- ** Internal breakpoint identifier
    17 18 
       , InternalBreakpointId(..), BreakInfoIndex
    19 
    +  , InternalBreakLoc(..)
    18 20
    19 21 
         -- * Operations
    20 22
    ... ... @@ -23,7 +25,7 @@ module GHC.ByteCode.Breakpoints
    23 25
    24 26 
         -- ** Source-level information operations
    25 27 
       , getBreakLoc, getBreakVars, getBreakDecls, getBreakCCS
    26 
    -  , getBreakSourceId
    28 
    +  , getBreakSourceId, getBreakSourceMod
    27 29
    28 30 
         -- * Utils
    29 31 
       , seqInternalModBreaks
    ... ... @@ -165,7 +167,7 @@ data CgBreakInfo
    165 167 
        { cgb_tyvars  :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
    166 168 
        , cgb_vars    :: ![Maybe (IfaceIdBndr, Word)]
    167 169 
        , cgb_resty   :: !IfaceType
    168 
    -   , cgb_tick_id :: !BreakpointId
    170 
    +   , cgb_tick_id :: !(Either InternalBreakLoc BreakpointId)
    169 171 
          -- ^ This field records the original breakpoint tick identifier for this
    170 172 
          -- internal breakpoint info. It is used to convert a breakpoint
    171 173 
          -- *occurrence* index ('InternalBreakpointId') into a *definition* index
    ... ... @@ -173,9 +175,19 @@ data CgBreakInfo
    173 175 
          --
    174 176 
          -- The modules of breakpoint occurrence and breakpoint definition are not
    175 177 
          -- necessarily the same: See Note [Breakpoint identifiers].
    178 
    +     --
    179 
    +     -- If there is no original tick identifier (that is, the breakpoint was
    180 
    +     -- created during code generation), instead refer directly to the SrcSpan
    181 
    +     -- we want to use for it. See Note [Internal Breakpoint Locations]
    176 182 
        }
    177 183 
     -- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
    178 184
    185 
    +-- | Breakpoints created during code generation don't have a source-level tick
    186 
    +-- location. Instead, we come up with one ourselves.
    187 
    +-- See Note [Internal Breakpoint Locations]
    188 
    +newtype InternalBreakLoc = InternalBreakLoc SrcSpan
    189 
    +  deriving newtype (Eq, Show, NFData, Outputable)
    190 
    +
    179 191 
     -- | Get an internal breakpoint info by 'InternalBreakpointId'
    180 192 
     getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
    181 193 
     getInternalBreak (InternalBreakpointId mod ix) imbs =
    ... ... @@ -196,27 +208,36 @@ assert_modules_match ibi_mod imbs_mod =
    196 208
    197 209 
     -- | Get the source module and tick index for this breakpoint
    198 210 
     -- (as opposed to the module where this breakpoint occurs, which is in 'InternalBreakpointId')
    199 
    -getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> BreakpointId
    211 
    +getBreakSourceId :: InternalBreakpointId -> InternalModBreaks -> Either InternalBreakLoc BreakpointId
    200 212 
     getBreakSourceId (InternalBreakpointId ibi_mod ibi_ix) imbs =
    201 213 
       assert_modules_match ibi_mod (imodBreaks_module imbs) $
    202 214 
         let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
    203 215 
          in cgb_tick_id cgb
    204 216
    217 
    +-- | Get the source module for this breakpoint (where the breakpoint is defined)
    218 
    +getBreakSourceMod :: InternalBreakpointId -> InternalModBreaks -> Module
    219 
    +getBreakSourceMod (InternalBreakpointId ibi_mod ibi_ix) imbs =
    220 
    +  assert_modules_match ibi_mod (imodBreaks_module imbs) $
    221 
    +    let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
    222 
    +     in case cgb_tick_id cgb of
    223 
    +      Left InternalBreakLoc{} -> imodBreaks_module imbs
    224 
    +      Right BreakpointId{bi_tick_mod} -> bi_tick_mod
    225 
    +
    205 226 
     -- | Get the source span for this breakpoint
    206 227 
     getBreakLoc :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO SrcSpan
    207 
    -getBreakLoc = getBreakXXX modBreaks_locs
    228 
    +getBreakLoc = getBreakXXX modBreaks_locs (\(InternalBreakLoc x) -> x)
    208 229
    209 230 
     -- | Get the vars for this breakpoint
    210 231 
     getBreakVars :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [OccName]
    211 
    -getBreakVars = getBreakXXX modBreaks_vars
    232 
    +getBreakVars = getBreakXXX modBreaks_vars (const [])
    212 233
    213 234 
     -- | Get the decls for this breakpoint
    214 235 
     getBreakDecls :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO [String]
    215 
    -getBreakDecls = getBreakXXX modBreaks_decls
    236 
    +getBreakDecls = getBreakXXX modBreaks_decls (const [])
    216 237
    217 238 
     -- | Get the decls for this breakpoint
    218 
    -getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (String, String)
    219 
    -getBreakCCS = getBreakXXX modBreaks_ccs
    239 
    +getBreakCCS :: (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO (Maybe (String, String))
    240 
    +getBreakCCS = getBreakXXX (fmap Just . modBreaks_ccs) (const Nothing)
    220 241
    221 242 
     -- | Internal utility to access a ModBreaks field at a particular breakpoint index
    222 243 
     --
    ... ... @@ -228,14 +249,17 @@ getBreakCCS = getBreakXXX modBreaks_ccs
    228 249 
     -- 'ModBreaks'. When the tick module is different, we need to look up the
    229 250 
     -- 'ModBreaks' in the HUG for that other module.
    230 251 
     --
    252 
    +-- When there is no tick module (the breakpoint was generated at codegen), use
    253 
    +-- the function on internal mod breaks.
    254 
    +--
    231 255 
     -- To avoid cyclic dependencies, we instead receive a function that looks up
    232 256 
     -- the 'ModBreaks' given a 'Module'
    233 
    -getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
    234 
    -getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
    257 
    +getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> (InternalBreakLoc -> a) -> (Module -> IO ModBreaks) -> InternalBreakpointId -> InternalModBreaks -> IO a
    258 
    +getBreakXXX view viewInternal lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
    235 259 
       assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
    236 260 
         let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
    237 261 
         case cgb_tick_id cgb of
    238 
    -      BreakpointId{bi_tick_mod, bi_tick_index}
    262 
    +      Right BreakpointId{bi_tick_mod, bi_tick_index}
    239 263 
             | bi_tick_mod == ibi_mod
    240 264 
             -> do
    241 265 
               let these_mbs = imodBreaks_modBreaks imbs
    ... ... @@ -244,6 +268,8 @@ getBreakXXX view lookupModule (InternalBreakpointId ibi_mod ibi_ix) imbs =
    244 268 
             -> do
    245 269 
               other_mbs <- lookupModule bi_tick_mod
    246 270 
               return $ view other_mbs ! bi_tick_index
    271 
    +      Left l ->
    272 
    +          return $ viewInternal l
    247 273
    248 274 
     --------------------------------------------------------------------------------
    249 275 
     -- Instances

  • compiler/GHC/Linker/Loader.hs
    ... ... @@ -58,6 +58,7 @@ import GHCi.RemoteTypes
    58 58 
     import GHC.Iface.Load
    59 59 
     import GHCi.Message (ConInfoTable(..), LoadedDLL)
    60 60
    61 
    +import GHC.ByteCode.Breakpoints
    61 62 
     import GHC.ByteCode.Linker
    62 63 
     import GHC.ByteCode.Asm
    63 64 
     import GHC.ByteCode.Types
    ... ... @@ -1711,8 +1712,10 @@ allocateCCS interp ce mbss
    1711 1712 
                   let count = 1 + (maybe 0 fst $ IM.lookupMax imodBreaks_breakInfo)
    1712 1713 
                   let ccs = IM.map
    1713 1714 
                         (\info ->
    1714 
    -                      fromMaybe (toRemotePtr nullPtr)
    1715 
    -                        (M.lookup (cgb_tick_id info) ccss)
    1715 
    +                      case cgb_tick_id info of
    1716 
    +                        Right bi -> fromMaybe (toRemotePtr nullPtr)
    1717 
    +                          (M.lookup bi ccss)
    1718 
    +                        Left InternalBreakLoc{} -> toRemotePtr nullPtr
    1716 1719 
                         )
    1717 1720 
                         imodBreaks_breakInfo
    1718 1721 
                   assertPpr (count == length ccs)

  • compiler/GHC/Runtime/Debugger/Breakpoints.hs
    ... ... @@ -253,8 +253,11 @@ mkBreakpointOccurrences = do
    253 253 
           let imod = modBreaks_module $ imodBreaks_modBreaks ibrks
    254 254 
           IntMap.foldrWithKey (\info_ix cgi bmp -> do
    255 255 
               let ibi = InternalBreakpointId imod info_ix
    256 
    -          let BreakpointId tick_mod tick_ix = cgb_tick_id cgi
    257 
    -          extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
    256 
    +          case cgb_tick_id cgi of
    257 
    +            Right (BreakpointId tick_mod tick_ix)
    258 
    +              -> extendModuleEnvWith (IntMap.unionWith (S.<>)) bmp tick_mod (IntMap.singleton tick_ix [ibi])
    259 
    +            Left _
    260 
    +              -> bmp
    258 261 
             ) bmp0 (imodBreaks_breakInfo ibrks)
    259 262
    260 263 
     --------------------------------------------------------------------------------
    ... ... @@ -287,7 +290,7 @@ getCurrentBreakModule = do
    287 290 
             Nothing -> pure Nothing
    288 291 
             Just ibi -> do
    289 292 
               brks <- readIModBreaks hug ibi
    290 
    -          return $ Just $ bi_tick_mod $ getBreakSourceId ibi brks
    293 
    +          return $ Just $ getBreakSourceMod ibi brks
    291 294 
           ix ->
    292 295 
               Just <$> getHistoryModule hug (resumeHistory r !! (ix-1))
    293 296

  • compiler/GHC/Runtime/Eval.hs
    ... ... @@ -151,7 +151,7 @@ getHistoryModule :: HUG.HomeUnitGraph -> History -> IO Module
    151 151 
     getHistoryModule hug hist = do
    152 152 
       let ibi = historyBreakpointId hist
    153 153 
       brks <- readIModBreaks hug ibi
    154 
    -  return $ bi_tick_mod $ getBreakSourceId ibi brks
    154 
    +  return $ getBreakSourceMod ibi brks
    155 155
    156 156 
     getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
    157 157 
     getHistorySpan hug hist = do

  • compiler/GHC/StgToByteCode.hs
    ... ... @@ -63,7 +63,7 @@ import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, idPrimRepU,
    63 63 
                                   assertNonVoidIds, assertNonVoidStgArgs )
    64 64 
     import GHC.StgToCmm.Layout
    65 65 
     import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
    66 
    -import GHC.Runtime.Interpreter ( interpreterProfiled )
    66 
    +import GHC.Runtime.Interpreter ( interpreterProfiled, readIModModBreaks )
    67 67 
     import GHC.Data.Bitmap
    68 68 
     import GHC.Data.FlatBag as FlatBag
    69 69 
     import GHC.Data.OrdList
    ... ... @@ -99,6 +99,7 @@ import GHC.CoreToIface
    99 99 
     import Control.Monad.IO.Class
    100 100 
     import Control.Monad.Trans.Reader (ReaderT(..))
    101 101 
     import Control.Monad.Trans.State  (StateT(..))
    102 
    +import Data.Array ((!))
    102 103
    103 104 
     -- -----------------------------------------------------------------------------
    104 105 
     -- Generating byte code for a complete module
    ... ... @@ -393,26 +394,30 @@ schemeR_wrk fvs nm original_body (args, body)
    393 394 
     -- | Introduce break instructions for ticked expressions.
    394 395 
     -- If no breakpoint information is available, the instruction is omitted.
    395 396 
     schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
    396 
    -schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
    397 
    -  code <- schemeE d 0 p rhs
    398 
    -  mb_current_mod_breaks <- getCurrentModBreaks
    399 
    -  case mb_current_mod_breaks of
    400 
    -    -- if we're not generating ModBreaks for this module for some reason, we
    401 
    -    -- can't store breakpoint occurrence information.
    402 
    -    Nothing -> pure code
    403 
    -    Just current_mod_breaks -> do
    404 
    -      platform <- profilePlatform <$> getProfile
    405 
    -      let idOffSets = getVarOffSets platform d p fvs
    406 
    -          ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
    407 
    -          toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
    408 
    -          toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
    409 
    -          breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
    410 
    -
    411 
    -      let info_mod = modBreaks_module current_mod_breaks
    412 
    -      infox <- newBreakInfo breakInfo
    397 
    +schemeER_wrk d p (StgTick bp@(Breakpoint tick_ty tick_id fvs) rhs) = do
    398 
    +  platform <- profilePlatform <$> getProfile
    399 
    +
    400 
    +  code <- case rhs of
    401 
    +    -- When we find a tick surrounding a case expression we introduce a new BRK_FUN
    402 
    +    -- instruction at the start of the case *continuation*, in addition to the
    403 
    +    -- usual BRK_FUN surrounding the StgCase)
    404 
    +    -- See Note [TODO]
    405 
    +    StgCase scrut bndr _ alts
    406 
    +      -> doCase d 0 p (Just bp) scrut bndr alts
    407 
    +    _ -> schemeE d 0 p rhs
    408 
    +
    409 
    +  let idOffSets = getVarOffSets platform d p fvs
    410 
    +      ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
    411 
    +      toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
    412 
    +      toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
    413 
    +      breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Right tick_id)
    414 
    +
    415 
    +  mibi <- newBreakInfo breakInfo
    416 
    +
    417 
    +  return $ case mibi of
    418 
    +    Nothing  -> code
    419 
    +    Just ibi -> BRK_FUN ibi `consOL` code
    413 420
    414 
    -      let breakInstr = BRK_FUN (InternalBreakpointId info_mod infox)
    415 
    -      return $ breakInstr `consOL` code
    416 421 
     schemeER_wrk d p rhs = schemeE d 0 p rhs
    417 422
    418 423 
     getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
    ... ... @@ -614,7 +619,7 @@ schemeE d s p (StgTick _ rhs) = schemeE d s p rhs
    614 619 
     schemeE d s p (StgCase scrut _ _ []) = schemeE d s p scrut
    615 620
    616 621 
     schemeE d s p (StgCase scrut bndr _ alts)
    617 
    -   = doCase d s p scrut bndr alts
    622 
    +   = doCase d s p Nothing scrut bndr alts
    618 623
    619 624
    620 625 
     {-
    ... ... @@ -1106,11 +1111,15 @@ doCase
    1106 1111 
         :: StackDepth
    1107 1112 
         -> Sequel
    1108 1113 
         -> BCEnv
    1114 
    +    -> Maybe StgTickish
    1115 
    +    -- ^ The breakpoint surrounding the full case expression, if any (only
    1116 
    +    -- source-level cases get breakpoint ticks, and those are the only we care
    1117 
    +    -- about). See Note [TODO]
    1109 1118 
         -> CgStgExpr
    1110 1119 
         -> Id
    1111 1120 
         -> [CgStgAlt]
    1112 1121 
         -> BcM BCInstrList
    1113 
    -doCase d s p scrut bndr alts
    1122 
    +doCase d s p m_bid scrut bndr alts
    1114 1123 
       = do
    1115 1124 
          profile <- getProfile
    1116 1125 
          hsc_env <- getHscEnv
    ... ... @@ -1325,19 +1334,35 @@ doCase d s p scrut bndr alts
    1325 1334 
                | ubx_tuple_frame    = SLIDE 0 3 `consOL` alt_final1
    1326 1335 
                | otherwise          = SLIDE 0 1 `consOL` alt_final1
    1327 1336
    1328 
    -         -- when `BRK_FUN` in a case continuation BCO executes,
    1329 
    -         -- the stack will already have a full continuation that just
    1330 
    -         -- re-executes the BCO being stopped at (including the stg_ret and
    1331 
    -         -- stg_ctoi frames)
    1332 
    -         --
    1333 
    -         -- right after the `BRK_FUN`, all case continuations will drop the
    1334 
    -         -- stg_ret and stg_ctoi headers (see alt_final1, alt_final2), leaving
    1335 
    -         -- the stack with the bound return values followed by the free variables
    1336 
    -         alt_final
    1337 
    -           | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
    1338 
    -                                -- See Note [Debugger: BRK_ALTS]
    1339 
    -                                = BRK_ALTS False `consOL` alt_final2
    1340 
    -           | otherwise          = alt_final2
    1337 
    +     -- when `BRK_FUN` in a case continuation BCO executes,
    1338 
    +     -- the stack will already have a full continuation that just
    1339 
    +     -- re-executes the BCO being stopped at (including the stg_ret and
    1340 
    +     -- stg_ctoi frames)
    1341 
    +     --
    1342 
    +     -- right after the `BRK_FUN`, all case continuations will drop the
    1343 
    +     -- stg_ret and stg_ctoi headers (see alt_final1, alt_final2), leaving
    1344 
    +     -- the stack with the bound return values followed by the free variables
    1345 
    +     alt_final <- case m_bid of
    1346 
    +       Just (Breakpoint tick_ty tick_id fvs)
    1347 
    +         | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env)
    1348 
    +         -- Construct an internal breakpoint to put at the start of this case
    1349 
    +         -- continuation BCO.
    1350 
    +         -- See Note [TODO]
    1351 
    +         -> do
    1352 
    +          internal_tick_loc <- makeCaseInternalBreakLoc tick_id
    1353 
    +
    1354 
    +          -- same fvs available in the case expression are available in the case continuation
    1355 
    +          let idOffSets = getVarOffSets platform d p fvs
    1356 
    +              ty_vars   = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
    1357 
    +              toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
    1358 
    +              toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
    1359 
    +              breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty (Left internal_tick_loc)
    1360 
    +
    1361 
    +          mibi <- newBreakInfo breakInfo
    1362 
    +          return $ case mibi of
    1363 
    +            Nothing  -> alt_final2
    1364 
    +            Just ibi -> BRK_FUN ibi `consOL` alt_final2
    1365 
    +       _ -> pure alt_final2
    1341 1366
    1342 1367 
          add_bco_name <- shouldAddBcoName
    1343 1368 
          let
    ... ... @@ -1357,6 +1382,24 @@ doCase d s p scrut bndr alts
    1357 1382 
                       _     -> panic "schemeE(StgCase).push_alts"
    1358 1383 
                 in return (PUSH_ALTS alt_bco scrut_rep `consOL` scrut_code)
    1359 1384
    1385 
    +makeCaseInternalBreakLoc :: BreakpointId -> BcM InternalBreakLoc
    1386 
    +makeCaseInternalBreakLoc bid = do
    1387 
    +  hug         <- hsc_HUG <$> getHscEnv
    1388 
    +  curr_mod    <- getCurrentModule
    1389 
    +  mb_mod_brks <- getCurrentModBreaks
    1390 
    +
    1391 
    +  -- TODO: Subtract the scrutinee loc from the case loc to get continuation loc
    1392 
    +  InternalBreakLoc <$> case bid of
    1393 
    +    BreakpointId{bi_tick_mod, bi_tick_index}
    1394 
    +      | bi_tick_mod == curr_mod
    1395 
    +      , Just these_mbs <- mb_mod_brks
    1396 
    +      -> do
    1397 
    +        return $ modBreaks_locs these_mbs ! bi_tick_index
    1398 
    +      | otherwise
    1399 
    +      -> do
    1400 
    +        other_mbs <- liftIO $ readIModModBreaks hug bi_tick_mod
    1401 
    +        return $ modBreaks_locs other_mbs ! bi_tick_index
    1402 
    +
    1360 1403 
     {-
    1361 1404 
     Note [Debugger: BRK_ALTS]
    1362 1405 
     ~~~~~~~~~~~~~~~~~~~~~~~~~
    ... ... @@ -2677,14 +2720,19 @@ getLabelsBc n = BcM $ \_ st ->
    2677 2720 
       let ctr = nextlabel st
    2678 2721 
        in return (coerce [ctr .. ctr+n-1], st{nextlabel = ctr+n})
    2679 2722
    2680 
    -newBreakInfo :: CgBreakInfo -> BcM Int
    2681 
    -newBreakInfo info = BcM $ \_ st ->
    2682 
    -  let ix = breakInfoIdx st
    2683 
    -      st' = st
    2684 
    -        { breakInfo = IntMap.insert ix info (breakInfo st)
    2685 
    -        , breakInfoIdx = ix + 1
    2686 
    -        }
    2687 
    -  in return (ix, st')
    2723 
    +newBreakInfo :: CgBreakInfo -> BcM (Maybe InternalBreakpointId)
    2724 
    +newBreakInfo info = BcM $ \env st -> do
    2725 
    +  -- if we're not generating ModBreaks for this module for some reason, we
    2726 
    +  -- can't store breakpoint occurrence information.
    2727 
    +  case modBreaks env of
    2728 
    +    Nothing -> pure (Nothing, st)
    2729 
    +    Just modBreaks -> do
    2730 
    +      let ix = breakInfoIdx st
    2731 
    +          st' = st
    2732 
    +            { breakInfo = IntMap.insert ix info (breakInfo st)
    2733 
    +            , breakInfoIdx = ix + 1
    2734 
    +            }
    2735 
    +      return (Just $ InternalBreakpointId (modBreaks_module modBreaks) ix, st')
    2688 2736
    2689 2737 
     getCurrentModule :: BcM Module
    2690 2738 
     getCurrentModule = BcM $ \env st -> return (bcm_module env, st)
    ... ... @@ -2697,7 +2745,7 @@ tickFS = fsLit "ticked"
    2697 2745
    2698 2746 
     -- Dehydrating CgBreakInfo
    2699 2747
    2700 
    -dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
    2748 
    +dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> Either InternalBreakLoc BreakpointId -> CgBreakInfo
    2701 2749 
     dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
    2702 2750 
               CgBreakInfo
    2703 2751 
                 { cgb_tyvars = map toIfaceTvBndr ty_vars

  • ghc/GHCi/UI.hs
    ... ... @@ -45,7 +45,7 @@ import GHC.Runtime.Eval (mkTopLevEnv)
    45 45 
     import GHC.Runtime.Eval.Utils
    46 46
    47 47 
     -- The GHC interface
    48 
    -import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId)
    48 
    +import GHC.ByteCode.Breakpoints (imodBreaks_modBreaks, InternalBreakpointId(..), getBreakSourceId, getBreakSourceMod)
    49 49 
     import GHC.Runtime.Interpreter
    50 50 
     import GHCi.RemoteTypes
    51 51 
     import GHCi.BreakArray( breakOn, breakOff )
    ... ... @@ -1621,7 +1621,7 @@ toBreakIdAndLocation (Just inf) = do
    1621 1621 
       brks <- liftIO $ readIModBreaks hug inf
    1622 1622 
       let bi = getBreakSourceId inf brks
    1623 1623 
       return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
    1624 
    -                                  breakId loc == bi ]
    1624 
    +                                  Right (breakId loc) == bi ]
    1625 1625
    1626 1626 
     printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
    1627 1627 
     printStoppedAtBreakInfo res names = do
    ... ... @@ -3825,7 +3825,7 @@ pprStopped res = do
    3825 3825 
           hug <- hsc_HUG <$> GHC.getSession
    3826 3826 
           brks <- liftIO $ readIModBreaks hug ibi
    3827 3827 
           return $ Just $ moduleName $
    3828 
    -        bi_tick_mod $ getBreakSourceId ibi brks
    3828 
    +        getBreakSourceMod ibi brks
    3829 3829 
       return $
    3830 3830 
         text "Stopped in"
    3831 3831 
           <+> ((case mb_mod_name of

  • testsuite/tests/ghci.debugger/scripts/T26042d2.hs
    1 
    +
    2 
    +module Main where
    3 
    +
    4 
    +main = do
    5 
    +  putStrLn "hello1"
    6 
    +  f
    7 
    +  putStrLn "hello3"
    8 
    +  putStrLn "hello4"
    9 
    +
    10 
    +f = do
    11 
    +  putStrLn "hello2.1"
    12 
    +  putStrLn "hello2.2"
    13 
    +{-# NOINLINE f #-}

  • testsuite/tests/ghci.debugger/scripts/T26042d2.script
    1 
    +:load T26042d2.hs
    2 
    +
    3 
    +:break 11
    4 
    +main
    5 
    +:list
    6 
    +:stepout
    7 
    +:list
    8 
    +:stepout
    9 
    +
    10 
    +-- should exit! we compile this test case with -O1 to make sure the monad >> are inlined
    11 
    +-- and thus the test relies on the filtering behavior based on SrcSpans for stepout
    12 
    +

  • testsuite/tests/ghci.debugger/scripts/T26042d2.stdout
    1 
    +Breakpoint 0 activated at T26042d2.hs:11:3-21
    2 
    +hello1
    3 
    +Stopped in Main.f, T26042d2.hs:11:3-21
    4 
    +_result ::
    5 
    +  GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld
    6 
    +  -> (# GHC.Internal.Prim.State# GHC.Internal.Prim.RealWorld,
    7 
    +        () #) = _
    8 
    +10  f = do
    9 
    +11    putStrLn "hello2.1"
    10 
    +      ^^^^^^^^^^^^^^^^^^^
    11 
    +12    putStrLn "hello2.2"
    12 
    +hello2.1
    13 
    +hello2.2
    14 
    +<--- should break here too
    15 
    +hello3
    16 
    +hello4

  • testsuite/tests/ghci.debugger/scripts/T26042g.stdout
    ... ... @@ -6,10 +6,13 @@ x :: Int = 14
    6 6 
     11  succ x = (-) (x - 2) (x + 1)
    7 7 
                  ^^^^^^^^^^^^^^^^^^^
    8 8 
     12
    9 
    -Stopped in T9.top, T26042g.hs:8:10-21
    9 
    +Stopped in T9., T26042g.hs:(6,3)-(8,21)
    10 10 
     _result :: Int = _
    11 
    +5  top = do
    12 
    +   vv
    13 
    +6    case succ 14 of
    11 14 
     7      5 -> 5
    12 15 
     8      _ -> 6 + other 55
    13 
    -            ^^^^^^^^^^^^
    16 
    +                        ^^
    14 17 
     9
    15 18 
     171

  • testsuite/tests/ghci.debugger/scripts/all.T
    ... ... @@ -147,8 +147,9 @@ test('T25932', extra_files(['T25932.hs']), ghci_script, ['T25932.script'])
    147 147
    148 148 
     # Step out tests
    149 149 
     test('T26042b', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042b.hs'])], ghci_script, ['T26042b.script'])
    150 
    -test('T26042c', [expect_broken(26042),extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
    150 
    +test('T26042c', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042c.hs'])], ghci_script, ['T26042c.script'])
    151 151 
     test('T26042d', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d.hs'])], ghci_script, ['T26042d.script'])
    152 
    +test('T26042d2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042d2.hs'])], ghci_script, ['T26042d2.script'])
    152 153 
     test('T26042e', extra_files(['T26042e.hs']), ghci_script, ['T26042e.script'])
    153 154 
     test('T26042f1', extra_files(['T26042f.hs', 'T26042f.script']), ghci_script, ['T26042f.script']) # >> is not inlined, so stepout has nowhere to stop
    154 155 
     test('T26042f2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), extra_files(['T26042f.hs', 'T26042f.script'])], ghci_script, ['T26042f.script'])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help