| ... |
... |
@@ -110,36 +110,36 @@ pprOnDiskModuleByteCodeHash = entry (text "hash") . ppr |
|
110
|
110
|
pprCompiledByteCode :: Module -- ^ The enclosing module
|
|
111
|
111
|
-> CompiledByteCode -- ^ The bytecode
|
|
112
|
112
|
-> SDoc -- ^ The textual information
|
|
113
|
|
-pprCompiledByteCode currentModule CompiledByteCode {..}
|
|
|
113
|
+pprCompiledByteCode current_module CompiledByteCode {..}
|
|
114
|
114
|
= vcat [
|
|
115
|
|
- pprByteCodeObjects currentModule $ bc_bcos,
|
|
116
|
|
- pprDataConstructorInfoTables $ bc_itbls,
|
|
117
|
|
- pprTopLevelStrings $ bc_strs,
|
|
118
|
|
- pprBreakpoints currentModule $ bc_breaks,
|
|
119
|
|
- pprStaticPointerTableEntries $ bc_spt_entries,
|
|
120
|
|
- pprHPCInfo $ bc_hpc_info
|
|
|
115
|
+ pprByteCodeObjects current_module $ bc_bcos,
|
|
|
116
|
+ pprDataConstructorInfoTables $ bc_itbls,
|
|
|
117
|
+ pprTopLevelStrings $ bc_strs,
|
|
|
118
|
+ pprBreakpoints current_module $ bc_breaks,
|
|
|
119
|
+ pprStaticPointerTableEntries $ bc_spt_entries,
|
|
|
120
|
+ pprHPCInfo $ bc_hpc_info
|
|
121
|
121
|
]
|
|
122
|
122
|
|
|
123
|
123
|
-- | Constructs textual information about bytecode objects.
|
|
124
|
124
|
pprByteCodeObjects :: Module -- ^ The enlosing module
|
|
125
|
125
|
-> FlatBag UnlinkedBCO -- ^ The bytecode objects
|
|
126
|
126
|
-> SDoc -- ^ The textual information
|
|
127
|
|
-pprByteCodeObjects currentModule = entry (text "objects") .
|
|
128
|
|
- vcatOrNone .
|
|
129
|
|
- map (pprByteCodeObject currentModule) .
|
|
130
|
|
- elemsFlatBag
|
|
|
127
|
+pprByteCodeObjects current_module = entry (text "objects") .
|
|
|
128
|
+ vcatOrNone .
|
|
|
129
|
+ map (pprByteCodeObject current_module) .
|
|
|
130
|
+ elemsFlatBag
|
|
131
|
131
|
|
|
132
|
132
|
-- | Constructs textual information about a single bytecode object.
|
|
133
|
133
|
pprByteCodeObject :: Module -- ^ The enclosing module
|
|
134
|
134
|
-> UnlinkedBCO -- ^ The bytecode object
|
|
135
|
135
|
-> SDoc -- ^ The textual information
|
|
136
|
|
-pprByteCodeObject currentModule byteCodeObject = case byteCodeObject of
|
|
|
136
|
+pprByteCodeObject current_module byte_code_object = case byte_code_object of
|
|
137
|
137
|
UnlinkedBCO {..}
|
|
138
|
138
|
-> entry (text "ordinary object" <+> quotes (ppr unlinkedBCOName)) $
|
|
139
|
139
|
vcat [
|
|
140
|
|
- pprArity $ unlinkedBCOArity,
|
|
141
|
|
- pprLiterals currentModule $ unlinkedBCOLits,
|
|
142
|
|
- pprPointers currentModule $ unlinkedBCOPtrs
|
|
|
140
|
+ pprArity $ unlinkedBCOArity,
|
|
|
141
|
+ pprLiterals current_module $ unlinkedBCOLits,
|
|
|
142
|
+ pprPointers current_module $ unlinkedBCOPtrs
|
|
143
|
143
|
]
|
|
144
|
144
|
UnlinkedStaticCon {..}
|
|
145
|
145
|
-> entry (
|
| ... |
... |
@@ -148,11 +148,15 @@ pprByteCodeObject currentModule byteCodeObject = case byteCodeObject of |
|
148
|
148
|
)
|
|
149
|
149
|
$
|
|
150
|
150
|
vcat [
|
|
151
|
|
- pprDataConstructorName $ unlinkedStaticConDataConName,
|
|
152
|
|
- pprLiftedness $ not unlinkedStaticConIsUnlifted,
|
|
153
|
|
- pprLiterals currentModule $ unlinkedStaticConLits,
|
|
154
|
|
- pprPointers currentModule $ unlinkedStaticConPtrs
|
|
|
151
|
+ pprDataConstructorName $ unlinkedStaticConDataConName,
|
|
|
152
|
+ pprLiftedness $ isLifted,
|
|
|
153
|
+ pprLiterals current_module $ unlinkedStaticConLits,
|
|
|
154
|
+ pprPointers current_module $ unlinkedStaticConPtrs
|
|
155
|
155
|
]
|
|
|
156
|
+ where
|
|
|
157
|
+
|
|
|
158
|
+ isLifted :: Bool
|
|
|
159
|
+ isLifted = not unlinkedStaticConIsUnlifted
|
|
156
|
160
|
|
|
157
|
161
|
-- | Constructs textual information about the arity of an ordinary bytecode
|
|
158
|
162
|
-- object.
|
| ... |
... |
@@ -173,16 +177,16 @@ pprLiftedness = entry (text "lifted") . noOrYes |
|
173
|
177
|
pprLiterals :: Module -- ^ The enclosing module
|
|
174
|
178
|
-> FlatBag BCONPtr -- ^ The literals
|
|
175
|
179
|
-> SDoc -- ^ The textual information
|
|
176
|
|
-pprLiterals currentModule = entry (text "literals") .
|
|
177
|
|
- vcatOrNone .
|
|
178
|
|
- map (pprLiteral currentModule) .
|
|
179
|
|
- elemsFlatBag
|
|
|
180
|
+pprLiterals current_module = entry (text "literals") .
|
|
|
181
|
+ vcatOrNone .
|
|
|
182
|
+ map (pprLiteral current_module) .
|
|
|
183
|
+ elemsFlatBag
|
|
180
|
184
|
|
|
181
|
185
|
-- | Constructs textual information about a single literal.
|
|
182
|
186
|
pprLiteral :: Module -- ^ The enclosing module
|
|
183
|
187
|
-> BCONPtr -- ^ The literal
|
|
184
|
188
|
-> SDoc -- ^ The textual information
|
|
185
|
|
-pprLiteral currentModule literal = case literal of
|
|
|
189
|
+pprLiteral current_module literal = case literal of
|
|
186
|
190
|
BCONPtrWord word
|
|
187
|
191
|
-> text "word" <+>
|
|
188
|
192
|
ppr word
|
| ... |
... |
@@ -195,9 +199,9 @@ pprLiteral currentModule literal = case literal of |
|
195
|
199
|
BCONPtrAddr addrName
|
|
196
|
200
|
-> text "address" <+>
|
|
197
|
201
|
quotes (ppr addrName)
|
|
198
|
|
- BCONPtrStr encodedString
|
|
|
202
|
+ BCONPtrStr encoded_string
|
|
199
|
203
|
-> text "top-level string" <+>
|
|
200
|
|
- text (show (utf8DecodeByteString encodedString))
|
|
|
204
|
+ text (show (utf8DecodeByteString encoded_string))
|
|
201
|
205
|
BCONPtrFS string
|
|
202
|
206
|
-> text "top-level string" <+>
|
|
203
|
207
|
text (show (unpackFS string))
|
| ... |
... |
@@ -206,7 +210,7 @@ pprLiteral currentModule literal = case literal of |
|
206
|
210
|
quotes (pprFFIInfo ffiInfo)
|
|
207
|
211
|
BCONPtrCostCentre breakpointID
|
|
208
|
212
|
-> text "cost center of breakpoint" <+>
|
|
209
|
|
- pprInternalBreakpointID currentModule breakpointID
|
|
|
213
|
+ pprInternalBreakpointID current_module breakpointID
|
|
210
|
214
|
|
|
211
|
215
|
-- | Constructs textual information about FFI info.
|
|
212
|
216
|
pprFFIInfo :: FFIInfo -> SDoc
|
| ... |
... |
@@ -216,21 +220,21 @@ pprFFIInfo FFIInfo {..} |
|
216
|
220
|
|
|
217
|
221
|
-- | Constructs textual information about an FFI type.
|
|
218
|
222
|
pprFFIType :: FFIType -> SDoc
|
|
219
|
|
-pprFFIType ffiType = assert (take 3 ident == "FFI") $ text (drop 3 ident) where
|
|
|
223
|
+pprFFIType ffi_type = assert (take 3 ident == "FFI") $ text (drop 3 ident) where
|
|
220
|
224
|
|
|
221
|
225
|
ident :: String
|
|
222
|
|
- ident = show ffiType
|
|
|
226
|
+ ident = show ffi_type
|
|
223
|
227
|
|
|
224
|
228
|
-- | Constructs textual information about the ID of a bytecode breakpoint.
|
|
225
|
229
|
pprInternalBreakpointID
|
|
226
|
230
|
:: Module -- ^ The enclosing module
|
|
227
|
231
|
-> InternalBreakpointId -- ^ The ID of the bytecode breakpoint
|
|
228
|
232
|
-> SDoc -- ^ The textual information
|
|
229
|
|
-pprInternalBreakpointID currentModule InternalBreakpointId {..}
|
|
230
|
|
- | ibi_info_mod == currentModule = indexDoc
|
|
231
|
|
- | otherwise = indexDoc <+>
|
|
232
|
|
- text "in" <+>
|
|
233
|
|
- ppr ibi_info_mod
|
|
|
233
|
+pprInternalBreakpointID current_module InternalBreakpointId {..}
|
|
|
234
|
+ | ibi_info_mod == current_module = indexDoc
|
|
|
235
|
+ | otherwise = indexDoc <+>
|
|
|
236
|
+ text "in" <+>
|
|
|
237
|
+ ppr ibi_info_mod
|
|
234
|
238
|
where
|
|
235
|
239
|
|
|
236
|
240
|
indexDoc :: SDoc
|
| ... |
... |
@@ -240,22 +244,22 @@ pprInternalBreakpointID currentModule InternalBreakpointId {..} |
|
240
|
244
|
pprPointers :: Module -- ^ The enclosing module
|
|
241
|
245
|
-> FlatBag BCOPtr -- ^ The pointers
|
|
242
|
246
|
-> SDoc -- ^ The textual information
|
|
243
|
|
-pprPointers currentModule = entry (text "utilized items") .
|
|
244
|
|
- vcatOrNone .
|
|
245
|
|
- map (pprPointer currentModule) .
|
|
246
|
|
- elemsFlatBag
|
|
|
247
|
+pprPointers current_module = entry (text "utilized items") .
|
|
|
248
|
+ vcatOrNone .
|
|
|
249
|
+ map (pprPointer current_module) .
|
|
|
250
|
+ elemsFlatBag
|
|
247
|
251
|
|
|
248
|
252
|
-- | Constructs textual information about a single pointer.
|
|
249
|
253
|
pprPointer :: Module -- ^ The enclosing module
|
|
250
|
254
|
-> BCOPtr -- ^ The pointer
|
|
251
|
255
|
-> SDoc -- ^ The textual information
|
|
252
|
|
-pprPointer currentModule pointer = case pointer of
|
|
|
256
|
+pprPointer current_module pointer = case pointer of
|
|
253
|
257
|
BCOPtrName name
|
|
254
|
258
|
-> text "item named" <+> quotes (ppr name)
|
|
255
|
259
|
BCOPtrPrimOp primOp
|
|
256
|
260
|
-> text "primitive operation" <+> quotes (ppr primOp)
|
|
257
|
|
- BCOPtrBCO byteCodeObject
|
|
258
|
|
- -> pprByteCodeObject currentModule byteCodeObject
|
|
|
261
|
+ BCOPtrBCO byte_code_object
|
|
|
262
|
+ -> pprByteCodeObject current_module byte_code_object
|
|
259
|
263
|
BCOPtrBreakArray breakArrayModule
|
|
260
|
264
|
-> text "break array of module" <+> quotes (ppr breakArrayModule)
|
|
261
|
265
|
|
| ... |
... |
@@ -290,37 +294,37 @@ pprTopLevelStrings = entry (text "top-level strings") . |
|
290
|
294
|
|
|
291
|
295
|
-- | Constructs textual information about a single top-level string.
|
|
292
|
296
|
pprTopLevelString :: Name -> ByteString -> SDoc
|
|
293
|
|
-pprTopLevelString stringName encodedString = entry (ppr stringName) $
|
|
294
|
|
- text $
|
|
295
|
|
- show $
|
|
296
|
|
- utf8DecodeByteString $
|
|
297
|
|
- encodedString
|
|
|
297
|
+pprTopLevelString string_name encoded_string = entry (ppr string_name) $
|
|
|
298
|
+ text $
|
|
|
299
|
+ show $
|
|
|
300
|
+ utf8DecodeByteString $
|
|
|
301
|
+ encoded_string
|
|
298
|
302
|
|
|
299
|
303
|
-- | Constructs textual information about breakpoints.
|
|
300
|
304
|
pprBreakpoints :: Module -- ^ The enclosing module
|
|
301
|
305
|
-> Maybe InternalModBreaks -- ^ The breakpoints
|
|
302
|
306
|
-> SDoc -- ^ The textual information
|
|
303
|
|
-pprBreakpoints currentModule
|
|
|
307
|
+pprBreakpoints current_module
|
|
304
|
308
|
= entry (text "breakpoints") .
|
|
305
|
|
- maybe (text "<none>") (pprActualBreakpoints currentModule)
|
|
|
309
|
+ maybe (text "<none>") (pprActualBreakpoints current_module)
|
|
306
|
310
|
|
|
307
|
311
|
-- | Constructs textual information about actual breakpoints.
|
|
308
|
312
|
pprActualBreakpoints :: Module -- ^ The enclosing module
|
|
309
|
313
|
-> InternalModBreaks -- ^ The actual breakpoints
|
|
310
|
314
|
-> SDoc -- ^ The textual information
|
|
311
|
|
-pprActualBreakpoints currentModule InternalModBreaks {..}
|
|
|
315
|
+pprActualBreakpoints current_module InternalModBreaks {..}
|
|
312
|
316
|
= vcat [
|
|
313
|
|
- pprSourceBreakpoints currentModule $ imodBreaks_modBreaks,
|
|
314
|
|
- pprByteCodeBreakpoints currentModule $ imodBreaks_breakInfo
|
|
|
317
|
+ pprSourceBreakpoints current_module $ imodBreaks_modBreaks,
|
|
|
318
|
+ pprByteCodeBreakpoints current_module $ imodBreaks_breakInfo
|
|
315
|
319
|
]
|
|
316
|
320
|
|
|
317
|
321
|
-- | Constructs textual information about source breakpoints.
|
|
318
|
322
|
pprSourceBreakpoints :: Module -- ^ The enclosing module
|
|
319
|
323
|
-> ModBreaks -- ^ The source breakpoints
|
|
320
|
324
|
-> SDoc -- ^ The textual information
|
|
321
|
|
-pprSourceBreakpoints currentModule ModBreaks {..}
|
|
|
325
|
+pprSourceBreakpoints current_module ModBreaks {..}
|
|
322
|
326
|
= entry (text "source breakpoints") $
|
|
323
|
|
- assert (modBreaks_module == currentModule) $
|
|
|
327
|
+ assert (modBreaks_module == current_module) $
|
|
324
|
328
|
assert (bounds modBreaks_locs_ == bounds modBreaks_decls) $
|
|
325
|
329
|
assert (bounds modBreaks_locs_ == bounds modBreaks_vars) $
|
|
326
|
330
|
vcatOrNone $
|
| ... |
... |
@@ -363,10 +367,10 @@ pprFreeVariables = entry (text "free variables") . vcatOrNone . map ppr |
|
363
|
367
|
pprByteCodeBreakpoints :: Module -- ^ The enclosing module
|
|
364
|
368
|
-> IntMap CgBreakInfo -- ^ The bytecode breakpoints
|
|
365
|
369
|
-> SDoc -- ^ The textual information
|
|
366
|
|
-pprByteCodeBreakpoints currentModule
|
|
367
|
|
- = entry (text "bytecode breakpoints") .
|
|
368
|
|
- vcatOrNone .
|
|
369
|
|
- map (uncurry (pprByteCodeBreakpoint currentModule)) .
|
|
|
370
|
+pprByteCodeBreakpoints current_module
|
|
|
371
|
+ = entry (text "bytecode breakpoints") .
|
|
|
372
|
+ vcatOrNone .
|
|
|
373
|
+ map (uncurry (pprByteCodeBreakpoint current_module)) .
|
|
370
|
374
|
IntMap.toList
|
|
371
|
375
|
|
|
372
|
376
|
-- | Constructs textual information about a single bytecode breakpoint.
|
| ... |
... |
@@ -374,13 +378,13 @@ pprByteCodeBreakpoint :: Module -- ^ The enclosing module |
|
374
|
378
|
-> Int -- ^ The index of the bytecode breakpoint
|
|
375
|
379
|
-> CgBreakInfo -- ^ The bytecode breakpoint
|
|
376
|
380
|
-> SDoc -- ^ The textual information
|
|
377
|
|
-pprByteCodeBreakpoint currentModule ix CgBreakInfo {..}
|
|
|
381
|
+pprByteCodeBreakpoint current_module ix CgBreakInfo {..}
|
|
378
|
382
|
= entry (text "bytecode breakpoint" <+> ppr ix) $
|
|
379
|
383
|
vcat [
|
|
380
|
|
- pprType $ cgb_resty,
|
|
381
|
|
- pprTypeVariables $ cgb_tyvars,
|
|
382
|
|
- pprVariables $ cgb_vars,
|
|
383
|
|
- pprCorrespondingSourceBreakpoint currentModule $ cgb_tick_id
|
|
|
384
|
+ pprType $ cgb_resty,
|
|
|
385
|
+ pprTypeVariables $ cgb_tyvars,
|
|
|
386
|
+ pprVariables $ cgb_vars,
|
|
|
387
|
+ pprCorrespondingSourceBreakpoint current_module $ cgb_tick_id
|
|
384
|
388
|
]
|
|
385
|
389
|
-- That the 'cgb_resty' field holds the type of the breakpoint is apparent
|
|
386
|
390
|
-- from the fact that this field is set by
|
| ... |
... |
@@ -426,20 +430,20 @@ pprCorrespondingSourceBreakpoint :: Module |
|
426
|
430
|
-- ^ A reference to the source breakpoint
|
|
427
|
431
|
-> SDoc
|
|
428
|
432
|
-- ^ The textual information
|
|
429
|
|
-pprCorrespondingSourceBreakpoint currentModule
|
|
|
433
|
+pprCorrespondingSourceBreakpoint current_module
|
|
430
|
434
|
= entry (text "corresponding source breakpoint") .
|
|
431
|
|
- pprBreakpointID currentModule .
|
|
|
435
|
+ pprBreakpointID current_module .
|
|
432
|
436
|
either internalBreakLoc id
|
|
433
|
437
|
|
|
434
|
438
|
-- | Constructs textual information about the ID of a source breakpoint.
|
|
435
|
439
|
pprBreakpointID :: Module -- ^ The enclosing module
|
|
436
|
440
|
-> BreakpointId -- ^ The ID of the source breakpoint
|
|
437
|
441
|
-> SDoc -- ^ The textual information
|
|
438
|
|
-pprBreakpointID currentModule BreakpointId {..}
|
|
439
|
|
- | bi_tick_mod == currentModule = indexDoc
|
|
440
|
|
- | otherwise = indexDoc <+>
|
|
441
|
|
- text "in" <+>
|
|
442
|
|
- quotes (ppr bi_tick_mod)
|
|
|
442
|
+pprBreakpointID current_module BreakpointId {..}
|
|
|
443
|
+ | bi_tick_mod == current_module = indexDoc
|
|
|
444
|
+ | otherwise = indexDoc <+>
|
|
|
445
|
+ text "in" <+>
|
|
|
446
|
+ quotes (ppr bi_tick_mod)
|
|
443
|
447
|
where
|
|
444
|
448
|
|
|
445
|
449
|
indexDoc :: SDoc
|
| ... |
... |
@@ -470,7 +474,6 @@ pprActualHPCInfo ByteCodeHpcInfo {..} |
|
470
|
474
|
pprTickBoxName $ bchi_tickbox_name,
|
|
471
|
475
|
pprTickCount $ bchi_tick_count
|
|
472
|
476
|
]
|
|
473
|
|
- where
|
|
474
|
477
|
|
|
475
|
478
|
-- | Constructs textual information about the hash of HPC info.
|
|
476
|
479
|
pprHPCInfoHash :: Int -> SDoc
|