| ... |
... |
@@ -9,6 +9,7 @@ import Prelude ((+), (-), Integral, div) |
|
9
|
9
|
import Control.Arrow ((>>>))
|
|
10
|
10
|
import Control.Exception (assert)
|
|
11
|
11
|
import Data.Eq ((==))
|
|
|
12
|
+import Data.Ord ((>=))
|
|
12
|
13
|
import Data.Bits (FiniteBits, finiteBitSize)
|
|
13
|
14
|
import Data.Function (($), id, (.))
|
|
14
|
15
|
import Data.Tuple (fst, uncurry)
|
| ... |
... |
@@ -106,7 +107,9 @@ pprOnDiskModuleByteCodeHash :: Fingerprint -> SDoc |
|
106
|
107
|
pprOnDiskModuleByteCodeHash = entry (text "hash") . ppr
|
|
107
|
108
|
|
|
108
|
109
|
-- | Constructs textual information about bytecode.
|
|
109
|
|
-pprCompiledByteCode :: Module -> CompiledByteCode -> SDoc
|
|
|
110
|
+pprCompiledByteCode :: Module -- ^ The enclosing module
|
|
|
111
|
+ -> CompiledByteCode -- ^ The bytecode
|
|
|
112
|
+ -> SDoc -- ^ The textual information
|
|
110
|
113
|
pprCompiledByteCode currentModule CompiledByteCode {..}
|
|
111
|
114
|
= vcat [
|
|
112
|
115
|
pprByteCodeObjects currentModule $ bc_bcos,
|
| ... |
... |
@@ -118,14 +121,18 @@ pprCompiledByteCode currentModule CompiledByteCode {..} |
|
118
|
121
|
]
|
|
119
|
122
|
|
|
120
|
123
|
-- | Constructs textual information about bytecode objects.
|
|
121
|
|
-pprByteCodeObjects :: Module -> FlatBag UnlinkedBCO -> SDoc
|
|
|
124
|
+pprByteCodeObjects :: Module -- ^ The enlosing module
|
|
|
125
|
+ -> FlatBag UnlinkedBCO -- ^ The bytecode objects
|
|
|
126
|
+ -> SDoc -- ^ The textual information
|
|
122
|
127
|
pprByteCodeObjects currentModule = entry (text "objects") .
|
|
123
|
128
|
vcatOrNone .
|
|
124
|
129
|
map (pprByteCodeObject currentModule) .
|
|
125
|
130
|
elemsFlatBag
|
|
126
|
131
|
|
|
127
|
132
|
-- | Constructs textual information about a single bytecode object.
|
|
128
|
|
-pprByteCodeObject :: Module -> UnlinkedBCO -> SDoc
|
|
|
133
|
+pprByteCodeObject :: Module -- ^ The enclosing module
|
|
|
134
|
+ -> UnlinkedBCO -- ^ The bytecode object
|
|
|
135
|
+ -> SDoc -- ^ The textual information
|
|
129
|
136
|
pprByteCodeObject currentModule byteCodeObject = case byteCodeObject of
|
|
130
|
137
|
UnlinkedBCO {..}
|
|
131
|
138
|
-> entry (text "ordinary object" <+> quotes (ppr unlinkedBCOName)) $
|
| ... |
... |
@@ -163,14 +170,18 @@ pprLiftedness :: Bool -> SDoc |
|
163
|
170
|
pprLiftedness = entry (text "lifted") . noOrYes
|
|
164
|
171
|
|
|
165
|
172
|
-- | Constructs textual information about literals.
|
|
166
|
|
-pprLiterals :: Module -> FlatBag BCONPtr -> SDoc
|
|
|
173
|
+pprLiterals :: Module -- ^ The enclosing module
|
|
|
174
|
+ -> FlatBag BCONPtr -- ^ The literals
|
|
|
175
|
+ -> SDoc -- ^ The textual information
|
|
167
|
176
|
pprLiterals currentModule = entry (text "literals") .
|
|
168
|
177
|
vcatOrNone .
|
|
169
|
178
|
map (pprLiteral currentModule) .
|
|
170
|
179
|
elemsFlatBag
|
|
171
|
180
|
|
|
172
|
181
|
-- | Constructs textual information about a single literal.
|
|
173
|
|
-pprLiteral :: Module -> BCONPtr -> SDoc
|
|
|
182
|
+pprLiteral :: Module -- ^ The enclosing module
|
|
|
183
|
+ -> BCONPtr -- ^ The literal
|
|
|
184
|
+ -> SDoc -- ^ The textual information
|
|
174
|
185
|
pprLiteral currentModule literal = case literal of
|
|
175
|
186
|
BCONPtrWord word
|
|
176
|
187
|
-> text "word" <+>
|
| ... |
... |
@@ -197,7 +208,7 @@ pprLiteral currentModule literal = case literal of |
|
197
|
208
|
-> text "cost center of breakpoint" <+>
|
|
198
|
209
|
pprInternalBreakpointID currentModule breakpointID
|
|
199
|
210
|
|
|
200
|
|
--- | Constructs textual information about some FFI info.
|
|
|
211
|
+-- | Constructs textual information about FFI info.
|
|
201
|
212
|
pprFFIInfo :: FFIInfo -> SDoc
|
|
202
|
213
|
pprFFIInfo FFIInfo {..}
|
|
203
|
214
|
= hsep (map (pprFFIType >>> (<+> text "->")) ffiInfoArgs) <+>
|
| ... |
... |
@@ -211,7 +222,10 @@ pprFFIType ffiType = assert (take 3 ident == "FFI") $ text (drop 3 ident) where |
|
211
|
222
|
ident = show ffiType
|
|
212
|
223
|
|
|
213
|
224
|
-- | Constructs textual information about the ID of a bytecode breakpoint.
|
|
214
|
|
-pprInternalBreakpointID :: Module -> InternalBreakpointId -> SDoc
|
|
|
225
|
+pprInternalBreakpointID
|
|
|
226
|
+ :: Module -- ^ The enclosing module
|
|
|
227
|
+ -> InternalBreakpointId -- ^ The ID of the bytecode breakpoint
|
|
|
228
|
+ -> SDoc -- ^ The textual information
|
|
215
|
229
|
pprInternalBreakpointID currentModule InternalBreakpointId {..}
|
|
216
|
230
|
| ibi_info_mod == currentModule = indexDoc
|
|
217
|
231
|
| otherwise = indexDoc <+>
|
| ... |
... |
@@ -223,14 +237,18 @@ pprInternalBreakpointID currentModule InternalBreakpointId {..} |
|
223
|
237
|
indexDoc = ppr ibi_info_index
|
|
224
|
238
|
|
|
225
|
239
|
-- | Constructs textual information about pointers.
|
|
226
|
|
-pprPointers :: Module -> FlatBag BCOPtr -> SDoc
|
|
|
240
|
+pprPointers :: Module -- ^ The enclosing module
|
|
|
241
|
+ -> FlatBag BCOPtr -- ^ The pointers
|
|
|
242
|
+ -> SDoc -- ^ The textual information
|
|
227
|
243
|
pprPointers currentModule = entry (text "utilized items") .
|
|
228
|
244
|
vcatOrNone .
|
|
229
|
245
|
map (pprPointer currentModule) .
|
|
230
|
246
|
elemsFlatBag
|
|
231
|
247
|
|
|
232
|
248
|
-- | Constructs textual information about a single pointer.
|
|
233
|
|
-pprPointer :: Module -> BCOPtr -> SDoc
|
|
|
249
|
+pprPointer :: Module -- ^ The enclosing module
|
|
|
250
|
+ -> BCOPtr -- ^ The pointer
|
|
|
251
|
+ -> SDoc -- ^ The textual information
|
|
234
|
252
|
pprPointer currentModule pointer = case pointer of
|
|
235
|
253
|
BCOPtrName name
|
|
236
|
254
|
-> text "item named" <+> quotes (ppr name)
|
| ... |
... |
@@ -279,21 +297,27 @@ pprTopLevelString stringName encodedString = entry (ppr stringName) $ |
|
279
|
297
|
encodedString
|
|
280
|
298
|
|
|
281
|
299
|
-- | Constructs textual information about breakpoints.
|
|
282
|
|
-pprBreakpoints :: Module -> Maybe InternalModBreaks -> SDoc
|
|
|
300
|
+pprBreakpoints :: Module -- ^ The enclosing module
|
|
|
301
|
+ -> Maybe InternalModBreaks -- ^ The breakpoints
|
|
|
302
|
+ -> SDoc -- ^ The textual information
|
|
283
|
303
|
pprBreakpoints currentModule
|
|
284
|
304
|
= entry (text "breakpoints") .
|
|
285
|
|
- maybe (text "<none>") (pprBreakpointsData currentModule)
|
|
|
305
|
+ maybe (text "<none>") (pprActualBreakpoints currentModule)
|
|
286
|
306
|
|
|
287
|
|
--- | Constructs textual information about a single breakpoint.
|
|
288
|
|
-pprBreakpointsData :: Module -> InternalModBreaks -> SDoc
|
|
289
|
|
-pprBreakpointsData currentModule InternalModBreaks {..}
|
|
|
307
|
+-- | Constructs textual information about actual breakpoints.
|
|
|
308
|
+pprActualBreakpoints :: Module -- ^ The enclosing module
|
|
|
309
|
+ -> InternalModBreaks -- ^ The actual breakpoints
|
|
|
310
|
+ -> SDoc -- ^ The textual information
|
|
|
311
|
+pprActualBreakpoints currentModule InternalModBreaks {..}
|
|
290
|
312
|
= vcat [
|
|
291
|
313
|
pprSourceBreakpoints currentModule $ imodBreaks_modBreaks,
|
|
292
|
314
|
pprByteCodeBreakpoints currentModule $ imodBreaks_breakInfo
|
|
293
|
315
|
]
|
|
294
|
316
|
|
|
295
|
317
|
-- | Constructs textual information about source breakpoints.
|
|
296
|
|
-pprSourceBreakpoints :: Module -> ModBreaks -> SDoc
|
|
|
318
|
+pprSourceBreakpoints :: Module -- ^ The enclosing module
|
|
|
319
|
+ -> ModBreaks -- ^ The source breakpoints
|
|
|
320
|
+ -> SDoc -- ^ The textual information
|
|
297
|
321
|
pprSourceBreakpoints currentModule ModBreaks {..}
|
|
298
|
322
|
= entry (text "source breakpoints") $
|
|
299
|
323
|
assert (modBreaks_module == currentModule) $
|
| ... |
... |
@@ -336,7 +360,9 @@ pprFreeVariables :: [OccName] -> SDoc |
|
336
|
360
|
pprFreeVariables = entry (text "free variables") . vcatOrNone . map ppr
|
|
337
|
361
|
|
|
338
|
362
|
-- | Constructs textual information about bytecode breakpoints.
|
|
339
|
|
-pprByteCodeBreakpoints :: Module -> IntMap CgBreakInfo -> SDoc
|
|
|
363
|
+pprByteCodeBreakpoints :: Module -- ^ The enclosing module
|
|
|
364
|
+ -> IntMap CgBreakInfo -- ^ The bytecode breakpoints
|
|
|
365
|
+ -> SDoc -- ^ The textual information
|
|
340
|
366
|
pprByteCodeBreakpoints currentModule
|
|
341
|
367
|
= entry (text "bytecode breakpoints") .
|
|
342
|
368
|
vcatOrNone .
|
| ... |
... |
@@ -344,7 +370,10 @@ pprByteCodeBreakpoints currentModule |
|
344
|
370
|
IntMap.toList
|
|
345
|
371
|
|
|
346
|
372
|
-- | Constructs textual information about a single bytecode breakpoint.
|
|
347
|
|
-pprByteCodeBreakpoint :: Module -> Int -> CgBreakInfo -> SDoc
|
|
|
373
|
+pprByteCodeBreakpoint :: Module -- ^ The enclosing module
|
|
|
374
|
+ -> Int -- ^ The index of the bytecode breakpoint
|
|
|
375
|
+ -> CgBreakInfo -- ^ The bytecode breakpoint
|
|
|
376
|
+ -> SDoc -- ^ The textual information
|
|
348
|
377
|
pprByteCodeBreakpoint currentModule ix CgBreakInfo {..}
|
|
349
|
378
|
= entry (text "bytecode breakpoint" <+> ppr ix) $
|
|
350
|
379
|
vcat [
|
| ... |
... |
@@ -392,15 +421,20 @@ pprVariableBinder (multiplicity, name, type_) |
|
392
|
421
|
-- | Constructs textual information about a source breakpoint corresponding to a
|
|
393
|
422
|
-- bytecode breakpoint.
|
|
394
|
423
|
pprCorrespondingSourceBreakpoint :: Module
|
|
|
424
|
+ -- ^ The enclosing module
|
|
395
|
425
|
-> Either InternalBreakLoc BreakpointId
|
|
|
426
|
+ -- ^ A reference to the source breakpoint
|
|
396
|
427
|
-> SDoc
|
|
|
428
|
+ -- ^ The textual information
|
|
397
|
429
|
pprCorrespondingSourceBreakpoint currentModule
|
|
398
|
430
|
= entry (text "corresponding source breakpoint") .
|
|
399
|
431
|
pprBreakpointID currentModule .
|
|
400
|
432
|
either internalBreakLoc id
|
|
401
|
433
|
|
|
402
|
434
|
-- | Constructs textual information about the ID of a source breakpoint.
|
|
403
|
|
-pprBreakpointID :: Module -> BreakpointId -> SDoc
|
|
|
435
|
+pprBreakpointID :: Module -- ^ The enclosing module
|
|
|
436
|
+ -> BreakpointId -- ^ The ID of the source breakpoint
|
|
|
437
|
+ -> SDoc -- ^ The textual information
|
|
404
|
438
|
pprBreakpointID currentModule BreakpointId {..}
|
|
405
|
439
|
| bi_tick_mod == currentModule = indexDoc
|
|
406
|
440
|
| otherwise = indexDoc <+>
|
| ... |
... |
@@ -422,14 +456,14 @@ pprStaticPointerTableEntry :: SptEntry -> SDoc |
|
422
|
456
|
pprStaticPointerTableEntry (SptEntry name fingerprint)
|
|
423
|
457
|
= ppr fingerprint <> text ":" <+> ppr name
|
|
424
|
458
|
|
|
425
|
|
--- | Constructs textual information about some HPC info.
|
|
|
459
|
+-- | Constructs textual information about HPC info.
|
|
426
|
460
|
pprHPCInfo :: Strict.Maybe ByteCodeHpcInfo -> SDoc
|
|
427
|
461
|
pprHPCInfo = entry (text "HPC information") .
|
|
428
|
|
- Strict.maybe (text "<none>") pprHPCInfoData
|
|
|
462
|
+ Strict.maybe (text "<none>") pprActualHPCInfo
|
|
429
|
463
|
|
|
430
|
|
--- | Constructs textual information about data that makes up some HPC info.
|
|
431
|
|
-pprHPCInfoData :: ByteCodeHpcInfo -> SDoc
|
|
432
|
|
-pprHPCInfoData ByteCodeHpcInfo {..}
|
|
|
464
|
+-- | Constructs textual information about actual HPC info.
|
|
|
465
|
+pprActualHPCInfo :: ByteCodeHpcInfo -> SDoc
|
|
|
466
|
+pprActualHPCInfo ByteCodeHpcInfo {..}
|
|
433
|
467
|
= vcat [
|
|
434
|
468
|
pprHPCInfoHash $ bchi_hash,
|
|
435
|
469
|
pprModuleName $ bchi_module_name,
|
| ... |
... |
@@ -438,7 +472,7 @@ pprHPCInfoData ByteCodeHpcInfo {..} |
|
438
|
472
|
]
|
|
439
|
473
|
where
|
|
440
|
474
|
|
|
441
|
|
--- | Constructs textual information about the hash of some HPC info.
|
|
|
475
|
+-- | Constructs textual information about the hash of HPC info.
|
|
442
|
476
|
pprHPCInfoHash :: Int -> SDoc
|
|
443
|
477
|
pprHPCInfoHash = entry (text "hash") . pprFixedSizeNatural
|
|
444
|
478
|
|