Wolfgang Jeltsch pushed to branch wip/jeltsch/textual-bytecode-output at Glasgow Haskell Compiler / GHC Commits: b8d3533a by Wolfgang Jeltsch at 2026-07-10T18:06:59+03:00 Make output of free variables vertical with `<none>` - - - - - f2dd3cce by Wolfgang Jeltsch at 2026-07-10T18:10:20+03:00 Make output of declaration paths vertical with `<empty`> - - - - - 78044d0a by Wolfgang Jeltsch at 2026-07-10T18:26:08+03:00 Remove `compiled bytecode:` and the following indentation - - - - - 0035654b by Wolfgang Jeltsch at 2026-07-10T20:53:47+03:00 Shorten “bytecode objects” to “objects” - - - - - 8d81bf98 by Wolfgang Jeltsch at 2026-07-10T21:05:32+03:00 Include outputting of the colon in `entry` - - - - - 94d5f860 by Wolfgang Jeltsch at 2026-07-10T21:36:00+03:00 Add quotes where appropriate - - - - - 64f1f572 by Wolfgang Jeltsch at 2026-07-10T21:50:36+03:00 Improve the output of “pointers” - - - - - 1 changed file: - compiler/GHC/ByteCode/Show.hs Changes: ===================================== compiler/GHC/ByteCode/Show.hs ===================================== @@ -47,6 +47,7 @@ import GHC.Utils.Outputable text, (<>), (<+>), + quotes, hsep, vcat, hang, @@ -98,17 +99,16 @@ pprOnDiskModuleByteCode OnDiskModuleByteCode {..} -- | […] pprModuleIdent :: Module -> SDoc -pprModuleIdent = entry (text "name:") . ppr +pprModuleIdent = entry (text "name") . ppr -- | […] pprOnDiskModuleByteCodeHash :: Fingerprint -> SDoc -pprOnDiskModuleByteCodeHash = entry (text "hash:") . ppr +pprOnDiskModuleByteCodeHash = entry (text "hash") . ppr -- | […] pprCompiledByteCode :: Module -> CompiledByteCode -> SDoc pprCompiledByteCode currentModule CompiledByteCode {..} - = entry (text "compiled bytecode:") $ - vcat [ + = vcat [ pprByteCodeObjects currentModule $ bc_bcos, pprDataConstructorInfoTables $ bc_itbls, pprTopLevelStrings $ bc_strs, @@ -119,7 +119,7 @@ pprCompiledByteCode currentModule CompiledByteCode {..} -- | […] pprByteCodeObjects :: Module -> FlatBag UnlinkedBCO -> SDoc -pprByteCodeObjects currentModule = entry (text "bytecode objects:") . +pprByteCodeObjects currentModule = entry (text "objects") . vcatOrNone . map (pprByteCodeObject currentModule) . elemsFlatBag @@ -128,7 +128,7 @@ pprByteCodeObjects currentModule = entry (text "bytecode objects:") . pprByteCodeObject :: Module -> UnlinkedBCO -> SDoc pprByteCodeObject currentModule byteCodeObject = case byteCodeObject of UnlinkedBCO {..} - -> entry (text "ordinary object" <+> ppr unlinkedBCOName <> text ":") $ + -> entry (text "ordinary object" <+> quotes (ppr unlinkedBCOName)) $ vcat [ pprArity $ unlinkedBCOArity, pprLiterals currentModule $ unlinkedBCOLits, @@ -136,9 +136,8 @@ pprByteCodeObject currentModule byteCodeObject = case byteCodeObject of ] UnlinkedStaticCon {..} -> entry ( - text "static-construction object" <+> - ppr unlinkedStaticConName <> - text ":" + text "static-construction object" <+> + quotes (ppr unlinkedStaticConName) ) $ vcat [ @@ -150,19 +149,19 @@ pprByteCodeObject currentModule byteCodeObject = case byteCodeObject of -- | […] pprArity :: Int -> SDoc -pprArity = entry (text "arity:") . ppr +pprArity = entry (text "arity") . ppr -- | […] pprDataConstructorName :: Name -> SDoc -pprDataConstructorName = entry (text "data constructor name:") . ppr +pprDataConstructorName = entry (text "data constructor name") . ppr -- | […] pprLiftedness :: Bool -> SDoc -pprLiftedness = entry (text "lifted:") . noOrYes +pprLiftedness = entry (text "lifted") . noOrYes -- | […] pprLiterals :: Module -> FlatBag BCONPtr -> SDoc -pprLiterals currentModule = entry (text "literals:") . +pprLiterals currentModule = entry (text "literals") . vcatOrNone . map (pprLiteral currentModule) . elemsFlatBag @@ -175,13 +174,13 @@ pprLiteral currentModule literal = case literal of ppr word BCONPtrLbl label -> text "label" <+> - ppr label + quotes (ppr label) BCONPtrItbl infoTableName -> text "info table of" <+> - ppr infoTableName + quotes (ppr infoTableName) BCONPtrAddr addrName -> text "address" <+> - ppr addrName + quotes (ppr addrName) BCONPtrStr encodedString -> text "top-level string" <+> text (show (utf8DecodeByteString encodedString)) @@ -190,7 +189,7 @@ pprLiteral currentModule literal = case literal of text (show (unpackFS string)) BCONPtrFFIInfo ffiInfo -> text "foreign function" <+> - pprFFIInfo ffiInfo + quotes (pprFFIInfo ffiInfo) BCONPtrCostCentre breakpointID -> text "cost center" <+> pprInternalBreakpointID currentModule breakpointID @@ -222,7 +221,7 @@ pprInternalBreakpointID currentModule InternalBreakpointId {..} -- | […] pprPointers :: Module -> FlatBag BCOPtr -> SDoc -pprPointers currentModule = entry (text "pointers:") . +pprPointers currentModule = entry (text "utilized items") . vcatOrNone . map (pprPointer currentModule) . elemsFlatBag @@ -231,24 +230,24 @@ pprPointers currentModule = entry (text "pointers:") . pprPointer :: Module -> BCOPtr -> SDoc pprPointer currentModule pointer = case pointer of BCOPtrName name - -> text "name" <+> ppr name + -> text "item named" <+> quotes (ppr name) BCOPtrPrimOp primOp - -> text "primitive operation" <+> ppr primOp + -> text "primitive operation" <+> quotes (ppr primOp) BCOPtrBCO byteCodeObject -> pprByteCodeObject currentModule byteCodeObject BCOPtrBreakArray breakArrayModule - -> text "break array of module" <+> ppr breakArrayModule + -> text "break array of module" <+> quotes (ppr breakArrayModule) -- | […] pprDataConstructorInfoTables :: [(Name, ConInfoTable)] -> SDoc -pprDataConstructorInfoTables = entry (text "data constructor info tables:") . - vcatOrNone . +pprDataConstructorInfoTables = entry (text "data constructor info tables") . + vcatOrNone . map (uncurry pprDataConstructorInfoTable) -- | […] pprDataConstructorInfoTable :: Name -> ConInfoTable -> SDoc pprDataConstructorInfoTable dataConstrName ConInfoTable {..} - = entry (text "info table of" <+> ppr dataConstrName <> text ":") $ + = entry (text "info table of" <+> quotes (ppr dataConstrName)) $ vcat [ pprPointerWordCount $ conItblPtrs, pprNonPointerWordCount $ conItblNPtrs @@ -256,31 +255,30 @@ pprDataConstructorInfoTable dataConstrName ConInfoTable {..} -- | […] pprPointerWordCount :: Int -> SDoc -pprPointerWordCount = entry (text "number of words for pointers:") . ppr +pprPointerWordCount = entry (text "number of words for pointers") . ppr -- | […] pprNonPointerWordCount :: Int -> SDoc -pprNonPointerWordCount = entry (text "number of words for non-pointers:") . ppr +pprNonPointerWordCount = entry (text "number of words for non-pointers") . ppr -- | […] pprTopLevelStrings :: [(Name, ByteString)] -> SDoc -pprTopLevelStrings = entry (text "top-level strings:") . - vcatOrNone . +pprTopLevelStrings = entry (text "top-level strings") . + vcatOrNone . map (uncurry pprTopLevelString) -- | […] pprTopLevelString :: Name -> ByteString -> SDoc -pprTopLevelString stringName encodedString - = entry (ppr stringName <> text ":") $ - text $ - show $ - utf8DecodeByteString $ - encodedString +pprTopLevelString stringName encodedString = entry (ppr stringName) $ + text $ + show $ + utf8DecodeByteString $ + encodedString -- | […] pprBreakpoints :: Module -> Maybe InternalModBreaks -> SDoc pprBreakpoints currentModule - = entry (text "breakpoints:") . + = entry (text "breakpoints") . maybe (text "<none>") (pprBreakpointsData currentModule) -- | […] @@ -294,7 +292,7 @@ pprBreakpointsData currentModule InternalModBreaks {..} -- | […] pprBreakpointsInSource :: Module -> ModBreaks -> SDoc pprBreakpointsInSource currentModule ModBreaks {..} - = entry (text "breakpoints in source:") $ + = entry (text "breakpoints in source") $ assert (modBreaks_module == currentModule) $ assert (bounds modBreaks_locs_ == bounds modBreaks_decls) $ assert (bounds modBreaks_locs_ == bounds modBreaks_vars) $ @@ -315,7 +313,7 @@ pprBreakpointInSource :: BreakTickIndex -> [OccName] -> SDoc pprBreakpointInSource ix srcSpan declarationPath freeVars - = entry (text "breakpoint" <+> ppr ix <> text ":") $ + = entry (text "breakpoint" <+> ppr ix) $ vcat [ pprSrcSpan $ srcSpan, pprDeclarationPath $ declarationPath, @@ -324,20 +322,20 @@ pprBreakpointInSource ix srcSpan declarationPath freeVars -- | […] pprSrcSpan :: BinSrcSpan -> SDoc -pprSrcSpan = entry (text "source span:") . ppr . unBinSrcSpan +pprSrcSpan = entry (text "source span") . ppr . unBinSrcSpan -- | […] pprDeclarationPath :: [String] -> SDoc -pprDeclarationPath = entry (text "declaration path:") . hsep . map text +pprDeclarationPath = entry (text "declaration path") . vcatOrEmpty . map text -- | […] pprFreeVariables :: [OccName] -> SDoc -pprFreeVariables = entry (text "free variables:") . hsep . map ppr +pprFreeVariables = entry (text "free variables") . vcatOrNone . map ppr -- | […] pprBreakpointsInByteCode :: Module -> IntMap CgBreakInfo -> SDoc pprBreakpointsInByteCode currentModule - = entry (text "breakpoints in bytecode:") . + = entry (text "breakpoints in bytecode") . vcatOrNone . map (uncurry (pprBreakpointInByteCode currentModule)) . IntMap.toList @@ -345,7 +343,7 @@ pprBreakpointsInByteCode currentModule -- | […] pprBreakpointInByteCode :: Module -> Int -> CgBreakInfo -> SDoc pprBreakpointInByteCode currentModule ix CgBreakInfo {..} - = entry (text "breakpoint" <+> ppr ix <> text ":") $ + = entry (text "breakpoint" <+> ppr ix) $ vcat [ pprType $ cgb_resty, pprTypeVariables $ cgb_tyvars, @@ -361,12 +359,12 @@ pprBreakpointInByteCode currentModule ix CgBreakInfo {..} -- instance declaration of @XBreakpoint 'TickishPassStg@. pprType :: IfaceType -> SDoc -pprType = entry (text "type:") . ppr +pprType = entry (text "type") . ppr -- | […] pprTypeVariables :: [IfaceTvBndr] -> SDoc -pprTypeVariables = entry (text "type variables:") . - vcat . +pprTypeVariables = entry (text "type variables") . + vcat . map pprTypeVariableBinder -- | […] @@ -375,9 +373,7 @@ pprTypeVariableBinder (name, kind) = ppr name <+> text "::" <+> ppr kind -- | […] pprVariables :: [Maybe (IfaceIdBndr, Word)] -> SDoc -pprVariables = entry (text "variables:") . - vcat . - map pprVariable +pprVariables = entry (text "variables") . vcat . map pprVariable -- | […] pprVariable :: Maybe (IfaceIdBndr, Word) -> SDoc @@ -398,7 +394,7 @@ pprVariableBinder (multiplicity, name, type_) ppr name <+> text "::" <+> ppr type_ pprOrigin :: Module -> Either InternalBreakLoc BreakpointId -> SDoc -pprOrigin currentModule = entry (text "origin:") . +pprOrigin currentModule = entry (text "origin") . pprBreakpointID currentModule . either internalBreakLoc id @@ -406,7 +402,9 @@ pprOrigin currentModule = entry (text "origin:") . pprBreakpointID :: Module -> BreakpointId -> SDoc pprBreakpointID currentModule BreakpointId {..} | bi_tick_mod == currentModule = indexDoc - | otherwise = indexDoc <+> text "in" <+> ppr bi_tick_mod + | otherwise = indexDoc <+> + text "in" <+> + quotes (ppr bi_tick_mod) where indexDoc :: SDoc @@ -414,8 +412,8 @@ pprBreakpointID currentModule BreakpointId {..} -- | […] pprStaticPointerTableEntries :: [SptEntry] -> SDoc -pprStaticPointerTableEntries = entry (text "static-pointer table entries:") . - vcatOrNone . +pprStaticPointerTableEntries = entry (text "static-pointer table entries") . + vcatOrNone . map pprStaticPointerTableEntry -- | […] @@ -425,7 +423,7 @@ pprStaticPointerTableEntry (SptEntry name fingerprint) -- | […] pprHPCInfo :: Strict.Maybe ByteCodeHpcInfo -> SDoc -pprHPCInfo = entry (text "HPC information:") . +pprHPCInfo = entry (text "HPC information") . Strict.maybe (text "<none>") pprHPCInfoData -- | […] @@ -441,23 +439,23 @@ pprHPCInfoData ByteCodeHpcInfo {..} -- | […] pprHPCInfoHash :: Int -> SDoc -pprHPCInfoHash = entry (text "hash:") . pprFixedSizeNatural +pprHPCInfoHash = entry (text "hash") . pprFixedSizeNatural -- | […] pprModuleName :: ShortByteString -> SDoc -pprModuleName = entry (text "module name:") . - text . +pprModuleName = entry (text "module name") . + text . utf8DecodeShortByteString -- | […] pprTickBoxName :: ShortByteString -> SDoc -pprTickBoxName = entry (text "tick box name:") . - text . +pprTickBoxName = entry (text "tick box name") . + text . utf8DecodeShortByteString -- | […] pprTickCount :: Int -> SDoc -pprTickCount = entry (text "number of ticks:") . ppr +pprTickCount = entry (text "number of ticks") . ppr -- | […] pprFixedSizeNatural :: (Integral a, FiniteBits a) => a -> SDoc @@ -477,9 +475,14 @@ noOrYes bool = text (if bool then "yes" else "no") -- | […] entry :: SDoc -> SDoc -> SDoc -entry title content = hang title 2 content +entry title content = hang (title <> text ":") 2 content -- | […] vcatOrNone :: [SDoc] -> SDoc vcatOrNone [] = text "<none>" vcatOrNone docs = vcat docs + +-- | […] +vcatOrEmpty :: [SDoc] -> SDoc +vcatOrEmpty [] = text "<empty>" +vcatOrEmpty docs = vcat docs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/326218284b4f78460697fd7db33036a... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/326218284b4f78460697fd7db33036a... You're receiving this email because of your account on gitlab.haskell.org.