[Git][ghc/ghc][wip/jeltsch/textual-bytecode-output] 2 commits: Improvement of code structure

30 May 2026


      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.

    

Wolfgang Jeltsch (＠jeltsch)

tags

participants (1)