Wolfgang Jeltsch pushed to branch wip/jeltsch/textual-bytecode-output at Glasgow Haskell Compiler / GHC Commits: 973d8aaa by Wolfgang Jeltsch at 2026-08-05T20:20:22+03:00 Make final corrections and improvements - - - - - 01ff2ea4 by Wolfgang Jeltsch at 2026-08-05T20:29:43+03:00 Change the `emsdk` test output name suffix to `wasi` - - - - - 6 changed files: - compiler/GHC/ByteCode/Show.hs - testsuite/tests/show-bytecode/Example.hs - testsuite/tests/show-bytecode/normalize - testsuite/tests/show-bytecode/show-bytecode-breakpoints.stdout-ghcjs → testsuite/tests/show-bytecode/show-bytecode-breakpoints.stdout-wasi - testsuite/tests/show-bytecode/show-bytecode-hpc.stdout-ghcjs → testsuite/tests/show-bytecode/show-bytecode-hpc.stdout-wasi - testsuite/tests/show-bytecode/show-bytecode-vanilla.stdout-ghcjs → testsuite/tests/show-bytecode/show-bytecode-vanilla.stdout-wasi Changes: ===================================== compiler/GHC/ByteCode/Show.hs ===================================== @@ -6,6 +6,9 @@ -- of bytecode files. It is the backbone of the @--show-byte-code@ option. module GHC.ByteCode.Show (showByteCode) where +-- The output generated by 'showByteCode' shall follow some general guidelines. +-- See Note [Guidelines for the output of @--show-byte-code@] for details. + -- Prelude import GHC.Prelude @@ -35,28 +38,29 @@ import GHC.Data.FastString (unpackFS) import GHC.Data.FlatBag (FlatBag, elemsFlatBag) import GHC.Fingerprint (Fingerprint) import GHC.Types.SrcLoc (noSrcSpan) -import GHC.Types.Name (Name, nameOccName) -import GHC.Types.Name.Occurrence (OccName, isSymOcc) +import GHC.Types.Name (Name) +import GHC.Types.Name.Occurrence (OccName, HasOccName, occName, parenSymOcc) import GHC.Types.Tickish (BreakTickIndex, BreakpointId (..)) import GHC.Types.SptEntry (SptEntry (..)) import GHC.Types.Error (MessageClass (MCDump)) import GHC.Utils.Panic.Plain (assert) +import GHC.Utils.Encoding.UTF8 (utf8DecodeShortByteString, utf8DecodeByteString) import GHC.Utils.Logger (Logger, logMsg) import GHC.Utils.Binary (BinSrcSpan (..)) -import GHC.Utils.Encoding.UTF8 (utf8DecodeShortByteString, utf8DecodeByteString) import GHC.Utils.Outputable ( + Outputable, defaultDumpStyle, SDoc, text, (<>), (<+>), - quotes, hsep, + quotes, vcat, hang, - withPprStyle, - ppr + ppr, + withPprStyle ) import GHC.Unit.Types (Module, moduleName) import GHC.Iface.Type (IfaceType, IfaceTvBndr, IfaceIdBndr) @@ -68,6 +72,7 @@ import Language.Haskell.Syntax.Module.Name (moduleNameString) -- Basic things import Control.Arrow ((>>>)) +import Data.Bool (bool) import Data.List (zipWith4) import Data.ByteString (ByteString) import Data.ByteString.Short (ShortByteString) @@ -101,9 +106,9 @@ rules: literals are output without quotes, because they stick out by themselves. * Infix operators are output with parentheses around them. To ensure that this - is always the case, all textual representations of names are generated using - the 'pprName' operation, defined in this module, instead of the 'ppr' - operation. + is always the case, all textual representations of 'OccName' and 'Name' + values are generated using the 'pprNameProperly' operation, defined in this + module, instead of the 'pprNameProperly' operation. -} @@ -115,8 +120,6 @@ showByteCode logger env path = do MCDump noSrcSpan (withPprStyle defaultDumpStyle $ pprOnDiskModuleByteCode byteCode) --- The output generated by 'showByteCode' shall follow some general guidelines. --- See Note [Guidelines for the output of @--show-byte-code@] for details. -- | Constructs textual information about the contents of a bytecode file. pprOnDiskModuleByteCode :: OnDiskModuleByteCode -> SDoc @@ -139,48 +142,48 @@ pprOnDiskModuleByteCodeHash = entry (text "hash") . ppr pprCompiledByteCode :: Module -- ^ The enclosing module -> CompiledByteCode -- ^ The bytecode -> SDoc -- ^ The textual information -pprCompiledByteCode current_module CompiledByteCode {..} +pprCompiledByteCode enclosing_module CompiledByteCode {..} = vcat [ - pprByteCodeObjects current_module $ bc_bcos, - pprDataConstructorInfoTables $ bc_itbls, - pprTopLevelStrings $ bc_strs, - pprBreakpoints current_module $ bc_breaks, - pprStaticPointerTableEntries $ bc_spt_entries, - pprHPCInfo current_module $ bc_hpc_info + pprByteCodeObjects enclosing_module $ bc_bcos, + pprDataConstructorInfoTables $ bc_itbls, + pprTopLevelStrings $ bc_strs, + pprBreakpoints enclosing_module $ bc_breaks, + pprStaticPointerTableEntries $ bc_spt_entries, + pprHPCInfo enclosing_module $ bc_hpc_info ] -- | Constructs textual information about bytecode objects. pprByteCodeObjects :: Module -- ^ The enlosing module -> FlatBag UnlinkedBCO -- ^ The bytecode objects -> SDoc -- ^ The textual information -pprByteCodeObjects current_module = entry (text "objects") . - vcatOrNone . - map (pprByteCodeObject current_module) . - elemsFlatBag +pprByteCodeObjects enclosing_module = entry (text "objects") . + vcatOrNone . + map (pprByteCodeObject enclosing_module) . + elemsFlatBag -- | Constructs textual information about a single bytecode object. pprByteCodeObject :: Module -- ^ The enclosing module -> UnlinkedBCO -- ^ The bytecode object -> SDoc -- ^ The textual information -pprByteCodeObject current_module byte_code_object = case byte_code_object of +pprByteCodeObject enclosing_module byte_code_object = case byte_code_object of UnlinkedBCO {..} - -> entry (text "object" <+> quotes (pprName unlinkedBCOName)) $ + -> entry (text "object" <+> quotes (pprNameProperly unlinkedBCOName)) $ vcat [ - pprArity $ unlinkedBCOArity, - pprLiterals current_module $ unlinkedBCOLits, - pprUsedItems current_module $ unlinkedBCOPtrs + pprArity $ unlinkedBCOArity, + pprLiterals enclosing_module $ unlinkedBCOLits, + pprUsedItems enclosing_module $ unlinkedBCOPtrs ] UnlinkedStaticCon {..} -> entry ( text "static-construction object" <+> - quotes (pprName unlinkedStaticConName) + quotes (pprNameProperly unlinkedStaticConName) ) $ vcat [ - pprDataConstructor $ unlinkedStaticConDataConName, - pprLiftedness $ not unlinkedStaticConIsUnlifted, - pprLiterals current_module $ unlinkedStaticConLits, - pprUsedItems current_module $ unlinkedStaticConPtrs + pprDataConstructor $ unlinkedStaticConDataConName, + pprLiftedness $ not unlinkedStaticConIsUnlifted, + pprLiterals enclosing_module $ unlinkedStaticConLits, + pprUsedItems enclosing_module $ unlinkedStaticConPtrs ] -- | Constructs textual information about the arity of a bytecode object. @@ -190,7 +193,7 @@ pprArity = entry (text "arity") . ppr -- | Constructs textual information about the data constructor of a -- static-construction bytecode object. pprDataConstructor :: Name -> SDoc -pprDataConstructor = entry (text "data constructor") . pprName +pprDataConstructor = entry (text "data constructor") . pprNameProperly -- | Constructs textual information about the liftedness of a -- static-construction bytecode object. @@ -201,16 +204,16 @@ pprLiftedness = entry (text "lifted") . noOrYes pprLiterals :: Module -- ^ The enclosing module -> FlatBag BCONPtr -- ^ The literals -> SDoc -- ^ The textual information -pprLiterals current_module = entry (text "literals") . - vcatOrNone . - map (pprLiteral current_module) . - elemsFlatBag +pprLiterals enclosing_module = entry (text "literals") . + vcatOrNone . + map (pprLiteral enclosing_module) . + elemsFlatBag -- | Constructs textual information about a single literal. pprLiteral :: Module -- ^ The enclosing module -> BCONPtr -- ^ The literal -> SDoc -- ^ The textual information -pprLiteral current_module literal = case literal of +pprLiteral enclosing_module literal = case literal of BCONPtrWord word -> text "word" <+> ppr word @@ -219,10 +222,10 @@ pprLiteral current_module literal = case literal of quotes (ppr label) BCONPtrItbl infoTableName -> text "info table of" <+> - quotes (pprName infoTableName) + quotes (pprNameProperly infoTableName) BCONPtrAddr addrName -> text "address" <+> - quotes (pprName addrName) + quotes (pprNameProperly addrName) BCONPtrStr encoded_string -> text "top-level string" <+> text (show (utf8DecodeByteString encoded_string)) @@ -234,7 +237,7 @@ pprLiteral current_module literal = case literal of quotes (pprFFIInfo ffiInfo) BCONPtrCostCentre breakpointID -> text "cost center of breakpoint" <+> - pprInternalBreakpointID current_module breakpointID + pprInternalBreakpointID enclosing_module breakpointID -- | Constructs textual information about FFI info. pprFFIInfo :: FFIInfo -> SDoc @@ -254,11 +257,11 @@ pprInternalBreakpointID :: Module -- ^ The enclosing module -> InternalBreakpointId -- ^ The ID of the bytecode breakpoint -> SDoc -- ^ The textual information -pprInternalBreakpointID current_module InternalBreakpointId {..} - | ibi_info_mod == current_module = index_doc - | otherwise = index_doc <+> - text "in" <+> - quotes (ppr ibi_info_mod) +pprInternalBreakpointID enclosing_module InternalBreakpointId {..} + | ibi_info_mod == enclosing_module = index_doc + | otherwise = index_doc <+> + text "in" <+> + quotes (ppr ibi_info_mod) where index_doc :: SDoc @@ -268,22 +271,22 @@ pprInternalBreakpointID current_module InternalBreakpointId {..} pprUsedItems :: Module -- ^ The enclosing module -> FlatBag BCOPtr -- ^ The used items -> SDoc -- ^ The textual information -pprUsedItems current_module = entry (text "used items") . - vcatOrNone . - map (pprUsedItem current_module) . - elemsFlatBag +pprUsedItems enclosing_module = entry (text "used items") . + vcatOrNone . + map (pprUsedItem enclosing_module) . + elemsFlatBag -- | Constructs textual information about a single used item. pprUsedItem :: Module -- ^ The enclosing module -> BCOPtr -- ^ The used item -> SDoc -- ^ The textual information -pprUsedItem current_module usedItem = case usedItem of +pprUsedItem enclosing_module used_item = case used_item of BCOPtrName name - -> text "named item" <+> quotes (pprName name) + -> text "named item" <+> quotes (pprNameProperly name) BCOPtrPrimOp primOp -> text "primitive operation" <+> quotes (ppr primOp) BCOPtrBCO byte_code_object - -> pprByteCodeObject current_module byte_code_object + -> pprByteCodeObject enclosing_module byte_code_object BCOPtrBreakArray breakArrayModule -> text "break array of module" <+> quotes (ppr breakArrayModule) @@ -295,8 +298,8 @@ pprDataConstructorInfoTables = entry (text "data constructor info tables") . -- | Constructs textual information about a single data constructor info table. pprDataConstructorInfoTable :: Name -> ConInfoTable -> SDoc -pprDataConstructorInfoTable dataConstrName ConInfoTable {..} - = entry (text "info table of" <+> quotes (pprName dataConstrName)) $ +pprDataConstructorInfoTable data_constr_name ConInfoTable {..} + = entry (text "info table of" <+> quotes (pprNameProperly data_constr_name)) $ vcat [ pprPointerWordCount $ conItblPtrs, pprNonPointerWordCount $ conItblNPtrs @@ -318,37 +321,38 @@ pprTopLevelStrings = entry (text "top-level strings") . -- | Constructs textual information about a single top-level string. pprTopLevelString :: Name -> ByteString -> SDoc -pprTopLevelString string_name encoded_string = entry (pprName string_name) $ - text $ - show $ - utf8DecodeByteString $ - encoded_string +pprTopLevelString string_name encoded_string + = entry (pprNameProperly string_name) $ + text $ + show $ + utf8DecodeByteString $ + encoded_string -- | Constructs textual information about breakpoints. pprBreakpoints :: Module -- ^ The enclosing module -> Maybe InternalModBreaks -- ^ The breakpoints -> SDoc -- ^ The textual information -pprBreakpoints current_module +pprBreakpoints enclosing_module = entry (text "breakpoints") . - maybe (text "<none>") (pprActualBreakpoints current_module) + maybe (text "<none>") (pprActualBreakpoints enclosing_module) -- | Constructs textual information about actual breakpoints. pprActualBreakpoints :: Module -- ^ The enclosing module -> InternalModBreaks -- ^ The actual breakpoints -> SDoc -- ^ The textual information -pprActualBreakpoints current_module InternalModBreaks {..} +pprActualBreakpoints enclosing_module InternalModBreaks {..} = vcat [ - pprSourceBreakpoints current_module $ imodBreaks_modBreaks, - pprByteCodeBreakpoints current_module $ imodBreaks_breakInfo + pprSourceBreakpoints enclosing_module $ imodBreaks_modBreaks, + pprByteCodeBreakpoints enclosing_module $ imodBreaks_breakInfo ] -- | Constructs textual information about source breakpoints. pprSourceBreakpoints :: Module -- ^ The enclosing module -> ModBreaks -- ^ The source breakpoints -> SDoc -- ^ The textual information -pprSourceBreakpoints current_module ModBreaks {..} +pprSourceBreakpoints enclosing_module ModBreaks {..} = entry (text "source breakpoints") $ - assert (modBreaks_module == current_module) $ + assert (modBreaks_module == enclosing_module) $ assert (bounds modBreaks_locs_ == bounds modBreaks_decls) $ assert (bounds modBreaks_locs_ == bounds modBreaks_vars) $ vcatOrNone $ @@ -361,39 +365,43 @@ pprSourceBreakpoints current_module ModBreaks {..} -- the source spans in 'modBreaks_locs_' and are therefore never shown. -- | Constructs textual information about a single source breakpoint. -pprSourceBreakpoint :: BreakTickIndex - -> BinSrcSpan - -> [String] - -> [OccName] - -> SDoc -pprSourceBreakpoint ix srcSpan declarationPath freeVars +pprSourceBreakpoint + :: BreakTickIndex -- ^ The index of the source breakpoint + -> BinSrcSpan -- ^ The source span of the source breakpoint + -> [String] -- ^ The names declared by the surrounding declarations + -> [OccName] -- ^ The free variables of the source breakpoint + -> SDoc -- ^ The textual information +pprSourceBreakpoint ix src_span declaration_path free_vars = entry (text "source breakpoint" <+> ppr ix) $ vcat [ - pprSrcSpan $ srcSpan, - pprDeclarationPath $ declarationPath, - pprFreeVariables $ freeVars + pprSrcSpan $ src_span, + pprDeclarationPath $ declaration_path, + pprFreeVariables $ free_vars ] -- | Constructs textual information about a source span. pprSrcSpan :: BinSrcSpan -> SDoc pprSrcSpan = entry (text "source span") . ppr . unBinSrcSpan --- | Constructs textual information about a declaration path. +-- | Constructs textual information about a declaration path, which is the list +-- of names declared by the declarations surrounding a source breakpoint. pprDeclarationPath :: [String] -> SDoc pprDeclarationPath = entry (text "declaration path") . vcatOrEmpty . map text -- | Constructs textual information about free variables. pprFreeVariables :: [OccName] -> SDoc -pprFreeVariables = entry (text "free variables") . vcatOrNone . map ppr +pprFreeVariables = entry (text "free variables") . + vcatOrNone . + map pprNameProperly -- | Constructs textual information about bytecode breakpoints. pprByteCodeBreakpoints :: Module -- ^ The enclosing module -> IntMap CgBreakInfo -- ^ The bytecode breakpoints -> SDoc -- ^ The textual information -pprByteCodeBreakpoints current_module - = entry (text "bytecode breakpoints") . - vcatOrNone . - map (uncurry (pprByteCodeBreakpoint current_module)) . +pprByteCodeBreakpoints enclosing_module + = entry (text "bytecode breakpoints") . + vcatOrNone . + map (uncurry (pprByteCodeBreakpoint enclosing_module)) . IntMap.toList -- | Constructs textual information about a single bytecode breakpoint. @@ -401,13 +409,13 @@ pprByteCodeBreakpoint :: Module -- ^ The enclosing module -> Int -- ^ The index of the bytecode breakpoint -> CgBreakInfo -- ^ The bytecode breakpoint -> SDoc -- ^ The textual information -pprByteCodeBreakpoint current_module ix CgBreakInfo {..} +pprByteCodeBreakpoint enclosing_module ix CgBreakInfo {..} = entry (text "bytecode breakpoint" <+> ppr ix) $ vcat [ - pprType $ cgb_resty, - pprTypeVariables $ cgb_tyvars, - pprVariables $ cgb_vars, - pprCorrespondingSourceBreakpoint current_module $ cgb_tick_id + pprType $ cgb_resty, + pprTypeVariables $ cgb_tyvars, + pprVariables $ cgb_vars, + pprCorrespondingSourceBreakpoint enclosing_module $ cgb_tick_id ] -- That the 'cgb_resty' field holds the type of the breakpoint is apparent -- from the fact that this field is set by @@ -453,20 +461,20 @@ pprCorrespondingSourceBreakpoint :: Module -- ^ A reference to the source breakpoint -> SDoc -- ^ The textual information -pprCorrespondingSourceBreakpoint current_module +pprCorrespondingSourceBreakpoint enclosing_module = entry (text "corresponding source breakpoint") . - pprBreakpointID current_module . + pprBreakpointID enclosing_module . either internalBreakLoc id -- | Constructs textual information about the ID of a source breakpoint. pprBreakpointID :: Module -- ^ The enclosing module -> BreakpointId -- ^ The ID of the source breakpoint -> SDoc -- ^ The textual information -pprBreakpointID current_module BreakpointId {..} - | bi_tick_mod == current_module = index_doc - | otherwise = index_doc <+> - text "in" <+> - quotes (ppr bi_tick_mod) +pprBreakpointID enclosing_module BreakpointId {..} + | bi_tick_mod == enclosing_module = index_doc + | otherwise = index_doc <+> + text "in" <+> + quotes (ppr bi_tick_mod) where index_doc :: SDoc @@ -481,25 +489,25 @@ pprStaticPointerTableEntries = entry (text "static-pointer table entries") . -- | Constructs textual information about a single static-pointer table entry. pprStaticPointerTableEntry :: SptEntry -> SDoc pprStaticPointerTableEntry (SptEntry name fingerprint) - = ppr fingerprint <> text ":" <+> pprName name + = entry (ppr fingerprint) (pprNameProperly name) -- | Constructs textual information about HPC info. pprHPCInfo :: Module -- ^ The enclosing module -> Strict.Maybe ByteCodeHpcInfo -- ^ The HPC info -> SDoc -- ^ The textual information -pprHPCInfo current_module +pprHPCInfo enclosing_module = entry (text "HPC information") . - Strict.maybe (text "<none>") (pprActualHPCInfo current_module) + Strict.maybe (text "<none>") (pprActualHPCInfo enclosing_module) -- | Constructs textual information about actual HPC info. pprActualHPCInfo :: Module -- ^ The enclosing module -> ByteCodeHpcInfo -- ^ The actual HPC info -> SDoc -- ^ The textual information -pprActualHPCInfo current_module ByteCodeHpcInfo {..} +pprActualHPCInfo enclosing_module ByteCodeHpcInfo {..} = assert ( utf8DecodeShortByteString bchi_module_name == - moduleNameString (moduleName current_module) + moduleNameString (moduleName enclosing_module) ) $ vcat [ @@ -516,14 +524,15 @@ pprHPCInfoHash = entry (text "hash") . pprFixedSizeNatural . intToWord pprTickBox :: ShortByteString -> SDoc pprTickBox = entry (text "tick box") . text . utf8DecodeShortByteString --- | Constructs textual information about a number of tick counts. +-- | Constructs textual information about a number of ticks. pprTickCount :: Int -> SDoc pprTickCount = entry (text "number of ticks") . ppr --- | Constructs the Haskell representation of a name. -pprName :: Name -> SDoc -pprName name | isSymOcc (nameOccName name) = text "(" <> ppr name <> text ")" - | otherwise = ppr name +-- | Constructs the Haskell representation of a name. This includes putting +-- parentheses around operators. The given name is supposed to be of type +-- 'OccName' or 'Name'. +pprNameProperly :: (HasOccName a, Outputable a) => a -> SDoc +pprNameProperly name = parenSymOcc (occName name) (ppr name) -- | Constructs a hexadecimal representation of a natural number such that the -- number of hexadecimal digits fits the number of bits used to represent the @@ -547,22 +556,22 @@ intToWord (I# int#) = W# (int2Word# int#) -- | Constructs a textual representation of a boolean, interpreting 'True' and -- 'False' as “yes” and “no”, respectively. noOrYes :: Bool -> SDoc -noOrYes bool = text (if bool then "yes" else "no") +noOrYes = text . bool "no" "yes" -- | Constructs an entry in a list of textual data representations. entry :: SDoc -- ^ The title of the entry -> SDoc -- ^ The contents of the entry -> SDoc -- ^ The entry -entry title content = hang (title <> text ":") 2 content +entry title contents = hang (title <> text ":") 2 contents -- | Composes documents vertically in general, but presents an empty document --- list as `<none`>. +-- list as @<none>@. vcatOrNone :: [SDoc] -> SDoc vcatOrNone [] = text "<none>" vcatOrNone docs = vcat docs -- | Composes documents vertically in general, but presents an empty document --- list as `<empty`>. +-- list as @<empty>@. vcatOrEmpty :: [SDoc] -> SDoc vcatOrEmpty [] = text "<empty>" vcatOrEmpty docs = vcat docs ===================================== testsuite/tests/show-bytecode/Example.hs ===================================== @@ -12,9 +12,9 @@ module Example where import Numeric.Natural (Natural) -import GHC.StaticPtr (StaticPtr) -import Foreign.C.Types (CChar, CSize (CSize)) import Foreign.Ptr (Ptr) +import Foreign.C.Types (CChar, CSize (CSize)) +import GHC.StaticPtr (StaticPtr) fibonaccis :: [Natural] fibonaccis = 0 : positiveFibonaccis where ===================================== testsuite/tests/show-bytecode/normalize ===================================== @@ -6,9 +6,9 @@ stabilize () { sed -E -e ' s/_r[[:alnum:]]+/_@name_suffix@/g - s/^( *hash: )[[:xdigit:]]+/\1@hash@/g - s/^( *)[[:xdigit:]]+:/\1@hash@:/g - s/word [[:digit:]]{2}[[:digit:]]*/word @large_word@/ + s/^( *hash: )[[:xdigit:]]+/\1@hash@/ + s/^( *)[[:xdigit:]]+:/\1@hash@:/ + s/word [[:digit:]]{2}[[:digit:]]*/word @large_word@/g ' } ===================================== testsuite/tests/show-bytecode/show-bytecode-breakpoints.stdout-ghcjs → testsuite/tests/show-bytecode/show-bytecode-breakpoints.stdout-wasi ===================================== ===================================== testsuite/tests/show-bytecode/show-bytecode-hpc.stdout-ghcjs → testsuite/tests/show-bytecode/show-bytecode-hpc.stdout-wasi ===================================== ===================================== testsuite/tests/show-bytecode/show-bytecode-vanilla.stdout-ghcjs → testsuite/tests/show-bytecode/show-bytecode-vanilla.stdout-wasi ===================================== View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2471d88d1fe2faa4cc1aac0597d1fd1... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2471d88d1fe2faa4cc1aac0597d1fd1... 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