| ... |
... |
@@ -8,16 +8,29 @@ module GHC.ByteCode.Show (showByteCode) where |
|
8
|
8
|
import Prelude ((+), (-), Integral, div)
|
|
9
|
9
|
import Control.Arrow ((>>>))
|
|
10
|
10
|
import Control.Exception (assert)
|
|
11
|
|
-import Data.Eq ((==))
|
|
|
11
|
+import Data.Eq (Eq, (==))
|
|
|
12
|
+import Data.Ord ((<=))
|
|
12
|
13
|
import Data.Bits (FiniteBits, finiteBitSize)
|
|
13
|
14
|
import Data.Function (($), id, (.))
|
|
14
|
15
|
import Data.Tuple (fst, snd, uncurry)
|
|
15
|
16
|
import Data.Bool (Bool, otherwise, not, (&&))
|
|
16
|
17
|
import Data.Int (Int)
|
|
17
|
18
|
import Data.Word (Word)
|
|
18
|
|
-import Data.Maybe (Maybe, maybe)
|
|
|
19
|
+import Data.Maybe (Maybe (Nothing, Just), maybe)
|
|
19
|
20
|
import Data.Either (Either, either)
|
|
20
|
|
-import Data.List (length, (++), map, zipWith, zipWith5, take, drop, replicate)
|
|
|
21
|
+import Data.List
|
|
|
22
|
+ (
|
|
|
23
|
+ length,
|
|
|
24
|
+ (++),
|
|
|
25
|
+ repeat,
|
|
|
26
|
+ map,
|
|
|
27
|
+ zipWith,
|
|
|
28
|
+ zipWith5,
|
|
|
29
|
+ and,
|
|
|
30
|
+ take,
|
|
|
31
|
+ drop,
|
|
|
32
|
+ replicate
|
|
|
33
|
+ )
|
|
21
|
34
|
import Data.String (String)
|
|
22
|
35
|
import Data.ByteString (ByteString, unpack)
|
|
23
|
36
|
import Data.ByteString.Short (ShortByteString)
|
| ... |
... |
@@ -44,6 +57,7 @@ import GHC.Utils.Outputable |
|
44
|
57
|
(
|
|
45
|
58
|
defaultDumpStyle,
|
|
46
|
59
|
SDoc,
|
|
|
60
|
+ empty,
|
|
47
|
61
|
text,
|
|
48
|
62
|
(<>),
|
|
49
|
63
|
(<+>),
|
| ... |
... |
@@ -297,46 +311,56 @@ pprBreakpointsInSource :: Module -> ModBreaks -> SDoc |
|
297
|
311
|
pprBreakpointsInSource currentModule ModBreaks {..}
|
|
298
|
312
|
= entry (text "breakpoints in source:") $
|
|
299
|
313
|
assert (modBreaks_module == currentModule) $
|
|
300
|
|
- assert boundsAreIdentical $
|
|
|
314
|
+ assert boundsAreConsistent $
|
|
301
|
315
|
vcatOrNone $
|
|
302
|
316
|
zipWith5 pprBreakpointInSource (indices modBreaks_locs_)
|
|
303
|
317
|
(elems modBreaks_locs_)
|
|
304
|
318
|
(elems modBreaks_decls)
|
|
305
|
319
|
(elems modBreaks_vars)
|
|
306
|
|
- (elems modBreaks_ccs)
|
|
|
320
|
+ potentialCostCenterInfos
|
|
307
|
321
|
where
|
|
308
|
322
|
|
|
309
|
|
- boundsAreIdentical :: Bool
|
|
310
|
|
- boundsAreIdentical = bounds modBreaks_locs_ == bounds modBreaks_decls &&
|
|
311
|
|
- bounds modBreaks_locs_ == bounds modBreaks_vars &&
|
|
312
|
|
- bounds modBreaks_locs_ == bounds modBreaks_ccs
|
|
|
323
|
+ costCenterInfoIsPresent :: Bool
|
|
|
324
|
+ costCenterInfoIsPresent = fst (bounds modBreaks_ccs) <=
|
|
|
325
|
+ snd (bounds modBreaks_ccs)
|
|
|
326
|
+
|
|
|
327
|
+ boundsAreConsistent :: Bool
|
|
|
328
|
+ boundsAreConsistent
|
|
|
329
|
+ = allAreEqual $
|
|
|
330
|
+ [
|
|
|
331
|
+ bounds modBreaks_locs_,
|
|
|
332
|
+ bounds modBreaks_decls,
|
|
|
333
|
+ bounds modBreaks_vars
|
|
|
334
|
+ ] ++ if costCenterInfoIsPresent then [bounds modBreaks_ccs] else []
|
|
|
335
|
+ where
|
|
|
336
|
+
|
|
|
337
|
+ allAreEqual :: Eq a => [a] -> Bool
|
|
|
338
|
+ allAreEqual list = and $ zipWith (==) list (drop 1 list)
|
|
|
339
|
+
|
|
|
340
|
+ potentialCostCenterInfos :: [Maybe (ShortByteString, ShortByteString)]
|
|
|
341
|
+ potentialCostCenterInfos
|
|
|
342
|
+ | costCenterInfoIsPresent = map Just (elems modBreaks_ccs)
|
|
|
343
|
+ | otherwise = repeat Nothing
|
|
313
|
344
|
|
|
314
|
345
|
-- | […]
|
|
315
|
346
|
pprBreakpointInSource :: BreakTickIndex
|
|
316
|
347
|
-> BinSrcSpan
|
|
317
|
348
|
-> [String]
|
|
318
|
349
|
-> [OccName]
|
|
319
|
|
- -> (ShortByteString, ShortByteString)
|
|
|
350
|
+ -> Maybe (ShortByteString, ShortByteString)
|
|
320
|
351
|
-> SDoc
|
|
321
|
|
-pprBreakpointInSource ix srcSpan declarationPath freeVars costCenterInfo
|
|
|
352
|
+pprBreakpointInSource ix
|
|
|
353
|
+ srcSpan
|
|
|
354
|
+ declarationPath
|
|
|
355
|
+ freeVars
|
|
|
356
|
+ potentialCostCenterInfo
|
|
322
|
357
|
= entry (text "breakpoint" <+> ppr ix <> text ":") $
|
|
323
|
358
|
vcat [
|
|
324
|
|
- pprSrcSpan $ srcSpan,
|
|
325
|
|
- pprDeclarationPath $ declarationPath,
|
|
326
|
|
- pprFreeVariables $ freeVars,
|
|
327
|
|
- pprCostCenterPath $ costCenterPath,
|
|
328
|
|
- pprCostCenterLocation $ costCenterLocation
|
|
|
359
|
+ pprSrcSpan $ srcSpan,
|
|
|
360
|
+ pprDeclarationPath $ declarationPath,
|
|
|
361
|
+ pprFreeVariables $ freeVars,
|
|
|
362
|
+ pprPotentialCostCenterInfo $ potentialCostCenterInfo
|
|
329
|
363
|
]
|
|
330
|
|
- where
|
|
331
|
|
-
|
|
332
|
|
- costCenterPath :: String
|
|
333
|
|
- costCenterPath = utf8DecodeShortByteString (fst costCenterInfo)
|
|
334
|
|
-
|
|
335
|
|
- costCenterLocation :: String
|
|
336
|
|
- costCenterLocation = utf8DecodeShortByteString (snd costCenterInfo)
|
|
337
|
|
-
|
|
338
|
|
- -- The structure of the cost center information is apparent from the
|
|
339
|
|
- -- implementation of 'GHC.HsToCore.Breakpoints.mkModBreaks'.
|
|
340
|
364
|
|
|
341
|
365
|
-- | […]
|
|
342
|
366
|
pprSrcSpan :: BinSrcSpan -> SDoc
|
| ... |
... |
@@ -350,6 +374,26 @@ pprDeclarationPath = entry (text "declaration path:") . vcat . map text |
|
350
|
374
|
pprFreeVariables :: [OccName] -> SDoc
|
|
351
|
375
|
pprFreeVariables = entry (text "free variables:") . hsep . map ppr
|
|
352
|
376
|
|
|
|
377
|
+-- | […]
|
|
|
378
|
+pprPotentialCostCenterInfo :: Maybe (ShortByteString, ShortByteString) -> SDoc
|
|
|
379
|
+pprPotentialCostCenterInfo Nothing
|
|
|
380
|
+ = empty
|
|
|
381
|
+pprPotentialCostCenterInfo (Just costCenterInfo)
|
|
|
382
|
+ = vcat [
|
|
|
383
|
+ pprCostCenterPath $ costCenterPath,
|
|
|
384
|
+ pprCostCenterLocation $ costCenterLocation
|
|
|
385
|
+ ]
|
|
|
386
|
+ where
|
|
|
387
|
+
|
|
|
388
|
+ costCenterPath :: String
|
|
|
389
|
+ costCenterPath = utf8DecodeShortByteString (fst costCenterInfo)
|
|
|
390
|
+
|
|
|
391
|
+ costCenterLocation :: String
|
|
|
392
|
+ costCenterLocation = utf8DecodeShortByteString (snd costCenterInfo)
|
|
|
393
|
+
|
|
|
394
|
+ -- The structure of the cost center information is apparent from the
|
|
|
395
|
+ -- implementation of 'GHC.HsToCore.Breakpoints.mkModBreaks'.
|
|
|
396
|
+
|
|
353
|
397
|
-- | […]
|
|
354
|
398
|
pprCostCenterPath :: String -> SDoc
|
|
355
|
399
|
pprCostCenterPath = entry (text "cost center path:") . text
|