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
    ... ... @@ -47,6 +47,7 @@ import GHC.Utils.Outputable
    47 47 
                text,
    48 48 
                (<>),
    49 49 
                (<+>),
    50 
    +           quotes,
    50 51 
                hsep,
    51 52 
                vcat,
    52 53 
                hang,
    ... ... @@ -98,17 +99,16 @@ pprOnDiskModuleByteCode OnDiskModuleByteCode {..}
    98 99
    99 100 
     -- | […]
    100 101 
     pprModuleIdent :: Module -> SDoc
    101 
    -pprModuleIdent = entry (text "name:") . ppr
    102 
    +pprModuleIdent = entry (text "name") . ppr
    102 103
    103 104 
     -- | […]
    104 105 
     pprOnDiskModuleByteCodeHash :: Fingerprint -> SDoc
    105 
    -pprOnDiskModuleByteCodeHash = entry (text "hash:") . ppr
    106 
    +pprOnDiskModuleByteCodeHash = entry (text "hash") . ppr
    106 107
    107 108 
     -- | […]
    108 109 
     pprCompiledByteCode :: Module -> CompiledByteCode -> SDoc
    109 110 
     pprCompiledByteCode currentModule CompiledByteCode {..}
    110 
    -    = entry (text "compiled bytecode:") $
    111 
    -      vcat [
    111 
    +    = vcat [
    112 112 
                    pprByteCodeObjects currentModule $ bc_bcos,
    113 113 
                    pprDataConstructorInfoTables     $ bc_itbls,
    114 114 
                    pprTopLevelStrings               $ bc_strs,
    ... ... @@ -119,7 +119,7 @@ pprCompiledByteCode currentModule CompiledByteCode {..}
    119 119
    120 120 
     -- | […]
    121 121 
     pprByteCodeObjects :: Module -> FlatBag UnlinkedBCO -> SDoc
    122 
    -pprByteCodeObjects currentModule = entry (text "bytecode objects:")      .
    122 
    +pprByteCodeObjects currentModule = entry (text "objects")                .
    123 123 
                                        vcatOrNone                            .
    124 124 
                                        map (pprByteCodeObject currentModule) .
    125 125 
                                        elemsFlatBag
    ... ... @@ -128,7 +128,7 @@ pprByteCodeObjects currentModule = entry (text "bytecode objects:") .
    128 128 
     pprByteCodeObject :: Module -> UnlinkedBCO -> SDoc
    129 129 
     pprByteCodeObject currentModule byteCodeObject = case byteCodeObject of
    130 130 
         UnlinkedBCO {..}
    131 
    -        -> entry (text "ordinary object" <+> ppr unlinkedBCOName <> text ":") $
    131 
    +        -> entry (text "ordinary object" <+> quotes (ppr unlinkedBCOName)) $
    132 132 
                vcat [
    133 133 
                         pprArity                  $ unlinkedBCOArity,
    134 134 
                         pprLiterals currentModule $ unlinkedBCOLits,
    ... ... @@ -136,9 +136,8 @@ pprByteCodeObject currentModule byteCodeObject = case byteCodeObject of
    136 136 
                     ]
    137 137 
         UnlinkedStaticCon {..}
    138 138 
             -> entry (
    139 
    -                     text "static-construction object" <+>
    140 
    -                     ppr unlinkedStaticConName         <>
    141 
    -                     text ":"
    139 
    +                     text "static-construction object"  <+>
    140 
    +                     quotes (ppr unlinkedStaticConName)
    142 141 
                      )
    143 142 
                $
    144 143 
                vcat [
    ... ... @@ -150,19 +149,19 @@ pprByteCodeObject currentModule byteCodeObject = case byteCodeObject of
    150 149
    151 150 
     -- | […]
    152 151 
     pprArity :: Int -> SDoc
    153 
    -pprArity = entry (text "arity:") . ppr
    152 
    +pprArity = entry (text "arity") . ppr
    154 153
    155 154 
     -- | […]
    156 155 
     pprDataConstructorName :: Name -> SDoc
    157 
    -pprDataConstructorName = entry (text "data constructor name:") . ppr
    156 
    +pprDataConstructorName = entry (text "data constructor name") . ppr
    158 157
    159 158 
     -- | […]
    160 159 
     pprLiftedness :: Bool -> SDoc
    161 
    -pprLiftedness = entry (text "lifted:") . noOrYes
    160 
    +pprLiftedness = entry (text "lifted") . noOrYes
    162 161
    163 162 
     -- | […]
    164 163 
     pprLiterals :: Module -> FlatBag BCONPtr -> SDoc
    165 
    -pprLiterals currentModule = entry (text "literals:")       .
    164 
    +pprLiterals currentModule = entry (text "literals")        .
    166 165 
                                 vcatOrNone                     .
    167 166 
                                 map (pprLiteral currentModule) .
    168 167 
                                 elemsFlatBag
    ... ... @@ -175,13 +174,13 @@ pprLiteral currentModule literal = case literal of
    175 174 
                ppr word
    176 175 
         BCONPtrLbl label
    177 176 
             -> text "label" <+>
    178 
    -           ppr label
    177 
    +           quotes (ppr label)
    179 178 
         BCONPtrItbl infoTableName
    180 179 
             -> text "info table of" <+>
    181 
    -           ppr infoTableName
    180 
    +           quotes (ppr infoTableName)
    182 181 
         BCONPtrAddr addrName
    183 182 
             -> text "address" <+>
    184 
    -           ppr addrName
    183 
    +           quotes (ppr addrName)
    185 184 
         BCONPtrStr encodedString
    186 185 
             -> text "top-level string" <+>
    187 186 
                text (show (utf8DecodeByteString encodedString))
    ... ... @@ -190,7 +189,7 @@ pprLiteral currentModule literal = case literal of
    190 189 
                text (show (unpackFS string))
    191 190 
         BCONPtrFFIInfo ffiInfo
    192 191 
             -> text "foreign function" <+>
    193 
    -           pprFFIInfo ffiInfo
    192 
    +           quotes (pprFFIInfo ffiInfo)
    194 193 
         BCONPtrCostCentre breakpointID
    195 194 
             -> text "cost center" <+>
    196 195 
                pprInternalBreakpointID currentModule breakpointID
    ... ... @@ -222,7 +221,7 @@ pprInternalBreakpointID currentModule InternalBreakpointId {..}
    222 221
    223 222 
     -- | […]
    224 223 
     pprPointers :: Module -> FlatBag BCOPtr -> SDoc
    225 
    -pprPointers currentModule = entry (text "pointers:")       .
    224 
    +pprPointers currentModule = entry (text "utilized items")  .
    226 225 
                                 vcatOrNone                     .
    227 226 
                                 map (pprPointer currentModule) .
    228 227 
                                 elemsFlatBag
    ... ... @@ -231,24 +230,24 @@ pprPointers currentModule = entry (text "pointers:") .
    231 230 
     pprPointer :: Module -> BCOPtr -> SDoc
    232 231 
     pprPointer currentModule pointer = case pointer of
    233 232 
         BCOPtrName name
    234 
    -        -> text "name" <+> ppr name
    233 
    +        -> text "item named" <+> quotes (ppr name)
    235 234 
         BCOPtrPrimOp primOp
    236 
    -        -> text "primitive operation" <+> ppr primOp
    235 
    +        -> text "primitive operation" <+> quotes (ppr primOp)
    237 236 
         BCOPtrBCO byteCodeObject
    238 237 
             -> pprByteCodeObject currentModule byteCodeObject
    239 238 
         BCOPtrBreakArray breakArrayModule
    240 
    -        -> text "break array of module" <+> ppr breakArrayModule
    239 
    +        -> text "break array of module" <+> quotes (ppr breakArrayModule)
    241 240
    242 241 
     -- | […]
    243 242 
     pprDataConstructorInfoTables :: [(Name, ConInfoTable)] -> SDoc
    244 
    -pprDataConstructorInfoTables = entry (text "data constructor info tables:") .
    245 
    -                               vcatOrNone                                   .
    243 
    +pprDataConstructorInfoTables = entry (text "data constructor info tables") .
    244 
    +                               vcatOrNone                                  .
    246 245 
                                    map (uncurry pprDataConstructorInfoTable)
    247 246
    248 247 
     -- | […]
    249 248 
     pprDataConstructorInfoTable :: Name -> ConInfoTable -> SDoc
    250 249 
     pprDataConstructorInfoTable dataConstrName ConInfoTable {..}
    251 
    -    = entry (text "info table of" <+> ppr dataConstrName <> text ":") $
    250 
    +    = entry (text "info table of" <+> quotes (ppr dataConstrName)) $
    252 251 
           vcat [
    253 252 
                    pprPointerWordCount    $ conItblPtrs,
    254 253 
                    pprNonPointerWordCount $ conItblNPtrs
    ... ... @@ -256,31 +255,30 @@ pprDataConstructorInfoTable dataConstrName ConInfoTable {..}
    256 255
    257 256 
     -- | […]
    258 257 
     pprPointerWordCount :: Int -> SDoc
    259 
    -pprPointerWordCount = entry (text "number of words for pointers:") . ppr
    258 
    +pprPointerWordCount = entry (text "number of words for pointers") . ppr
    260 259
    261 260 
     -- | […]
    262 261 
     pprNonPointerWordCount :: Int -> SDoc
    263 
    -pprNonPointerWordCount = entry (text "number of words for non-pointers:") . ppr
    262 
    +pprNonPointerWordCount = entry (text "number of words for non-pointers") . ppr
    264 263
    265 264 
     -- | […]
    266 265 
     pprTopLevelStrings :: [(Name, ByteString)] -> SDoc
    267 
    -pprTopLevelStrings = entry (text "top-level strings:") .
    268 
    -                     vcatOrNone                        .
    266 
    +pprTopLevelStrings = entry (text "top-level strings") .
    267 
    +                     vcatOrNone                       .
    269 268 
                          map (uncurry pprTopLevelString)
    270 269
    271 270 
     -- | […]
    272 271 
     pprTopLevelString :: Name -> ByteString -> SDoc
    273 
    -pprTopLevelString stringName encodedString
    274 
    -    = entry (ppr stringName <> text ":") $
    275 
    -      text                               $
    276 
    -      show                               $
    277 
    -      utf8DecodeByteString               $
    278 
    -      encodedString
    272 
    +pprTopLevelString stringName encodedString = entry (ppr stringName) $
    273 
    +                                             text                   $
    274 
    +                                             show                   $
    275 
    +                                             utf8DecodeByteString   $
    276 
    +                                             encodedString
    279 277
    280 278 
     -- | […]
    281 279 
     pprBreakpoints :: Module -> Maybe InternalModBreaks -> SDoc
    282 280 
     pprBreakpoints currentModule
    283 
    -    = entry (text "breakpoints:") .
    281 
    +    = entry (text "breakpoints") .
    284 282 
           maybe (text "<none>") (pprBreakpointsData currentModule)
    285 283
    286 284 
     -- | […]
    ... ... @@ -294,7 +292,7 @@ pprBreakpointsData currentModule InternalModBreaks {..}
    294 292 
     -- | […]
    295 293 
     pprBreakpointsInSource :: Module -> ModBreaks -> SDoc
    296 294 
     pprBreakpointsInSource currentModule ModBreaks {..}
    297 
    -    = entry (text "breakpoints in source:")                     $
    295 
    +    = entry (text "breakpoints in source")                      $
    298 296 
           assert (modBreaks_module == currentModule)                $
    299 297 
           assert (bounds modBreaks_locs_ == bounds modBreaks_decls) $
    300 298 
           assert (bounds modBreaks_locs_ == bounds modBreaks_vars)  $
    ... ... @@ -315,7 +313,7 @@ pprBreakpointInSource :: BreakTickIndex
    315 313 
                           -> [OccName]
    316 314 
                           -> SDoc
    317 315 
     pprBreakpointInSource ix srcSpan declarationPath freeVars
    318 
    -    = entry (text "breakpoint" <+> ppr ix <> text ":") $
    316 
    +    = entry (text "breakpoint" <+> ppr ix) $
    319 317 
           vcat [
    320 318 
                    pprSrcSpan         $ srcSpan,
    321 319 
                    pprDeclarationPath $ declarationPath,
    ... ... @@ -324,20 +322,20 @@ pprBreakpointInSource ix srcSpan declarationPath freeVars
    324 322
    325 323 
     -- | […]
    326 324 
     pprSrcSpan :: BinSrcSpan -> SDoc
    327 
    -pprSrcSpan = entry (text "source span:") . ppr . unBinSrcSpan
    325 
    +pprSrcSpan = entry (text "source span") . ppr . unBinSrcSpan
    328 326
    329 327 
     -- | […]
    330 328 
     pprDeclarationPath :: [String] -> SDoc
    331 
    -pprDeclarationPath = entry (text "declaration path:") . hsep . map text
    329 
    +pprDeclarationPath = entry (text "declaration path") . vcatOrEmpty . map text
    332 330
    333 331 
     -- | […]
    334 332 
     pprFreeVariables :: [OccName] -> SDoc
    335 
    -pprFreeVariables = entry (text "free variables:") . hsep . map ppr
    333 
    +pprFreeVariables = entry (text "free variables") . vcatOrNone . map ppr
    336 334
    337 335 
     -- | […]
    338 336 
     pprBreakpointsInByteCode :: Module -> IntMap CgBreakInfo -> SDoc
    339 337 
     pprBreakpointsInByteCode currentModule
    340 
    -    = entry (text "breakpoints in bytecode:")               .
    338 
    +    = entry (text "breakpoints in bytecode")                .
    341 339 
           vcatOrNone                                            .
    342 340 
           map (uncurry (pprBreakpointInByteCode currentModule)) .
    343 341 
           IntMap.toList
    ... ... @@ -345,7 +343,7 @@ pprBreakpointsInByteCode currentModule
    345 343 
     -- | […]
    346 344 
     pprBreakpointInByteCode :: Module -> Int -> CgBreakInfo -> SDoc
    347 345 
     pprBreakpointInByteCode currentModule ix CgBreakInfo {..}
    348 
    -    = entry (text "breakpoint" <+> ppr ix <> text ":") $
    346 
    +    = entry (text "breakpoint" <+> ppr ix) $
    349 347 
           vcat [
    350 348 
                    pprType                 $ cgb_resty,
    351 349 
                    pprTypeVariables        $ cgb_tyvars,
    ... ... @@ -361,12 +359,12 @@ pprBreakpointInByteCode currentModule ix CgBreakInfo {..}
    361 359 
         -- instance declaration of @XBreakpoint 'TickishPassStg@.
    362 360
    363 361 
     pprType :: IfaceType -> SDoc
    364 
    -pprType = entry (text "type:") . ppr
    362 
    +pprType = entry (text "type") . ppr
    365 363
    366 364 
     -- | […]
    367 365 
     pprTypeVariables :: [IfaceTvBndr] -> SDoc
    368 
    -pprTypeVariables = entry (text "type variables:") .
    369 
    -                   vcat                           .
    366 
    +pprTypeVariables = entry (text "type variables") .
    367 
    +                   vcat                          .
    370 368 
                        map pprTypeVariableBinder
    371 369
    372 370 
     -- | […]
    ... ... @@ -375,9 +373,7 @@ pprTypeVariableBinder (name, kind) = ppr name <+> text "::" <+> ppr kind
    375 373
    376 374 
     -- | […]
    377 375 
     pprVariables :: [Maybe (IfaceIdBndr, Word)] -> SDoc
    378 
    -pprVariables = entry (text "variables:") .
    379 
    -               vcat                           .
    380 
    -               map pprVariable
    376 
    +pprVariables = entry (text "variables") . vcat . map pprVariable
    381 377
    382 378 
     -- | […]
    383 379 
     pprVariable :: Maybe (IfaceIdBndr, Word) -> SDoc
    ... ... @@ -398,7 +394,7 @@ pprVariableBinder (multiplicity, name, type_)
    398 394 
           ppr name <+> text "::" <+> ppr type_
    399 395
    400 396 
     pprOrigin :: Module -> Either InternalBreakLoc BreakpointId -> SDoc
    401 
    -pprOrigin currentModule = entry (text "origin:")        .
    397 
    +pprOrigin currentModule = entry (text "origin")         .
    402 398 
                               pprBreakpointID currentModule .
    403 399 
                               either internalBreakLoc id
    404 400
    ... ... @@ -406,7 +402,9 @@ pprOrigin currentModule = entry (text "origin:") .
    406 402 
     pprBreakpointID :: Module -> BreakpointId -> SDoc
    407 403 
     pprBreakpointID currentModule BreakpointId {..}
    408 404 
         | bi_tick_mod == currentModule = indexDoc
    409 
    -    | otherwise                    = indexDoc <+> text "in" <+> ppr bi_tick_mod
    405 
    +    | otherwise                    = indexDoc                 <+>
    406 
    +                                     text "in"                <+>
    407 
    +                                     quotes (ppr bi_tick_mod)
    410 408 
         where
    411 409
    412 410 
         indexDoc :: SDoc
    ... ... @@ -414,8 +412,8 @@ pprBreakpointID currentModule BreakpointId {..}
    414 412
    415 413 
     -- | […]
    416 414 
     pprStaticPointerTableEntries :: [SptEntry] -> SDoc
    417 
    -pprStaticPointerTableEntries = entry (text "static-pointer table entries:") .
    418 
    -                               vcatOrNone                                   .
    415 
    +pprStaticPointerTableEntries = entry (text "static-pointer table entries") .
    416 
    +                               vcatOrNone                                  .
    419 417 
                                    map pprStaticPointerTableEntry
    420 418
    421 419 
     -- | […]
    ... ... @@ -425,7 +423,7 @@ pprStaticPointerTableEntry (SptEntry name fingerprint)
    425 423
    426 424 
     -- | […]
    427 425 
     pprHPCInfo :: Strict.Maybe ByteCodeHpcInfo -> SDoc
    428 
    -pprHPCInfo = entry (text "HPC information:") .
    426 
    +pprHPCInfo = entry (text "HPC information") .
    429 427 
                  Strict.maybe (text "<none>") pprHPCInfoData
    430 428
    431 429 
     -- | […]
    ... ... @@ -441,23 +439,23 @@ pprHPCInfoData ByteCodeHpcInfo {..}
    441 439
    442 440 
     -- | […]
    443 441 
     pprHPCInfoHash :: Int -> SDoc
    444 
    -pprHPCInfoHash = entry (text "hash:") . pprFixedSizeNatural
    442 
    +pprHPCInfoHash = entry (text "hash") . pprFixedSizeNatural
    445 443
    446 444 
     -- | […]
    447 445 
     pprModuleName :: ShortByteString -> SDoc
    448 
    -pprModuleName = entry (text "module name:") .
    449 
    -                text                        .
    446 
    +pprModuleName = entry (text "module name") .
    447 
    +                text                       .
    450 448 
                     utf8DecodeShortByteString
    451 449
    452 450 
     -- | […]
    453 451 
     pprTickBoxName :: ShortByteString -> SDoc
    454 
    -pprTickBoxName = entry (text "tick box name:") .
    455 
    -                 text                          .
    452 
    +pprTickBoxName = entry (text "tick box name") .
    453 
    +                 text                         .
    456 454 
                      utf8DecodeShortByteString
    457 455
    458 456 
     -- | […]
    459 457 
     pprTickCount :: Int -> SDoc
    460 
    -pprTickCount = entry (text "number of ticks:") . ppr
    458 
    +pprTickCount = entry (text "number of ticks") . ppr
    461 459
    462 460 
     -- | […]
    463 461 
     pprFixedSizeNatural :: (Integral a, FiniteBits a) => a -> SDoc
    ... ... @@ -477,9 +475,14 @@ noOrYes bool = text (if bool then "yes" else "no")
    477 475
    478 476 
     -- | […]
    479 477 
     entry :: SDoc -> SDoc -> SDoc
    480 
    -entry title content = hang title 2 content
    478 
    +entry title content = hang (title <> text ":") 2 content
    481 479
    482 480 
     -- | […]
    483 481 
     vcatOrNone :: [SDoc] -> SDoc
    484 482 
     vcatOrNone []   = text "<none>"
    485 483 
     vcatOrNone docs = vcat docs
    484 
    +
    485 
    +-- | […]
    486 
    +vcatOrEmpty :: [SDoc] -> SDoc
    487 
    +vcatOrEmpty []   = text "<empty>"
    488 
    +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