Wolfgang Jeltsch pushed to branch wip/jeltsch/textual-bytecode-output at Glasgow Haskell Compiler / GHC Commits: 0c9fded2 by Wolfgang Jeltsch at 2026-06-04T13:33:04+03:00 Further Up and Further In - - - - - 1 changed file: - compiler/GHC/ByteCode/Show.hs Changes: ===================================== compiler/GHC/ByteCode/Show.hs ===================================== @@ -11,6 +11,7 @@ import Control.Exception (assert) import Data.Eq ((==)) import Data.Bits (FiniteBits, finiteBitSize) import Data.Function (($), (.)) +import Data.Tuple (uncurry) import Data.Bool (Bool, otherwise, not) import Data.Int (Int) import Data.Word (Word, Word16) @@ -37,6 +38,7 @@ import GHC.Utils.Outputable defaultDumpStyle, SDoc, text, + (<>), (<+>), hsep, vcat, @@ -60,7 +62,7 @@ import GHC.ByteCode.Serialize (readOnDiskModuleByteCode) import GHC.Driver.Env.Types (HscEnv) import GHCi.ResolvedBCO (BCOByteArray, fromBCOByteArray) import GHCi.FFI (FFIType) -import GHCi.Message (ConInfoTable) +import GHCi.Message (ConInfoTable (..)) -- | […] showByteCode :: Logger -> HscEnv -> FilePath -> IO () @@ -109,7 +111,7 @@ pprByteCodeObjects currentModule = entry (text "bytecode objects:") . pprByteCodeObject :: Module -> UnlinkedBCO -> SDoc pprByteCodeObject currentModule byteCodeObject = case byteCodeObject of UnlinkedBCO {..} - -> entry (text "ordinary bytecode object" <+> ppr unlinkedBCOName) $ + -> entry (text "ordinary object" <+> ppr unlinkedBCOName <> text ":") $ vcat [ pprArity $ unlinkedBCOArity, pprInstructions $ unlinkedBCOInstrs, @@ -118,7 +120,12 @@ pprByteCodeObject currentModule byteCodeObject = case byteCodeObject of pprPointers currentModule $ unlinkedBCOPtrs ] UnlinkedStaticCon {..} - -> entry (text "static constructor object" <+> ppr unlinkedStaticConName) $ + -> entry ( + text "static-construction object" <+> + ppr unlinkedStaticConName <> + text ":" + ) + $ vcat [ pprDataConstructorName $ unlinkedStaticConDataConName, pprLiftedness $ not unlinkedStaticConIsUnlifted, @@ -219,9 +226,50 @@ pprPointer currentModule pointer = case pointer of -- | […] pprDataConstructorInfoTables :: [(Name, ConInfoTable)] -> SDoc -pprDataConstructorInfoTables - = entry (text "data constructor info tables:") . - pprDataConstructorInfoTables +pprDataConstructorInfoTables = entry (text "data constructor info tables:") . + vcatOrNone . + map (uncurry pprDataConstructorInfoTableOf) + +-- | […] +pprDataConstructorInfoTableOf :: Name -> ConInfoTable -> SDoc +pprDataConstructorInfoTableOf dataConstrName ConInfoTable {..} + = entry (text "info table of" <+> ppr dataConstrName <> text ":") $ + vcat [ + pprTablePositioning $ conItblTablesNextToCode, + pprLiteralCount $ conItblNPtrs, + pprPointerCount $ conItblPtrs, + pprConstructorTag $ conItblConTag, + pprPointerTag $ conItblPtrTag, + pprDescription $ conItblDescr + ] +{-FIXME: + Check based on any answers to my message on 4 June 2026, 13:17 EEST whether + the current handling of `conItblPtrs` and `conItblNPtrs` is correct. +-} + +-- | […] +pprTablePositioning :: Bool -> SDoc +pprTablePositioning = entry (text "tables next to code:") . noOrYes + +-- | […] +pprLiteralCount :: Int -> SDoc +pprLiteralCount = entry (text "number of literals:") . ppr + +-- | […] +pprPointerCount :: Int -> SDoc +pprPointerCount = entry (text "number of pointers:") . ppr + +-- | […] +pprConstructorTag :: Int -> SDoc +pprConstructorTag = entry (text "constructor tag:") . ppr + +-- | […] +pprPointerTag :: Int -> SDoc +pprPointerTag = entry (text "pointer tag:") . ppr + +-- | […] +pprDescription :: ByteString -> SDoc +pprDescription = entry (text "description:") . pprByteString -- | […] pprTopLevelStrings :: [(Name, ByteString)] -> SDoc @@ -240,9 +288,8 @@ pprBreakpointsData = pprBreakpointsData -- | […] pprStaticPointerTableEntries :: [SptEntry] -> SDoc -pprStaticPointerTableEntries - = entry (text "static-pointer table entries:") . - pprStaticPointerTableEntries +pprStaticPointerTableEntries = entry (text "static-pointer table entries:") . + pprStaticPointerTableEntries -- | […] pprHPCInfo :: Strict.Maybe ByteCodeHpcInfo -> SDoc @@ -255,14 +302,13 @@ pprHPCInfoData = pprHPCInfoData -- | […] pprObjectFileContents :: [ByteString] -> SDoc -pprObjectFileContents - = entry (text "contents of object files:") . - vcatOrNone . - zipWith pprEntry [0 ..] - where +pprObjectFileContents = entry (text "contents of object files:") . + vcatOrNone . + zipWith pprContentOfObjectFile [0 ..] - pprEntry :: Int -> ByteString -> SDoc - pprEntry ix content = entry (text "file" <+> ppr ix) (pprByteString content) +pprContentOfObjectFile :: Int -> ByteString -> SDoc +pprContentOfObjectFile ix = entry (text "file" <+> ppr ix <> text ":") . + pprByteString -- | […] pprByteString :: ByteString -> SDoc View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0c9fded226c95ebe6325361a5d30acd6... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0c9fded226c95ebe6325361a5d30acd6... You're receiving this email because of your account on gitlab.haskell.org.