| ... |
... |
@@ -11,7 +11,7 @@ import Control.Exception (assert) |
|
11
|
11
|
import Data.Eq ((==))
|
|
12
|
12
|
import Data.Bits (FiniteBits, finiteBitSize)
|
|
13
|
13
|
import Data.Function (($), id, (.))
|
|
14
|
|
-import Data.Tuple (uncurry)
|
|
|
14
|
+import Data.Tuple (fst, uncurry)
|
|
15
|
15
|
import Data.Bool (Bool, otherwise, not)
|
|
16
|
16
|
import Data.Int (Int)
|
|
17
|
17
|
import Data.Word (Word)
|
| ... |
... |
@@ -191,7 +191,7 @@ pprLiteral currentModule literal = case literal of |
|
191
|
191
|
-> text "foreign function" <+>
|
|
192
|
192
|
quotes (pprFFIInfo ffiInfo)
|
|
193
|
193
|
BCONPtrCostCentre breakpointID
|
|
194
|
|
- -> text "cost center" <+>
|
|
|
194
|
+ -> text "cost center of breakpoint" <+>
|
|
195
|
195
|
pprInternalBreakpointID currentModule breakpointID
|
|
196
|
196
|
|
|
197
|
197
|
-- | […]
|
| ... |
... |
@@ -285,35 +285,35 @@ pprBreakpoints currentModule |
|
285
|
285
|
pprBreakpointsData :: Module -> InternalModBreaks -> SDoc
|
|
286
|
286
|
pprBreakpointsData currentModule InternalModBreaks {..}
|
|
287
|
287
|
= vcat [
|
|
288
|
|
- pprBreakpointsInSource currentModule $ imodBreaks_modBreaks,
|
|
289
|
|
- pprBreakpointsInByteCode currentModule $ imodBreaks_breakInfo
|
|
|
288
|
+ pprSourceBreakpoints currentModule $ imodBreaks_modBreaks,
|
|
|
289
|
+ pprByteCodeBreakpoints currentModule $ imodBreaks_breakInfo
|
|
290
|
290
|
]
|
|
291
|
291
|
|
|
292
|
292
|
-- | […]
|
|
293
|
|
-pprBreakpointsInSource :: Module -> ModBreaks -> SDoc
|
|
294
|
|
-pprBreakpointsInSource currentModule ModBreaks {..}
|
|
295
|
|
- = entry (text "breakpoints in source") $
|
|
|
293
|
+pprSourceBreakpoints :: Module -> ModBreaks -> SDoc
|
|
|
294
|
+pprSourceBreakpoints currentModule ModBreaks {..}
|
|
|
295
|
+ = entry (text "source breakpoints") $
|
|
296
|
296
|
assert (modBreaks_module == currentModule) $
|
|
297
|
297
|
assert (bounds modBreaks_locs_ == bounds modBreaks_decls) $
|
|
298
|
298
|
assert (bounds modBreaks_locs_ == bounds modBreaks_vars) $
|
|
299
|
299
|
vcatOrNone $
|
|
300
|
|
- zipWith4 pprBreakpointInSource (indices modBreaks_locs_)
|
|
301
|
|
- (elems modBreaks_locs_)
|
|
302
|
|
- (elems modBreaks_decls)
|
|
303
|
|
- (elems modBreaks_vars)
|
|
|
300
|
+ zipWith4 pprSourceBreakpoint (indices modBreaks_locs_)
|
|
|
301
|
+ (elems modBreaks_locs_)
|
|
|
302
|
+ (elems modBreaks_decls)
|
|
|
303
|
+ (elems modBreaks_vars)
|
|
304
|
304
|
-- The cost center infos in `modBreaks_ccs`, when present, just contain
|
|
305
|
305
|
-- textual representations of the declaration paths in `modBreaks_decls`
|
|
306
|
306
|
-- and the source spans in `modBreaks_locs_` and are therefore never
|
|
307
|
307
|
-- shown.
|
|
308
|
308
|
|
|
309
|
309
|
-- | […]
|
|
310
|
|
-pprBreakpointInSource :: BreakTickIndex
|
|
311
|
|
- -> BinSrcSpan
|
|
312
|
|
- -> [String]
|
|
313
|
|
- -> [OccName]
|
|
314
|
|
- -> SDoc
|
|
315
|
|
-pprBreakpointInSource ix srcSpan declarationPath freeVars
|
|
316
|
|
- = entry (text "breakpoint" <+> ppr ix) $
|
|
|
310
|
+pprSourceBreakpoint :: BreakTickIndex
|
|
|
311
|
+ -> BinSrcSpan
|
|
|
312
|
+ -> [String]
|
|
|
313
|
+ -> [OccName]
|
|
|
314
|
+ -> SDoc
|
|
|
315
|
+pprSourceBreakpoint ix srcSpan declarationPath freeVars
|
|
|
316
|
+ = entry (text "source breakpoint" <+> ppr ix) $
|
|
317
|
317
|
vcat [
|
|
318
|
318
|
pprSrcSpan $ srcSpan,
|
|
319
|
319
|
pprDeclarationPath $ declarationPath,
|
| ... |
... |
@@ -333,22 +333,22 @@ pprFreeVariables :: [OccName] -> SDoc |
|
333
|
333
|
pprFreeVariables = entry (text "free variables") . vcatOrNone . map ppr
|
|
334
|
334
|
|
|
335
|
335
|
-- | […]
|
|
336
|
|
-pprBreakpointsInByteCode :: Module -> IntMap CgBreakInfo -> SDoc
|
|
337
|
|
-pprBreakpointsInByteCode currentModule
|
|
338
|
|
- = entry (text "breakpoints in bytecode") .
|
|
339
|
|
- vcatOrNone .
|
|
340
|
|
- map (uncurry (pprBreakpointInByteCode currentModule)) .
|
|
|
336
|
+pprByteCodeBreakpoints :: Module -> IntMap CgBreakInfo -> SDoc
|
|
|
337
|
+pprByteCodeBreakpoints currentModule
|
|
|
338
|
+ = entry (text "bytecode breakpoints") .
|
|
|
339
|
+ vcatOrNone .
|
|
|
340
|
+ map (uncurry (pprByteCodeBreakpoint currentModule)) .
|
|
341
|
341
|
IntMap.toList
|
|
342
|
342
|
|
|
343
|
343
|
-- | […]
|
|
344
|
|
-pprBreakpointInByteCode :: Module -> Int -> CgBreakInfo -> SDoc
|
|
345
|
|
-pprBreakpointInByteCode currentModule ix CgBreakInfo {..}
|
|
346
|
|
- = entry (text "breakpoint" <+> ppr ix) $
|
|
|
344
|
+pprByteCodeBreakpoint :: Module -> Int -> CgBreakInfo -> SDoc
|
|
|
345
|
+pprByteCodeBreakpoint currentModule ix CgBreakInfo {..}
|
|
|
346
|
+ = entry (text "bytecode breakpoint" <+> ppr ix) $
|
|
347
|
347
|
vcat [
|
|
348
|
|
- pprType $ cgb_resty,
|
|
349
|
|
- pprTypeVariables $ cgb_tyvars,
|
|
350
|
|
- pprVariables $ cgb_vars,
|
|
351
|
|
- pprOrigin currentModule $ cgb_tick_id
|
|
|
348
|
+ pprType $ cgb_resty,
|
|
|
349
|
+ pprTypeVariables $ cgb_tyvars,
|
|
|
350
|
+ pprVariables $ cgb_vars,
|
|
|
351
|
+ pprCorrespondingSourceBreakpoint currentModule $ cgb_tick_id
|
|
352
|
352
|
]
|
|
353
|
353
|
-- That the 'cgb_resty' field holds the type of the breakpoint is apparent
|
|
354
|
354
|
-- from the fact that this field is set by
|
| ... |
... |
@@ -377,15 +377,7 @@ pprVariables = entry (text "variables") . vcatOrNone . map pprVariable |
|
377
|
377
|
|
|
378
|
378
|
-- | […]
|
|
379
|
379
|
pprVariable :: Maybe (IfaceIdBndr, Word) -> SDoc
|
|
380
|
|
-pprVariable = maybe (text "<unknown>") (uncurry pprKnownVariable)
|
|
381
|
|
-
|
|
382
|
|
-pprKnownVariable :: IfaceIdBndr -> Word -> SDoc
|
|
383
|
|
-pprKnownVariable binder offset = pprVariableBinder binder <+>
|
|
384
|
|
- text "@" <+>
|
|
385
|
|
- ppr offset
|
|
386
|
|
--- That the second argument is an offset is apparent from the use of the
|
|
387
|
|
--- identifier @offset@ in the implementation of
|
|
388
|
|
--- 'GHC.StgToByteCode.dehydrateCgBreakInfo'.
|
|
|
380
|
+pprVariable = maybe (text "<unknown>") (pprVariableBinder . fst)
|
|
389
|
381
|
|
|
390
|
382
|
-- | […]
|
|
391
|
383
|
pprVariableBinder :: IfaceIdBndr -> SDoc
|
| ... |
... |
@@ -393,10 +385,13 @@ pprVariableBinder (multiplicity, name, type_) |
|
393
|
385
|
= text "%" <> ppr multiplicity <+>
|
|
394
|
386
|
ppr name <+> text "::" <+> ppr type_
|
|
395
|
387
|
|
|
396
|
|
-pprOrigin :: Module -> Either InternalBreakLoc BreakpointId -> SDoc
|
|
397
|
|
-pprOrigin currentModule = entry (text "origin") .
|
|
398
|
|
- pprBreakpointID currentModule .
|
|
399
|
|
- either internalBreakLoc id
|
|
|
388
|
+pprCorrespondingSourceBreakpoint :: Module
|
|
|
389
|
+ -> Either InternalBreakLoc BreakpointId
|
|
|
390
|
+ -> SDoc
|
|
|
391
|
+pprCorrespondingSourceBreakpoint currentModule
|
|
|
392
|
+ = entry (text "corresponding source breakpoint") .
|
|
|
393
|
+ pprBreakpointID currentModule .
|
|
|
394
|
+ either internalBreakLoc id
|
|
400
|
395
|
|
|
401
|
396
|
-- | […] [analogous to 'pprInternalBreakpointID' but the meaning of the index is different]
|
|
402
|
397
|
pprBreakpointID :: Module -> BreakpointId -> SDoc
|