Wolfgang Jeltsch pushed to branch wip/jeltsch/textual-bytecode-output at Glasgow Haskell Compiler / GHC

Commits:

1 changed file:

Changes:

  • compiler/GHC/ByteCode/Show.hs
    1 1 
     {-# LANGUAGE ImportQualifiedPost #-}
    2 2 
     {-# LANGUAGE RecordWildCards #-}
    3 
    -{-# LANGUAGE ScopedTypeVariables #-}
    4 3
    5 
    --- | […]
    4 
    +-- | This module implements the output of textual information about the contents
    5 
    +--   of bytecode files. It is the backbone of the @--show-byte-code@ option.
    6 6 
     module GHC.ByteCode.Show (showByteCode) where
    7 7
    8 8 
     import Prelude ((+), (-), Integral, div)
    ... ... @@ -79,7 +79,7 @@ import GHC.Driver.Env.Types (HscEnv)
    79 79 
     import GHCi.FFI (FFIType)
    80 80 
     import GHCi.Message (ConInfoTable (..))
    81 81
    82 
    --- | […]
    82 
    +-- | Outputs textual information about the contents of a bytecode file.
    83 83 
     showByteCode :: Logger -> HscEnv -> FilePath -> IO ()
    84 84 
     showByteCode logger env path = do
    85 85 
         byteCode <- readOnDiskModuleByteCode env path
    ... ... @@ -88,7 +88,7 @@ showByteCode logger env path = do
    88 88 
                noSrcSpan
    89 89 
                (withPprStyle defaultDumpStyle $ pprOnDiskModuleByteCode byteCode)
    90 90
    91 
    --- | […]
    91 
    +-- | Constructs textual information about the contents of a bytecode file.
    92 92 
     pprOnDiskModuleByteCode :: OnDiskModuleByteCode -> SDoc
    93 93 
     pprOnDiskModuleByteCode OnDiskModuleByteCode {..}
    94 94 
         = vcat [
    ... ... @@ -97,15 +97,15 @@ pprOnDiskModuleByteCode OnDiskModuleByteCode {..}
    97 97 
                    pprCompiledByteCode odgbc_module $ odgbc_compiled_byte_code
    98 98 
                ]
    99 99
    100 
    --- | […]
    100 
    +-- | Constructs textual information about the name of a module.
    101 101 
     pprModuleIdent :: Module -> SDoc
    102 102 
     pprModuleIdent = entry (text "name") . ppr
    103 103
    104 
    --- | […]
    104 
    +-- | Constructs textual information about the hash of a module.
    105 105 
     pprOnDiskModuleByteCodeHash :: Fingerprint -> SDoc
    106 106 
     pprOnDiskModuleByteCodeHash = entry (text "hash") . ppr
    107 107
    108 
    --- | […]
    108 
    +-- | Constructs textual information about bytecode.
    109 109 
     pprCompiledByteCode :: Module -> CompiledByteCode -> SDoc
    110 110 
     pprCompiledByteCode currentModule CompiledByteCode {..}
    111 111 
         = vcat [
    ... ... @@ -117,14 +117,14 @@ pprCompiledByteCode currentModule CompiledByteCode {..}
    117 117 
                    pprHPCInfo                       $ bc_hpc_info
    118 118 
                ]
    119 119
    120 
    --- | […]
    120 
    +-- | Constructs textual information about bytecode objects.
    121 121 
     pprByteCodeObjects :: Module -> FlatBag UnlinkedBCO -> SDoc
    122 122 
     pprByteCodeObjects currentModule = entry (text "objects")                .
    123 123 
                                        vcatOrNone                            .
    124 124 
                                        map (pprByteCodeObject currentModule) .
    125 125 
                                        elemsFlatBag
    126 126
    127 
    --- | […]
    127 
    +-- | Constructs textual information about a single bytecode object.
    128 128 
     pprByteCodeObject :: Module -> UnlinkedBCO -> SDoc
    129 129 
     pprByteCodeObject currentModule byteCodeObject = case byteCodeObject of
    130 130 
         UnlinkedBCO {..}
    ... ... @@ -147,26 +147,29 @@ pprByteCodeObject currentModule byteCodeObject = case byteCodeObject of
    147 147 
                         pprPointers currentModule $ unlinkedStaticConPtrs
    148 148 
                     ]
    149 149
    150 
    --- | […]
    150 
    +-- | Constructs textual information about the arity of an ordinary bytecode
    151 
    +--   object.
    151 152 
     pprArity :: Int -> SDoc
    152 153 
     pprArity = entry (text "arity") . ppr
    153 154
    154 
    --- | […]
    155 
    +-- | Constructs textual information about the data constructor name of a
    156 
    +--   static-construction bytecode object.
    155 157 
     pprDataConstructorName :: Name -> SDoc
    156 158 
     pprDataConstructorName = entry (text "data constructor name") . ppr
    157 159
    158 
    --- | […]
    160 
    +-- | Constructs textual information about the liftedness of a
    161 
    +--   static-construction bytecode object.
    159 162 
     pprLiftedness :: Bool -> SDoc
    160 163 
     pprLiftedness = entry (text "lifted") . noOrYes
    161 164
    162 
    --- | […]
    165 
    +-- | Constructs textual information about literals.
    163 166 
     pprLiterals :: Module -> FlatBag BCONPtr -> SDoc
    164 167 
     pprLiterals currentModule = entry (text "literals")        .
    165 168 
                                 vcatOrNone                     .
    166 169 
                                 map (pprLiteral currentModule) .
    167 170 
                                 elemsFlatBag
    168 171
    169 
    --- | […]
    172 
    +-- | Constructs textual information about a single literal.
    170 173 
     pprLiteral :: Module -> BCONPtr -> SDoc
    171 174 
     pprLiteral currentModule literal = case literal of
    172 175 
         BCONPtrWord word
    ... ... @@ -194,20 +197,20 @@ pprLiteral currentModule literal = case literal of
    194 197 
             -> text "cost center of breakpoint" <+>
    195 198 
                pprInternalBreakpointID currentModule breakpointID
    196 199
    197 
    --- | […]
    200 
    +-- | Constructs textual information about some FFI info.
    198 201 
     pprFFIInfo :: FFIInfo -> SDoc
    199 202 
     pprFFIInfo FFIInfo {..}
    200 203 
         = hsep (map (pprFFIType >>> (<+> text "->")) ffiInfoArgs) <+>
    201 204 
           pprFFIType ffiInfoRet
    202 205
    203 
    --- | […]
    206 
    +-- | Constructs textual information about an FFI type.
    204 207 
     pprFFIType :: FFIType -> SDoc
    205 208 
     pprFFIType ffiType = assert (take 3 ident == "FFI") $ text (drop 3 ident) where
    206 209
    207 210 
         ident :: String
    208 211 
         ident = show ffiType
    209 212
    210 
    --- | […]
    213 
    +-- | Constructs textual information about the ID of a bytecode breakpoint.
    211 214 
     pprInternalBreakpointID :: Module -> InternalBreakpointId -> SDoc
    212 215 
     pprInternalBreakpointID currentModule InternalBreakpointId {..}
    213 216 
         | ibi_info_mod == currentModule = indexDoc
    ... ... @@ -219,14 +222,14 @@ pprInternalBreakpointID currentModule InternalBreakpointId {..}
    219 222 
         indexDoc :: SDoc
    220 223 
         indexDoc = ppr ibi_info_index
    221 224
    222 
    --- | […]
    225 
    +-- | Constructs textual information about pointers.
    223 226 
     pprPointers :: Module -> FlatBag BCOPtr -> SDoc
    224 227 
     pprPointers currentModule = entry (text "utilized items")  .
    225 228 
                                 vcatOrNone                     .
    226 229 
                                 map (pprPointer currentModule) .
    227 230 
                                 elemsFlatBag
    228 231
    229 
    --- | […]
    232 
    +-- | Constructs textual information about a single pointer.
    230 233 
     pprPointer :: Module -> BCOPtr -> SDoc
    231 234 
     pprPointer currentModule pointer = case pointer of
    232 235 
         BCOPtrName name
    ... ... @@ -238,13 +241,13 @@ pprPointer currentModule pointer = case pointer of
    238 241 
         BCOPtrBreakArray breakArrayModule
    239 242 
             -> text "break array of module" <+> quotes (ppr breakArrayModule)
    240 243
    241 
    --- | […]
    244 
    +-- | Constructs textual information about data constructor info tables.
    242 245 
     pprDataConstructorInfoTables :: [(Name, ConInfoTable)] -> SDoc
    243 246 
     pprDataConstructorInfoTables = entry (text "data constructor info tables") .
    244 247 
                                    vcatOrNone                                  .
    245 248 
                                    map (uncurry pprDataConstructorInfoTable)
    246 249
    247 
    --- | […]
    250 
    +-- | Constructs textual information about a single data constructor info table.
    248 251 
     pprDataConstructorInfoTable :: Name -> ConInfoTable -> SDoc
    249 252 
     pprDataConstructorInfoTable dataConstrName ConInfoTable {..}
    250 253 
         = entry (text "info table of" <+> quotes (ppr dataConstrName)) $
    ... ... @@ -253,21 +256,21 @@ pprDataConstructorInfoTable dataConstrName ConInfoTable {..}
    253 256 
                    pprNonPointerWordCount $ conItblNPtrs
    254 257 
                ]
    255 258
    256 
    --- | […]
    259 
    +-- | Constructs textual information about a number of pointer words.
    257 260 
     pprPointerWordCount :: Int -> SDoc
    258 261 
     pprPointerWordCount = entry (text "number of words for pointers") . ppr
    259 262
    260 
    --- | […]
    263 
    +-- | Constructs textual information about a number of non-pointer words.
    261 264 
     pprNonPointerWordCount :: Int -> SDoc
    262 265 
     pprNonPointerWordCount = entry (text "number of words for non-pointers") . ppr
    263 266
    264 
    --- | […]
    267 
    +-- | Constructs textual information about top-level strings.
    265 268 
     pprTopLevelStrings :: [(Name, ByteString)] -> SDoc
    266 269 
     pprTopLevelStrings = entry (text "top-level strings") .
    267 270 
                          vcatOrNone                       .
    268 271 
                          map (uncurry pprTopLevelString)
    269 272
    270 
    --- | […]
    273 
    +-- | Constructs textual information about a single top-level string.
    271 274 
     pprTopLevelString :: Name -> ByteString -> SDoc
    272 275 
     pprTopLevelString stringName encodedString = entry (ppr stringName) $
    273 276 
                                                  text                   $
    ... ... @@ -275,13 +278,13 @@ pprTopLevelString stringName encodedString = entry (ppr stringName) $
    275 278 
                                                  utf8DecodeByteString   $
    276 279 
                                                  encodedString
    277 280
    278 
    --- | […]
    281 
    +-- | Constructs textual information about breakpoints.
    279 282 
     pprBreakpoints :: Module -> Maybe InternalModBreaks -> SDoc
    280 283 
     pprBreakpoints currentModule
    281 284 
         = entry (text "breakpoints") .
    282 285 
           maybe (text "<none>") (pprBreakpointsData currentModule)
    283 286
    284 
    --- | […]
    287 
    +-- | Constructs textual information about a single breakpoint.
    285 288 
     pprBreakpointsData :: Module -> InternalModBreaks -> SDoc
    286 289 
     pprBreakpointsData currentModule InternalModBreaks {..}
    287 290 
         = vcat [
    ... ... @@ -289,7 +292,7 @@ pprBreakpointsData currentModule InternalModBreaks {..}
    289 292 
                    pprByteCodeBreakpoints currentModule $ imodBreaks_breakInfo
    290 293 
                ]
    291 294
    292 
    --- | […]
    295 
    +-- | Constructs textual information about source breakpoints.
    293 296 
     pprSourceBreakpoints :: Module -> ModBreaks -> SDoc
    294 297 
     pprSourceBreakpoints currentModule ModBreaks {..}
    295 298 
         = entry (text "source breakpoints")                         $
    ... ... @@ -301,12 +304,12 @@ pprSourceBreakpoints currentModule ModBreaks {..}
    301 304 
                                        (elems modBreaks_locs_)
    302 305 
                                        (elems modBreaks_decls)
    303 306 
                                        (elems modBreaks_vars)
    304 
    -      -- The cost center infos in `modBreaks_ccs`, when present, just contain
    305 
    -      -- textual representations of the declaration paths in `modBreaks_decls`
    306 
    -      -- and the source spans in `modBreaks_locs_` and are therefore never
    307 
    +      -- The cost center infos in 'modBreaks_ccs', when present, just contain
    308 
    +      -- textual representations of the declaration paths in 'modBreaks_decls'
    309 
    +      -- and the source spans in 'modBreaks_locs_' and are therefore never
    307 310 
           -- shown.
    308 311
    309 
    --- | […]
    312 
    +-- | Constructs textual information about a single source breakpoint.
    310 313 
     pprSourceBreakpoint :: BreakTickIndex
    311 314 
                         -> BinSrcSpan
    312 315 
                         -> [String]
    ... ... @@ -320,19 +323,19 @@ pprSourceBreakpoint ix srcSpan declarationPath freeVars
    320 323 
                    pprFreeVariables   $ freeVars
    321 324 
                ]
    322 325
    323 
    --- | […]
    326 
    +-- | Constructs textual information about a source span.
    324 327 
     pprSrcSpan :: BinSrcSpan -> SDoc
    325 328 
     pprSrcSpan = entry (text "source span") . ppr . unBinSrcSpan
    326 329
    327 
    --- | […]
    330 
    +-- | Constructs textual information about a declaration path.
    328 331 
     pprDeclarationPath :: [String] -> SDoc
    329 332 
     pprDeclarationPath = entry (text "declaration path") . vcatOrEmpty . map text
    330 333
    331 
    --- | […]
    334 
    +-- | Constructs textual information about free variables.
    332 335 
     pprFreeVariables :: [OccName] -> SDoc
    333 336 
     pprFreeVariables = entry (text "free variables") . vcatOrNone . map ppr
    334 337
    335 
    --- | […]
    338 
    +-- | Constructs textual information about bytecode breakpoints.
    336 339 
     pprByteCodeBreakpoints :: Module -> IntMap CgBreakInfo -> SDoc
    337 340 
     pprByteCodeBreakpoints currentModule
    338 341 
         = entry (text "bytecode breakpoints")                 .
    ... ... @@ -340,7 +343,7 @@ pprByteCodeBreakpoints currentModule
    340 343 
           map (uncurry (pprByteCodeBreakpoint currentModule)) .
    341 344 
           IntMap.toList
    342 345
    343 
    --- | […]
    346 
    +-- | Constructs textual information about a single bytecode breakpoint.
    344 347 
     pprByteCodeBreakpoint :: Module -> Int -> CgBreakInfo -> SDoc
    345 348 
     pprByteCodeBreakpoint currentModule ix CgBreakInfo {..}
    346 349 
         = entry (text "bytecode breakpoint" <+> ppr ix) $
    ... ... @@ -353,38 +356,41 @@ pprByteCodeBreakpoint currentModule ix CgBreakInfo {..}
    353 356 
         -- That the 'cgb_resty' field holds the type of the breakpoint is apparent
    354 357 
         -- from the fact that this field is set by
    355 358 
         -- 'GHC.StgToByteCode.dehydrateCgBreakInfo' using one of its arguments and
    356 
    -    -- 'dehydrateCgBreakInfo' is always invoked with this argument set to the
    357 
    -    -- extension field of 'Breakpoint', which in turn holds the type of the
    358 
    -    -- breakpoint according to Note [Tickish passes] and the comment on the
    359 
    -    -- instance declaration of @XBreakpoint 'TickishPassStg@.
    359 
    +    -- 'GHC.StgToByteCode.dehydrateCgBreakInfo' is always invoked with this
    360 
    +    -- argument set to the extension field of 'Breakpoint', which in turn holds
    361 
    +    -- the type of the breakpoint according to Note [Tickish passes] and the
    362 
    +    -- comment on the instance declaration of @XBreakpoint 'TickishPassStg@.
    360 363
    364 
    +-- | Constructs textual information about a type.
    361 365 
     pprType :: IfaceType -> SDoc
    362 366 
     pprType = entry (text "type") . ppr
    363 367
    364 
    --- | […]
    368 
    +-- | Constructs textual information about type variables.
    365 369 
     pprTypeVariables :: [IfaceTvBndr] -> SDoc
    366 370 
     pprTypeVariables = entry (text "type variables") .
    367 371 
                        vcatOrNone                    .
    368 372 
                        map pprTypeVariableBinder
    369 373
    370 
    --- | […]
    374 
    +-- | Constructs textual information about a type variable binder.
    371 375 
     pprTypeVariableBinder :: IfaceTvBndr -> SDoc
    372 376 
     pprTypeVariableBinder (name, kind) = ppr name <+> text "::" <+> ppr kind
    373 377
    374 
    --- | […]
    378 
    +-- | Constructs textual information about variables.
    375 379 
     pprVariables :: [Maybe (IfaceIdBndr, Word)] -> SDoc
    376 380 
     pprVariables = entry (text "variables") . vcatOrNone . map pprVariable
    377 381
    378 
    --- | […]
    382 
    +-- | Constructs textual information about a single variable.
    379 383 
     pprVariable :: Maybe (IfaceIdBndr, Word) -> SDoc
    380 384 
     pprVariable = maybe (text "<unknown>") (pprVariableBinder . fst)
    381 385
    382 
    --- | […]
    386 
    +-- | Constructs textual information about a variable binder.
    383 387 
     pprVariableBinder :: IfaceIdBndr -> SDoc
    384 388 
     pprVariableBinder (multiplicity, name, type_)
    385 389 
         = text "%" <> ppr multiplicity <+>
    386 390 
           ppr name <+> text "::" <+> ppr type_
    387 391
    392 
    +-- | Constructs textual information about a source breakpoint corresponding to a
    393 
    +--   bytecode breakpoint.
    388 394 
     pprCorrespondingSourceBreakpoint :: Module
    389 395 
                                      -> Either InternalBreakLoc BreakpointId
    390 396 
                                      -> SDoc
    ... ... @@ -393,7 +399,7 @@ pprCorrespondingSourceBreakpoint currentModule
    393 399 
           pprBreakpointID currentModule                  .
    394 400 
           either internalBreakLoc id
    395 401
    396 
    --- | […] [analogous to 'pprInternalBreakpointID' but the meaning of the index is different]
    402 
    +-- | Constructs textual information about the ID of a source breakpoint.
    397 403 
     pprBreakpointID :: Module -> BreakpointId -> SDoc
    398 404 
     pprBreakpointID currentModule BreakpointId {..}
    399 405 
         | bi_tick_mod == currentModule = indexDoc
    ... ... @@ -405,23 +411,23 @@ pprBreakpointID currentModule BreakpointId {..}
    405 411 
         indexDoc :: SDoc
    406 412 
         indexDoc = ppr bi_tick_index
    407 413
    408 
    --- | […]
    414 
    +-- | Constructs textual information about static-pointer table entries.
    409 415 
     pprStaticPointerTableEntries :: [SptEntry] -> SDoc
    410 416 
     pprStaticPointerTableEntries = entry (text "static-pointer table entries") .
    411 417 
                                    vcatOrNone                                  .
    412 418 
                                    map pprStaticPointerTableEntry
    413 419
    414 
    --- | […]
    420 
    +-- | Constructs textual information about a single static-pointer table entry.
    415 421 
     pprStaticPointerTableEntry :: SptEntry -> SDoc
    416 422 
     pprStaticPointerTableEntry (SptEntry name fingerprint)
    417 423 
         = ppr fingerprint <> text ":" <+> ppr name
    418 424
    419 
    --- | […]
    425 
    +-- | Constructs textual information about some HPC info.
    420 426 
     pprHPCInfo :: Strict.Maybe ByteCodeHpcInfo -> SDoc
    421 427 
     pprHPCInfo = entry (text "HPC information") .
    422 428 
                  Strict.maybe (text "<none>") pprHPCInfoData
    423 429
    424 
    --- | […]
    430 
    +-- | Constructs textual information about data that makes up some HPC info.
    425 431 
     pprHPCInfoData :: ByteCodeHpcInfo -> SDoc
    426 432 
     pprHPCInfoData ByteCodeHpcInfo {..}
    427 433 
         = vcat [
    ... ... @@ -432,30 +438,33 @@ pprHPCInfoData ByteCodeHpcInfo {..}
    432 438 
                ]
    433 439 
         where
    434 440
    435 
    --- | […]
    441 
    +-- | Constructs textual information about the hash of some HPC info.
    436 442 
     pprHPCInfoHash :: Int -> SDoc
    437 443 
     pprHPCInfoHash = entry (text "hash") . pprFixedSizeNatural
    438 444
    439 
    --- | […]
    445 
    +-- | Constructs textual information about a module name.
    440 446 
     pprModuleName :: ShortByteString -> SDoc
    441 447 
     pprModuleName = entry (text "module name") .
    442 448 
                     text                       .
    443 449 
                     utf8DecodeShortByteString
    444 450
    445 
    --- | […]
    451 
    +-- | Constructs textual information about a tick box name.
    446 452 
     pprTickBoxName :: ShortByteString -> SDoc
    447 453 
     pprTickBoxName = entry (text "tick box name") .
    448 454 
                      text                         .
    449 455 
                      utf8DecodeShortByteString
    450 456
    451 
    --- | […]
    457 
    +-- | Constructs textual information about a number of tick counts.
    452 458 
     pprTickCount :: Int -> SDoc
    453 459 
     pprTickCount = entry (text "number of ticks") . ppr
    454 460
    455 
    --- | […]
    461 
    +-- | Constructs a hexadecimal representation of a natural number such that the
    462 
    +--   number of hexadecimal digits fits the number of bits used to represent the
    463 
    +--   natural number.
    456 464 
     pprFixedSizeNatural :: (Integral a, FiniteBits a) => a -> SDoc
    457 465 
     pprFixedSizeNatural num
    458 
    -    = text $ replicate (digitCount - length unpadded) '0' ++ unpadded
    466 
    +    = assert (num >= 0) $
    467 
    +      text $ replicate (digitCount - length unpadded) '0' ++ unpadded
    459 468 
         where
    460 469
    461 470 
         digitCount :: Int
    ... ... @@ -464,20 +473,25 @@ pprFixedSizeNatural num
    464 473 
         unpadded :: String
    465 474 
         unpadded = showHex num ""
    466 475
    467 
    --- | […]
    476 
    +-- | Constructs a textual representation of a boolean, interpreting 'True' and
    477 
    +--   'False' as “yes” and “no”, respectively.
    468 478 
     noOrYes :: Bool -> SDoc
    469 479 
     noOrYes bool = text (if bool then "yes" else "no")
    470 480
    471 
    --- | […]
    472 
    -entry :: SDoc -> SDoc -> SDoc
    481 
    +-- | Constructs an entry in a list of textual data representations.
    482 
    +entry :: SDoc -- ^ The title of the entry
    483 
    +      -> SDoc -- ^ The contents of the entry
    484 
    +      -> SDoc -- ^ The entry
    473 485 
     entry title content = hang (title <> text ":") 2 content
    474 486
    475 
    --- | […]
    487 
    +-- | Composes documents vertically in general, but presents an empty document
    488 
    +--   list as `<none`>.
    476 489 
     vcatOrNone :: [SDoc] -> SDoc
    477 490 
     vcatOrNone []   = text "<none>"
    478 491 
     vcatOrNone docs = vcat docs
    479 492
    480 
    --- | […]
    493 
    +-- | Composes documents vertically in general, but presents an empty document
    494 
    +--   list as `<empty`>.
    481 495 
     vcatOrEmpty :: [SDoc] -> SDoc
    482 496 
     vcatOrEmpty []   = text "<empty>"
    483 497 
     vcatOrEmpty docs = vcat docs

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/compare/aeddc354c6672f1d89903200aac7932a37cbb6dc...2f58c3a2d3c0e6f3738865a01ace68ebfec3c671 at 1784309928