Wolfgang Jeltsch pushed to branch wip/jeltsch/textual-bytecode-output at Glasgow Haskell Compiler / GHC

Commits:

5 changed files:

Changes:

  • compiler/GHC/ByteCode/Serialize.hs
    ... ... @@ -6,7 +6,7 @@
    6 6 
     {- | This module implements the serialization of bytecode objects to and from disk.
    7 7 
     -}
    8 8 
     module GHC.ByteCode.Serialize
    9 
    -  ( writeBinByteCode, readBinByteCode
    9 
    +  ( writeBinByteCode, readBinByteCode, readOnDiskModuleByteCode
    10 10 
       , ModuleByteCode(..)
    11 11 
       , BytecodeLibX(..)
    12 12 
       , BytecodeLib

  • compiler/GHC/ByteCode/Show.hs
    1 
    +{-# LANGUAGE RecordWildCards #-}
    2 
    +{-# LANGUAGE ScopedTypeVariables #-}
    3 
    +
    4 
    +-- | […]
    5 
    +module GHC.ByteCode.Show (showByteCode) where
    6 
    +
    7 
    +import Data.Ord ((<))
    8 
    +import Data.Function (($), (&), (.))
    9 
    +import Data.Bool (otherwise)
    10 
    +import Data.Int (Int)
    11 
    +import Data.Word (Word8)
    12 
    +import Data.Maybe (maybe)
    13 
    +import Data.List (map, zipWith)
    14 
    +import Data.String (String)
    15 
    +import Data.ByteString (ByteString, null, length, unpack)
    16 
    +import Numeric (showHex)
    17 
    +import System.IO (IO, FilePath)
    18 
    +import GHC.Types.SrcLoc (noSrcSpan)
    19 
    +import GHC.Types.Error (MessageClass (MCDump))
    20 
    +import GHC.Utils.Logger (Logger, logMsg)
    21 
    +import GHC.Utils.Outputable
    22 
    +       (
    23 
    +           defaultDumpStyle,
    24 
    +           SDoc,
    25 
    +           text,
    26 
    +           (<+>),
    27 
    +           hsep,
    28 
    +           nest,
    29 
    +           vcat,
    30 
    +           withPprStyle,
    31 
    +           ppr
    32 
    +       )
    33 
    +import GHC.ByteCode.Types (CompiledByteCode (..))
    34 
    +import GHC.ByteCode.Binary (OnDiskModuleByteCode (..))
    35 
    +import GHC.ByteCode.Serialize (readOnDiskModuleByteCode)
    36 
    +import GHC.Driver.Env.Types (HscEnv)
    37 
    +
    38 
    +-- | […]
    39 
    +showByteCode :: Logger -> HscEnv -> FilePath -> IO ()
    40 
    +showByteCode logger env path = do
    41 
    +    byteCode <- readOnDiskModuleByteCode env path
    42 
    +    logMsg logger
    43 
    +           MCDump
    44 
    +           noSrcSpan
    45 
    +           (withPprStyle defaultDumpStyle $ pprOnDiskModuleByteCode byteCode)
    46 
    +
    47 
    +-- | […]
    48 
    +pprOnDiskModuleByteCode :: OnDiskModuleByteCode -> SDoc
    49 
    +pprOnDiskModuleByteCode OnDiskModuleByteCode {..}
    50 
    +    = vcat $
    51 
    +      [
    52 
    +          text "module" <+> ppr odgbc_module,
    53 
    +          nest 2 $ vcat
    54 
    +                   [
    55 
    +                       text "hash:"
    56 
    +                           <+> ppr odgbc_hash,
    57 
    +                       text "compiled bytecode:"
    58 
    +                           <+> pprCompiledByteCode odgbc_compiled_byte_code,
    59 
    +                       text "contents of object files:"
    60 
    +                           <+> pprObjectFileContents odgbc_foreign
    61 
    +                   ]
    62 
    +      ]
    63 
    +
    64 
    +-- | […]
    65 
    +pprCompiledByteCode :: CompiledByteCode -> SDoc
    66 
    +pprCompiledByteCode CompiledByteCode {..}
    67 
    +    = vcat
    68 
    +      [
    69 
    +          text "bytecode objects"
    70 
    +              <+> pprByteCodeObjects bc_bcos,
    71 
    +          text "data constructor info tables:"
    72 
    +              <+> pprDataConstructorInfoTables bc_itbls,
    73 
    +          text "top-level strings:"
    74 
    +              <+> pprTopLevelStrings bc_strs,
    75 
    +          text "break points:"
    76 
    +              <+> maybe (text "<none>") pprInternalBreakPoints bc_breaks,
    77 
    +          text "static-pointer table entries:"
    78 
    +              <+> pprStaticPointerTableEntries bc_spt_entries,
    79 
    +          text "HPC information:"
    80 
    +              <+> pprHPCInfo bc_hpc_info
    81 
    +      ]
    82 
    +
    83 
    +-- | […]
    84 
    +pprByteCodeObjects :: a -> SDoc
    85 
    +pprByteCodeObjects = pprByteCodeObjects
    86 
    +
    87 
    +-- | […]
    88 
    +pprDataConstructorInfoTables :: a -> SDoc
    89 
    +pprDataConstructorInfoTables = pprDataConstructorInfoTables
    90 
    +
    91 
    +-- | […]
    92 
    +pprTopLevelStrings :: a -> SDoc
    93 
    +pprTopLevelStrings = pprTopLevelStrings
    94 
    +
    95 
    +-- | […]
    96 
    +pprInternalBreakPoints :: a -> SDoc
    97 
    +pprInternalBreakPoints = pprInternalBreakPoints
    98 
    +
    99 
    +-- | […]
    100 
    +pprStaticPointerTableEntries :: a -> SDoc
    101 
    +pprStaticPointerTableEntries = pprStaticPointerTableEntries
    102 
    +
    103 
    +-- | […]
    104 
    +pprHPCInfo :: a -> SDoc
    105 
    +pprHPCInfo = pprHPCInfo
    106 
    +
    107 
    +-- | […]
    108 
    +pprObjectFileContents :: [ByteString] -> SDoc
    109 
    +pprObjectFileContents = vcatOrNone . zipWith pprEntry [0 ..] where
    110 
    +
    111 
    +    pprEntry :: Int -> ByteString -> SDoc
    112 
    +    pprEntry ix content
    113 
    +        = vcat [
    114 
    +                   hsep [
    115 
    +                            text "file",
    116 
    +                            ppr ix,
    117 
    +                            text "of length",
    118 
    +                            ppr (length content)
    119 
    +                        ],
    120 
    +                   nest 2 $ pprByteString content
    121 
    +               ]
    122 
    +
    123 
    +-- | […]
    124 
    +pprByteString :: ByteString -> SDoc
    125 
    +pprByteString byteString
    126 
    +    | null byteString = text "<empty>"
    127 
    +    | otherwise       = byteString & unpack & map pprByte & hsep
    128 
    +
    129 
    +-- | […]
    130 
    +pprByte :: Word8 -> SDoc
    131 
    +pprByte byte = text $ if byte < 16 then '0' : unpadded else unpadded where
    132 
    +
    133 
    +    unpadded :: String
    134 
    +    unpadded = showHex byte ""
    135 
    +
    136 
    +-- | […]
    137 
    +vcatOrNone :: [SDoc] -> SDoc
    138 
    +vcatOrNone []   = text "<none>"
    139 
    +vcatOrNone docs = vcat docs

  • compiler/ghc.cabal.in
    ... ... @@ -217,6 +217,7 @@ Library
    217 217 
             GHC.ByteCode.Linker
    218 218 
             GHC.ByteCode.Recomp.Binary
    219 219 
             GHC.ByteCode.Serialize
    220 
    +        GHC.ByteCode.Show
    220 221 
             GHC.ByteCode.Types
    221 222 
             GHC.Cmm
    222 223 
             GHC.Cmm.BlockId

  • ghc/GHC/Driver/Session/Mode.hs
    ... ... @@ -77,6 +77,7 @@ isShowGhciUsageMode _ = False
    77 77
    78 78 
     data PostLoadMode
    79 79 
       = ShowInterface FilePath  -- ghc --show-iface
    80 
    +  | ShowByteCode FilePath   -- ghc --show-byte-code
    80 81 
       | DoMkDependHS            -- ghc -M
    81 82 
       | StopBefore StopPhase    -- ghc -E | -C | -S
    82 83 
                                 -- StopBefore StopLn is the default
    ... ... @@ -101,6 +102,9 @@ showUnitsMode = mkPostLoadMode ShowPackages
    101 102 
     showInterfaceMode :: FilePath -> Mode
    102 103 
     showInterfaceMode fp = mkPostLoadMode (ShowInterface fp)
    103 104
    105 
    +showByteCodeMode :: FilePath -> Mode
    106 
    +showByteCodeMode fp = mkPostLoadMode (ShowByteCode fp)
    107 
    +
    104 108 
     stopBeforeMode :: StopPhase -> Mode
    105 109 
     stopBeforeMode phase = mkPostLoadMode (StopBefore phase)
    106 110
    ... ... @@ -231,9 +235,11 @@ mode_flags =
    231 235 
             replaceSpace ' ' = '-'
    232 236 
             replaceSpace c   = c
    233 237 
       ] ++
    234 
    -      ------- interfaces ----------------------------------------------------
    235 
    -  [ defFlag "-show-iface"  (HasArg (\f -> setMode (showInterfaceMode f)
    238 
    +      ------- textual output of generated data -----------------------------
    239 
    +  [ defFlag "-show-iface"     (HasArg (\f -> setMode (showInterfaceMode f)
    236 240 
                                                    "--show-iface"))
    241 
    +  , defFlag "-show-byte-code" (HasArg (\f -> setMode (showByteCodeMode  f)
    242 
    +                                               "--show-byte-code"))
    237 243
    238 244 
           ------- primary modes ------------------------------------------------
    239 245 
       , defFlag "c"            (PassFlag (\f -> do setMode (stopBeforeMode NoStop) f

  • ghc/Main.hs
    ... ... @@ -73,6 +73,8 @@ import GHC.SysTools.BaseDir
    73 73 
     import GHC.Iface.Load
    74 74 
     import GHC.Iface.Recomp.Binary ( fingerprintBinMem )
    75 75
    76 
    +import GHC.ByteCode.Show ( showByteCode )
    77 
    +
    76 78 
     import GHC.Tc.Utils.Monad      ( initIfaceCheck )
    77 79 
     import GHC.Iface.Errors.Ppr
    78 80
    ... ... @@ -266,6 +268,7 @@ main' postLoadMode units dflags0 args flagWarnings = do
    266 268 
                                                         (hsc_units  hsc_env)
    267 269 
                                                         (hsc_NC     hsc_env)
    268 270 
                                                         f
    271 
    +       ShowByteCode f         -> liftIO $ showByteCode logger hsc_env f
    269 272 
            DoMake                 -> doMake units srcs
    270 273 
            DoMkDependHS           -> doMkDependHS (map fst srcs)
    271 274 
            StopBefore p           -> liftIO (oneShot hsc_env p srcs)

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help