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

Commits:

1 changed file:

Changes:

  • compiler/GHC/ByteCode/Show.hs
    ... ... @@ -11,7 +11,7 @@ import Control.Exception (assert)
    11 11
     import Data.Eq ((==))
    
    12 12
     import Data.Bits (FiniteBits, finiteBitSize)
    
    13 13
     import Data.Function (($), (.))
    
    14
    -import Data.Bool (otherwise)
    
    14
    +import Data.Bool (Bool, otherwise)
    
    15 15
     import Data.Int (Int)
    
    16 16
     import Data.Word (Word, Word16)
    
    17 17
     import Data.Maybe (Maybe, maybe)
    
    ... ... @@ -117,21 +117,13 @@ pprByteCodeObject currentModule byteCodeObject = case byteCodeObject of
    117 117
                         pprLiterals currentModule $ unlinkedBCOLits,
    
    118 118
                         pprPointers currentModule $ unlinkedBCOPtrs
    
    119 119
                     ]
    
    120
    -    UnlinkedStaticCon {{-..-}}
    
    121
    -        -> entry (text "static constructor object:") $ --FIXME: Remove colon and add name.
    
    120
    +    UnlinkedStaticCon {..}
    
    121
    +        -> entry (text "static constructor object" <+> ppr unlinkedStaticConName) $
    
    122 122
                vcat [
    
    123
    -                    {-
    
    124
    -                        unlinkedStaticConName :: !Name,
    
    125
    -                        -- ^ The name to which this static constructor is bound, not to be
    
    126
    -                        -- confused with the name of the static constructor itself
    
    127
    -                        -- ('unlinkedStaticConDataConName')
    
    128
    -                        unlinkedStaticConDataConName :: !Name,
    
    129
    -                        unlinkedStaticConLits :: !(FlatBag BCONPtr),
    
    130
    -                        -- ^ non-ptrs full words, where sub-word literals have already been
    
    131
    -                        -- packed into full words as needed
    
    132
    -                        unlinkedStaticConPtrs :: !(FlatBag BCOPtr),  -- ptrs
    
    133
    -                        unlinkedStaticConIsUnlifted :: !Bool
    
    134
    -                    -}
    
    123
    +                    pprDataConstructorName    $ unlinkedStaticConDataConName,
    
    124
    +                    pprNoOrYes                $ unlinkedStaticConIsUnlifted,
    
    125
    +                    pprLiterals currentModule $ unlinkedStaticConLits,
    
    126
    +                    pprPointers currentModule $ unlinkedStaticConPtrs
    
    135 127
                     ]
    
    136 128
     
    
    137 129
     -- | […]
    
    ... ... @@ -146,6 +138,10 @@ pprInstructions = entry (text "instructions:") . pprBCOByteArray
    146 138
     pprBitmap :: BCOByteArray Word -> SDoc
    
    147 139
     pprBitmap = entry (text "bitmap:") . pprBCOByteArray
    
    148 140
     
    
    141
    +-- | […]
    
    142
    +pprDataConstructorName :: Name -> SDoc
    
    143
    +pprDataConstructorName = entry (text "data constructor name:") . ppr
    
    144
    +
    
    149 145
     -- | […]
    
    150 146
     pprLiterals :: Module -> FlatBag BCONPtr -> SDoc
    
    151 147
     pprLiterals currentModule = entry (text "literals:")       .
    
    ... ... @@ -290,6 +286,10 @@ pprFixedSizeNatural num
    290 286
         unpadded :: String
    
    291 287
         unpadded = showHex num ""
    
    292 288
     
    
    289
    +-- | […]
    
    290
    +pprNoOrYes :: Bool -> SDoc
    
    291
    +pprNoOrYes bool = text (if bool then "yes" else "no")
    
    292
    +
    
    293 293
     -- | […]
    
    294 294
     entry :: SDoc -> SDoc -> SDoc
    
    295 295
     entry title content = hang title 2 content