Wolfgang Jeltsch pushed to branch wip/jeltsch/textual-bytecode-output at Glasgow Haskell Compiler / GHC Commits: d1436c99 by Wolfgang Jeltsch at 2026-07-17T21:35:57+03:00 Add missing import of `(>=)` - - - - - f3a7a06a by Wolfgang Jeltsch at 2026-07-17T21:37:40+03:00 Improve and correct the terminology around `Maybe` values - - - - - 26550866 by Wolfgang Jeltsch at 2026-07-17T21:48:08+03:00 Make it explicit where enclosing modules are expected - - - - - 1 changed file: - compiler/GHC/ByteCode/Show.hs Changes: ===================================== compiler/GHC/ByteCode/Show.hs ===================================== @@ -9,6 +9,7 @@ import Prelude ((+), (-), Integral, div) import Control.Arrow ((>>>)) import Control.Exception (assert) import Data.Eq ((==)) +import Data.Ord ((>=)) import Data.Bits (FiniteBits, finiteBitSize) import Data.Function (($), id, (.)) import Data.Tuple (fst, uncurry) @@ -106,7 +107,9 @@ pprOnDiskModuleByteCodeHash :: Fingerprint -> SDoc pprOnDiskModuleByteCodeHash = entry (text "hash") . ppr -- | Constructs textual information about bytecode. -pprCompiledByteCode :: Module -> CompiledByteCode -> SDoc +pprCompiledByteCode :: Module -- ^ The enclosing module + -> CompiledByteCode -- ^ The bytecode + -> SDoc -- ^ The textual information pprCompiledByteCode currentModule CompiledByteCode {..} = vcat [ pprByteCodeObjects currentModule $ bc_bcos, @@ -118,14 +121,18 @@ pprCompiledByteCode currentModule CompiledByteCode {..} ] -- | Constructs textual information about bytecode objects. -pprByteCodeObjects :: Module -> FlatBag UnlinkedBCO -> SDoc +pprByteCodeObjects :: Module -- ^ The enlosing module + -> FlatBag UnlinkedBCO -- ^ The bytecode objects + -> SDoc -- ^ The textual information pprByteCodeObjects currentModule = entry (text "objects") . vcatOrNone . map (pprByteCodeObject currentModule) . elemsFlatBag -- | Constructs textual information about a single bytecode object. -pprByteCodeObject :: Module -> UnlinkedBCO -> SDoc +pprByteCodeObject :: Module -- ^ The enclosing module + -> UnlinkedBCO -- ^ The bytecode object + -> SDoc -- ^ The textual information pprByteCodeObject currentModule byteCodeObject = case byteCodeObject of UnlinkedBCO {..} -> entry (text "ordinary object" <+> quotes (ppr unlinkedBCOName)) $ @@ -163,14 +170,18 @@ pprLiftedness :: Bool -> SDoc pprLiftedness = entry (text "lifted") . noOrYes -- | Constructs textual information about literals. -pprLiterals :: Module -> FlatBag BCONPtr -> SDoc +pprLiterals :: Module -- ^ The enclosing module + -> FlatBag BCONPtr -- ^ The literals + -> SDoc -- ^ The textual information pprLiterals currentModule = entry (text "literals") . vcatOrNone . map (pprLiteral currentModule) . elemsFlatBag -- | Constructs textual information about a single literal. -pprLiteral :: Module -> BCONPtr -> SDoc +pprLiteral :: Module -- ^ The enclosing module + -> BCONPtr -- ^ The literal + -> SDoc -- ^ The textual information pprLiteral currentModule literal = case literal of BCONPtrWord word -> text "word" <+> @@ -197,7 +208,7 @@ pprLiteral currentModule literal = case literal of -> text "cost center of breakpoint" <+> pprInternalBreakpointID currentModule breakpointID --- | Constructs textual information about some FFI info. +-- | Constructs textual information about FFI info. pprFFIInfo :: FFIInfo -> SDoc pprFFIInfo FFIInfo {..} = hsep (map (pprFFIType >>> (<+> text "->")) ffiInfoArgs) <+> @@ -211,7 +222,10 @@ pprFFIType ffiType = assert (take 3 ident == "FFI") $ text (drop 3 ident) where ident = show ffiType -- | Constructs textual information about the ID of a bytecode breakpoint. -pprInternalBreakpointID :: Module -> InternalBreakpointId -> SDoc +pprInternalBreakpointID + :: Module -- ^ The enclosing module + -> InternalBreakpointId -- ^ The ID of the bytecode breakpoint + -> SDoc -- ^ The textual information pprInternalBreakpointID currentModule InternalBreakpointId {..} | ibi_info_mod == currentModule = indexDoc | otherwise = indexDoc <+> @@ -223,14 +237,18 @@ pprInternalBreakpointID currentModule InternalBreakpointId {..} indexDoc = ppr ibi_info_index -- | Constructs textual information about pointers. -pprPointers :: Module -> FlatBag BCOPtr -> SDoc +pprPointers :: Module -- ^ The enclosing module + -> FlatBag BCOPtr -- ^ The pointers + -> SDoc -- ^ The textual information pprPointers currentModule = entry (text "utilized items") . vcatOrNone . map (pprPointer currentModule) . elemsFlatBag -- | Constructs textual information about a single pointer. -pprPointer :: Module -> BCOPtr -> SDoc +pprPointer :: Module -- ^ The enclosing module + -> BCOPtr -- ^ The pointer + -> SDoc -- ^ The textual information pprPointer currentModule pointer = case pointer of BCOPtrName name -> text "item named" <+> quotes (ppr name) @@ -279,21 +297,27 @@ pprTopLevelString stringName encodedString = entry (ppr stringName) $ encodedString -- | Constructs textual information about breakpoints. -pprBreakpoints :: Module -> Maybe InternalModBreaks -> SDoc +pprBreakpoints :: Module -- ^ The enclosing module + -> Maybe InternalModBreaks -- ^ The breakpoints + -> SDoc -- ^ The textual information pprBreakpoints currentModule = entry (text "breakpoints") . - maybe (text "<none>") (pprBreakpointsData currentModule) + maybe (text "<none>") (pprActualBreakpoints currentModule) --- | Constructs textual information about a single breakpoint. -pprBreakpointsData :: Module -> InternalModBreaks -> SDoc -pprBreakpointsData currentModule InternalModBreaks {..} +-- | Constructs textual information about actual breakpoints. +pprActualBreakpoints :: Module -- ^ The enclosing module + -> InternalModBreaks -- ^ The actual breakpoints + -> SDoc -- ^ The textual information +pprActualBreakpoints currentModule InternalModBreaks {..} = vcat [ pprSourceBreakpoints currentModule $ imodBreaks_modBreaks, pprByteCodeBreakpoints currentModule $ imodBreaks_breakInfo ] -- | Constructs textual information about source breakpoints. -pprSourceBreakpoints :: Module -> ModBreaks -> SDoc +pprSourceBreakpoints :: Module -- ^ The enclosing module + -> ModBreaks -- ^ The source breakpoints + -> SDoc -- ^ The textual information pprSourceBreakpoints currentModule ModBreaks {..} = entry (text "source breakpoints") $ assert (modBreaks_module == currentModule) $ @@ -336,7 +360,9 @@ pprFreeVariables :: [OccName] -> SDoc pprFreeVariables = entry (text "free variables") . vcatOrNone . map ppr -- | Constructs textual information about bytecode breakpoints. -pprByteCodeBreakpoints :: Module -> IntMap CgBreakInfo -> SDoc +pprByteCodeBreakpoints :: Module -- ^ The enclosing module + -> IntMap CgBreakInfo -- ^ The bytecode breakpoints + -> SDoc -- ^ The textual information pprByteCodeBreakpoints currentModule = entry (text "bytecode breakpoints") . vcatOrNone . @@ -344,7 +370,10 @@ pprByteCodeBreakpoints currentModule IntMap.toList -- | Constructs textual information about a single bytecode breakpoint. -pprByteCodeBreakpoint :: Module -> Int -> CgBreakInfo -> SDoc +pprByteCodeBreakpoint :: Module -- ^ The enclosing module + -> Int -- ^ The index of the bytecode breakpoint + -> CgBreakInfo -- ^ The bytecode breakpoint + -> SDoc -- ^ The textual information pprByteCodeBreakpoint currentModule ix CgBreakInfo {..} = entry (text "bytecode breakpoint" <+> ppr ix) $ vcat [ @@ -392,15 +421,20 @@ pprVariableBinder (multiplicity, name, type_) -- | Constructs textual information about a source breakpoint corresponding to a -- bytecode breakpoint. pprCorrespondingSourceBreakpoint :: Module + -- ^ The enclosing module -> Either InternalBreakLoc BreakpointId + -- ^ A reference to the source breakpoint -> SDoc + -- ^ The textual information pprCorrespondingSourceBreakpoint currentModule = entry (text "corresponding source breakpoint") . pprBreakpointID currentModule . either internalBreakLoc id -- | Constructs textual information about the ID of a source breakpoint. -pprBreakpointID :: Module -> BreakpointId -> SDoc +pprBreakpointID :: Module -- ^ The enclosing module + -> BreakpointId -- ^ The ID of the source breakpoint + -> SDoc -- ^ The textual information pprBreakpointID currentModule BreakpointId {..} | bi_tick_mod == currentModule = indexDoc | otherwise = indexDoc <+> @@ -422,14 +456,14 @@ pprStaticPointerTableEntry :: SptEntry -> SDoc pprStaticPointerTableEntry (SptEntry name fingerprint) = ppr fingerprint <> text ":" <+> ppr name --- | Constructs textual information about some HPC info. +-- | Constructs textual information about HPC info. pprHPCInfo :: Strict.Maybe ByteCodeHpcInfo -> SDoc pprHPCInfo = entry (text "HPC information") . - Strict.maybe (text "<none>") pprHPCInfoData + Strict.maybe (text "<none>") pprActualHPCInfo --- | Constructs textual information about data that makes up some HPC info. -pprHPCInfoData :: ByteCodeHpcInfo -> SDoc -pprHPCInfoData ByteCodeHpcInfo {..} +-- | Constructs textual information about actual HPC info. +pprActualHPCInfo :: ByteCodeHpcInfo -> SDoc +pprActualHPCInfo ByteCodeHpcInfo {..} = vcat [ pprHPCInfoHash $ bchi_hash, pprModuleName $ bchi_module_name, @@ -438,7 +472,7 @@ pprHPCInfoData ByteCodeHpcInfo {..} ] where --- | Constructs textual information about the hash of some HPC info. +-- | Constructs textual information about the hash of HPC info. pprHPCInfoHash :: Int -> SDoc pprHPCInfoHash = entry (text "hash") . pprFixedSizeNatural View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2f58c3a2d3c0e6f3738865a01ace68e... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2f58c3a2d3c0e6f3738865a01ace68e... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help