Wolfgang Jeltsch pushed to branch wip/jeltsch/textual-bytecode-output at Glasgow Haskell Compiler / GHC Commits: a70a5cd8 by Wolfgang Jeltsch at 2026-05-30T18:29:29+03:00 Improvement of code structure - - - - - 8bc75cd9 by Wolfgang Jeltsch at 2026-05-30T18:48:35+03:00 A bit of wobbling - - - - - 1 changed file: - compiler/GHC/ByteCode/Show.hs Changes: ===================================== compiler/GHC/ByteCode/Show.hs ===================================== @@ -10,14 +10,15 @@ import Data.Function (($), (&), (.)) import Data.Bool (otherwise) import Data.Int (Int) import Data.Word (Word8) -import Data.Maybe (maybe) +import Data.Maybe (Maybe, maybe) import Data.List (map, zipWith) import Data.String (String) 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.Strict qualified as Strict (Maybe, maybe) import GHC.Data.FlatBag (elemsFlatBag) +import GHC.Fingerprint (Fingerprint) import GHC.Types.SrcLoc (noSrcSpan) import GHC.Types.Name (Name) import GHC.Types.SptEntry (SptEntry) @@ -57,74 +58,111 @@ pprOnDiskModuleByteCode :: OnDiskModuleByteCode -> SDoc pprOnDiskModuleByteCode OnDiskModuleByteCode {..} = 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) + pprHash odgbc_hash, + pprCompiledByteCode odgbc_compiled_byte_code, + pprObjectFileContents odgbc_foreign ] +-- | […] +pprHash :: Fingerprint -> SDoc +pprHash hash = singleLineEntry (text "hash:") (ppr hash) + -- | […] pprCompiledByteCode :: CompiledByteCode -> SDoc pprCompiledByteCode CompiledByteCode {..} - = vcat - [ - 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) - ] + = multiLineEntry (text "compiled bytecode:") $ + vcat [ + pprByteCodeObjects (elemsFlatBag bc_bcos), + pprDataConstructorInfoTables bc_itbls, + pprTopLevelStrings bc_strs, + pprBreakPoints bc_breaks, + pprStaticPointerTableEntries bc_spt_entries, + pprHPCInfo bc_hpc_info + ] -- | […] pprByteCodeObjects :: [UnlinkedBCO] -> SDoc -pprByteCodeObjects = vcatOrNone . map pprByteCodeObject +pprByteCodeObjects = multiLineEntry (text "bytecode objects:") . + vcatOrNone . + map pprByteCodeObject -- | […] pprByteCodeObject :: UnlinkedBCO -> SDoc -pprByteCodeObject {- UnlinkedBCO {..} -} - = pprByteCodeObject +pprByteCodeObject UnlinkedBCO {..} + = multiLineEntry (text "ordinary bytecode object:") $ + vcat [ + {- + unlinkedBCOName :: !Name, + unlinkedBCOArity :: {-# UNPACK #-} !Int, + unlinkedBCOInstrs :: !(BCOByteArray Word16), -- insns + unlinkedBCOBitmap :: !(BCOByteArray Word), -- bitmap + unlinkedBCOLits :: !(FlatBag BCONPtr), -- non-ptrs + unlinkedBCOPtrs :: !(FlatBag BCOPtr) -- ptrs + -} + ] +pprByteCodeObject UnlinkedStaticCon {..} + = multiLineEntry (text "static constructor object:") $ + vcat [ + {- + unlinkedStaticConName :: !Name, + -- ^ The name to which this static constructor is bound, not to be + -- confused with the name of the static constructor itself + -- ('unlinkedStaticConDataConName') + unlinkedStaticConDataConName :: !Name, + unlinkedStaticConLits :: !(FlatBag BCONPtr), + -- ^ non-ptrs full words, where sub-word literals have already been + -- packed into full words as needed + unlinkedStaticConPtrs :: !(FlatBag BCOPtr), -- ptrs + unlinkedStaticConIsUnlifted :: !Bool + -} + ] -- | […] pprDataConstructorInfoTables :: [(Name, ConInfoTable)] -> SDoc -pprDataConstructorInfoTables = pprDataConstructorInfoTables +pprDataConstructorInfoTables + = multiLineEntry (text "data constructor info tables:") . + pprDataConstructorInfoTables -- | […] pprTopLevelStrings :: [(Name, ByteString)] -> SDoc -pprTopLevelStrings = pprTopLevelStrings +pprTopLevelStrings = multiLineEntry (text "top-level strings:") . + pprTopLevelStrings + +-- | […] +pprBreakPoints :: Maybe InternalModBreaks -> SDoc +pprBreakPoints = multiLineEntry (text "break points:") . + maybe (text "<none>") pprBreakPointsData -- | […] -pprInternalBreakPoints :: InternalModBreaks -> SDoc -pprInternalBreakPoints = pprInternalBreakPoints +pprBreakPointsData :: InternalModBreaks -> SDoc +pprBreakPointsData = pprBreakPointsData +{-FIMXE: + Instead of outputting module perhaps assert that it is identical to the + present one (if this indeed how it should be). +-} -- | […] pprStaticPointerTableEntries :: [SptEntry] -> SDoc -pprStaticPointerTableEntries = pprStaticPointerTableEntries +pprStaticPointerTableEntries + = multiLineEntry (text "static-pointer table entries:") . + pprStaticPointerTableEntries + +-- | […] +pprHPCInfo :: Strict.Maybe ByteCodeHpcInfo -> SDoc +pprHPCInfo = multiLineEntry (text "HPC information:") . + Strict.maybe (text "<none>") pprHPCInfoData -- | […] -pprHPCInfo :: ByteCodeHpcInfo -> SDoc -pprHPCInfo = pprHPCInfo +pprHPCInfoData :: ByteCodeHpcInfo -> SDoc +pprHPCInfoData = pprHPCInfoData -- | […] pprObjectFileContents :: [ByteString] -> SDoc -pprObjectFileContents = vcatOrNone . zipWith pprEntry [0 ..] where +pprObjectFileContents + = multiLineEntry (text "contents of object files:") . + vcatOrNone . + zipWith pprEntry [0 ..] + where pprEntry :: Int -> ByteString -> SDoc pprEntry ix content = multiLineEntry (text "file" <+> ppr ix) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4f217a585c7e4c142b7f8434a9e2caa... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4f217a585c7e4c142b7f8434a9e2caa... You're receiving this email because of your account on gitlab.haskell.org.