Wolfgang Jeltsch pushed to branch wip/jeltsch/textual-bytecode-output at Glasgow Haskell Compiler / GHC Commits: 4f217a58 by Wolfgang Jeltsch at 2026-05-30T17:38:09+03:00 Improvements and a small extension - - - - - 1 changed file: - compiler/GHC/ByteCode/Show.hs Changes: ===================================== compiler/GHC/ByteCode/Show.hs ===================================== @@ -13,11 +13,11 @@ import Data.Word (Word8) import Data.Maybe (maybe) import Data.List (map, zipWith) import Data.String (String) -import Data.ByteString (ByteString, null, length, unpack) +import Data.ByteString (ByteString, null, unpack) import Numeric (showHex) import System.IO (IO, FilePath) import GHC.Data.Strict qualified as Strict (maybe) -import GHC.Data.FlatBag (FlatBag) +import GHC.Data.FlatBag (elemsFlatBag) import GHC.Types.SrcLoc (noSrcSpan) import GHC.Types.Name (Name) import GHC.Types.SptEntry (SptEntry) @@ -31,6 +31,7 @@ import GHC.Utils.Outputable (<+>), hsep, nest, + ($$), vcat, withPprStyle, ppr @@ -54,42 +55,52 @@ showByteCode logger env path = do -- | […] pprOnDiskModuleByteCode :: OnDiskModuleByteCode -> SDoc pprOnDiskModuleByteCode OnDiskModuleByteCode {..} - = vcat $ - [ - text "module" <+> ppr odgbc_module, - nest 2 $ vcat - [ - text "hash:" - <+> ppr odgbc_hash, - text "compiled bytecode:" - <+> pprCompiledByteCode odgbc_compiled_byte_code, - text "contents of object files:" - <+> pprObjectFileContents odgbc_foreign - ] - ] + = multiLineEntry (text "module" <+> ppr odgbc_module) $ + vcat [ + singleLineEntry + (text "hash:") + (ppr odgbc_hash), + multiLineEntry + (text "compiled bytecode:") + (pprCompiledByteCode odgbc_compiled_byte_code), + multiLineEntry + (text "contents of object files:") + (pprObjectFileContents odgbc_foreign) + ] -- | […] pprCompiledByteCode :: CompiledByteCode -> SDoc pprCompiledByteCode CompiledByteCode {..} = vcat [ - text "bytecode objects" - <+> pprByteCodeObjects bc_bcos, - text "data constructor info tables:" - <+> pprDataConstructorInfoTables bc_itbls, - text "top-level strings:" - <+> pprTopLevelStrings bc_strs, - text "break points:" - <+> maybe (text "<none>") pprInternalBreakPoints bc_breaks, - text "static-pointer table entries:" - <+> pprStaticPointerTableEntries bc_spt_entries, - text "HPC information:" - <+> Strict.maybe (text "<none>") pprHPCInfo bc_hpc_info + multiLineEntry + (text "bytecode objects") + (pprByteCodeObjects (elemsFlatBag bc_bcos)), + multiLineEntry + (text "data constructor info tables:") + (pprDataConstructorInfoTables bc_itbls), + multiLineEntry + (text "top-level strings:") + (pprTopLevelStrings bc_strs), + multiLineEntry + (text "break points:") + (maybe (text "<none>") pprInternalBreakPoints bc_breaks), + multiLineEntry + (text "static-pointer table entries:") + (pprStaticPointerTableEntries bc_spt_entries), + multiLineEntry + (text "HPC information:") + (Strict.maybe (text "<none>") pprHPCInfo bc_hpc_info) ] -- | […] -pprByteCodeObjects :: FlatBag UnlinkedBCO -> SDoc -pprByteCodeObjects = pprByteCodeObjects +pprByteCodeObjects :: [UnlinkedBCO] -> SDoc +pprByteCodeObjects = vcatOrNone . map pprByteCodeObject + +-- | […] +pprByteCodeObject :: UnlinkedBCO -> SDoc +pprByteCodeObject {- UnlinkedBCO {..} -} + = pprByteCodeObject -- | […] pprDataConstructorInfoTables :: [(Name, ConInfoTable)] -> SDoc @@ -116,16 +127,8 @@ pprObjectFileContents :: [ByteString] -> SDoc pprObjectFileContents = vcatOrNone . zipWith pprEntry [0 ..] where pprEntry :: Int -> ByteString -> SDoc - pprEntry ix content - = vcat [ - hsep [ - text "file", - ppr ix, - text "of length", - ppr (length content) - ], - nest 2 $ pprByteString content - ] + pprEntry ix content = multiLineEntry (text "file" <+> ppr ix) + (pprByteString content) -- | […] pprByteString :: ByteString -> SDoc @@ -140,6 +143,14 @@ pprByte byte = text $ if byte < 16 then '0' : unpadded else unpadded where unpadded :: String unpadded = showHex byte "" +-- | […] +singleLineEntry :: SDoc -> SDoc -> SDoc +singleLineEntry title content = title <+> content + +-- | […] +multiLineEntry :: SDoc -> SDoc -> SDoc +multiLineEntry title content = title $$ nest 2 content + -- | […] vcatOrNone :: [SDoc] -> SDoc vcatOrNone [] = text "<none>" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f217a585c7e4c142b7f8434a9e2caac... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f217a585c7e4c142b7f8434a9e2caac... You're receiving this email because of your account on gitlab.haskell.org.