compiler/cmm/SMRep.hs

   1 -- (c) The University of Glasgow 2006
   2 -- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 --
   4 -- Storage manager representation of closures
   5
   6 {-# LANGUAGE CPP,GeneralizedNewtypeDeriving #-}
   7
   8 module SMRep (
   9         -- * Words and bytes
  10         WordOff, ByteOff,
  11         wordsToBytes, bytesToWordsRoundUp,
  12         roundUpToWords, roundUpTo,
  13
  14         StgWord, fromStgWord, toStgWord,
  15         StgHalfWord, fromStgHalfWord, toStgHalfWord,
  16         hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
  17
  18         -- * Closure repesentation
  19         SMRep(..), -- CmmInfo sees the rep; no one else does
  20         IsStatic,
  21         ClosureTypeInfo(..), ArgDescr(..), Liveness,
  22         ConstrDescription,
  23
  24         -- ** Construction
  25         mkHeapRep, blackHoleRep, indStaticRep, mkStackRep, mkRTSRep, arrPtrsRep,
  26         smallArrPtrsRep, arrWordsRep,
  27
  28         -- ** Predicates
  29         isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon,
  30         isStackRep,
  31
  32         -- ** Size-related things
  33         heapClosureSizeW,
  34         fixedHdrSizeW, arrWordsHdrSize, arrWordsHdrSizeW, arrPtrsHdrSize,
  35         arrPtrsHdrSizeW, profHdrSize, thunkHdrSize, nonHdrSize, nonHdrSizeW,
  36         smallArrPtrsHdrSize, smallArrPtrsHdrSizeW, hdrSize, hdrSizeW,
  37         fixedHdrSize,
  38
  39         -- ** RTS closure types
  40         rtsClosureType, rET_SMALL, rET_BIG,
  41         aRG_GEN, aRG_GEN_BIG,
  42
  43         -- ** Arrays
  44         card, cardRoundUp, cardTableSizeB, cardTableSizeW,
  45
  46         -- * Operations over [Word8] strings that don't belong here
  47         pprWord8String, stringToWord8s
  48     ) where
  49
  50 #include "../HsVersions.h"
  51 #include "../includes/MachDeps.h"
  52
  53 import GhcPrelude
  54
  55 import BasicTypes( ConTagZ )
  56 import DynFlags
  57 import Outputable
  58 import Platform
  59 import FastString
  60
  61 import Data.Char( ord )
  62 import Data.Word
  63 import Data.Bits
  64
  65 {-
  66 ************************************************************************
  67 *                                                                      *
  68                 Words and bytes
  69 *                                                                      *
  70 ************************************************************************
  71 -}
  72
  73 -- | Word offset, or word count
  74 type WordOff = Int
  75
  76 -- | Byte offset, or byte count
  77 type ByteOff = Int
  78
  79 -- | Round up the given byte count to the next byte count that's a
  80 -- multiple of the machine's word size.
  81 roundUpToWords :: DynFlags -> ByteOff -> ByteOff
  82 roundUpToWords dflags n = roundUpTo n (wORD_SIZE dflags)
  83
  84 -- | Round up @base@ to a multiple of @size@.
  85 roundUpTo :: ByteOff -> ByteOff -> ByteOff
  86 roundUpTo base size = (base + (size - 1)) .&. (complement (size - 1))
  87
  88 -- | Convert the given number of words to a number of bytes.
  89 --
  90 -- This function morally has type @WordOff -> ByteOff@, but uses @Num
  91 -- a@ to allow for overloading.
  92 wordsToBytes :: Num a => DynFlags -> a -> a
  93 wordsToBytes dflags n = fromIntegral (wORD_SIZE dflags) * n
  94 {-# SPECIALIZE wordsToBytes :: DynFlags -> Int -> Int #-}
  95 {-# SPECIALIZE wordsToBytes :: DynFlags -> Word -> Word #-}
  96 {-# SPECIALIZE wordsToBytes :: DynFlags -> Integer -> Integer #-}
  97
  98 -- | First round the given byte count up to a multiple of the
  99 -- machine's word size and then convert the result to words.
 100 bytesToWordsRoundUp :: DynFlags -> ByteOff -> WordOff
 101 bytesToWordsRoundUp dflags n = (n + word_size - 1) `quot` word_size
 102  where word_size = wORD_SIZE dflags
 103 -- StgWord is a type representing an StgWord on the target platform.
 104 -- A Word64 is large enough to hold a Word for either a 32bit or 64bit platform
 105 newtype StgWord = StgWord Word64
 106     deriving (Eq, Bits)
 107
 108 fromStgWord :: StgWord -> Integer
 109 fromStgWord (StgWord i) = toInteger i
 110
 111 toStgWord :: DynFlags -> Integer -> StgWord
 112 toStgWord dflags i
 113     = case platformWordSize (targetPlatform dflags) of
 114       -- These conversions mean that things like toStgWord (-1)
 115       -- do the right thing
 116       4 -> StgWord (fromIntegral (fromInteger i :: Word32))
 117       8 -> StgWord (fromInteger i :: Word64)
 118       w -> panic ("toStgWord: Unknown platformWordSize: " ++ show w)
 119
 120 instance Outputable StgWord where
 121     ppr (StgWord i) = integer (toInteger i)
 122
 123 --
 124
 125 -- A Word32 is large enough to hold half a Word for either a 32bit or
 126 -- 64bit platform
 127 newtype StgHalfWord = StgHalfWord Word32
 128     deriving Eq
 129
 130 fromStgHalfWord :: StgHalfWord -> Integer
 131 fromStgHalfWord (StgHalfWord w) = toInteger w
 132
 133 toStgHalfWord :: DynFlags -> Integer -> StgHalfWord
 134 toStgHalfWord dflags i
 135     = case platformWordSize (targetPlatform dflags) of
 136       -- These conversions mean that things like toStgHalfWord (-1)
 137       -- do the right thing
 138       4 -> StgHalfWord (fromIntegral (fromInteger i :: Word16))
 139       8 -> StgHalfWord (fromInteger i :: Word32)
 140       w -> panic ("toStgHalfWord: Unknown platformWordSize: " ++ show w)
 141
 142 instance Outputable StgHalfWord where
 143     ppr (StgHalfWord w) = integer (toInteger w)
 144
 145 hALF_WORD_SIZE :: DynFlags -> ByteOff
 146 hALF_WORD_SIZE dflags = platformWordSize (targetPlatform dflags) `shiftR` 1
 147 hALF_WORD_SIZE_IN_BITS :: DynFlags -> Int
 148 hALF_WORD_SIZE_IN_BITS dflags = platformWordSize (targetPlatform dflags) `shiftL` 2
 149
 150 {-
 151 ************************************************************************
 152 *                                                                      *
 153 \subsubsection[SMRep-datatype]{@SMRep@---storage manager representation}
 154 *                                                                      *
 155 ************************************************************************
 156 -}
 157
 158 -- | A description of the layout of a closure.  Corresponds directly
 159 -- to the closure types in includes/rts/storage/ClosureTypes.h.
 160 data SMRep
 161   = HeapRep              -- GC routines consult sizes in info tbl
 162         IsStatic
 163         !WordOff         --  # ptr words
 164         !WordOff         --  # non-ptr words INCLUDING SLOP (see mkHeapRep below)
 165         ClosureTypeInfo  -- type-specific info
 166
 167   | ArrayPtrsRep
 168         !WordOff        -- # ptr words
 169         !WordOff        -- # card table words
 170
 171   | SmallArrayPtrsRep
 172         !WordOff        -- # ptr words
 173
 174   | ArrayWordsRep
 175         !WordOff        -- # bytes expressed in words, rounded up
 176
 177   | StackRep            -- Stack frame (RET_SMALL or RET_BIG)
 178         Liveness
 179
 180   | RTSRep              -- The RTS needs to declare info tables with specific
 181         Int             -- type tags, so this form lets us override the default
 182         SMRep           -- tag for an SMRep.
 183
 184 -- | True <=> This is a static closure.  Affects how we garbage-collect it.
 185 -- Static closure have an extra static link field at the end.
 186 -- Constructors do not have a static variant; see Note [static constructors]
 187 type IsStatic = Bool
 188
 189 -- From an SMRep you can get to the closure type defined in
 190 -- includes/rts/storage/ClosureTypes.h. Described by the function
 191 -- rtsClosureType below.
 192
 193 data ClosureTypeInfo
 194   = Constr        ConTagZ ConstrDescription
 195   | Fun           FunArity ArgDescr
 196   | Thunk
 197   | ThunkSelector SelectorOffset
 198   | BlackHole
 199   | IndStatic
 200
 201 type ConstrDescription = [Word8] -- result of dataConIdentity
 202 type FunArity          = Int
 203 type SelectorOffset    = Int
 204
 205 -------------------------
 206 -- We represent liveness bitmaps as a Bitmap (whose internal
 207 -- representation really is a bitmap).  These are pinned onto case return
 208 -- vectors to indicate the state of the stack for the garbage collector.
 209 --
 210 -- In the compiled program, liveness bitmaps that fit inside a single
 211 -- word (StgWord) are stored as a single word, while larger bitmaps are
 212 -- stored as a pointer to an array of words.
 213
 214 type Liveness = [Bool]   -- One Bool per word; True  <=> non-ptr or dead
 215                          --                    False <=> ptr
 216
 217 -------------------------
 218 -- An ArgDescr describes the argument pattern of a function
 219
 220 data ArgDescr
 221   = ArgSpec             -- Fits one of the standard patterns
 222         !Int            -- RTS type identifier ARG_P, ARG_N, ...
 223
 224   | ArgGen              -- General case
 225         Liveness        -- Details about the arguments
 226
 227
 228 -----------------------------------------------------------------------------
 229 -- Construction
 230
 231 mkHeapRep :: DynFlags -> IsStatic -> WordOff -> WordOff -> ClosureTypeInfo
 232           -> SMRep
 233 mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type_info
 234   = HeapRep is_static
 235             ptr_wds
 236             (nonptr_wds + slop_wds)
 237             cl_type_info
 238   where
 239      slop_wds
 240       | is_static = 0
 241       | otherwise = max 0 (minClosureSize dflags - (hdr_size + payload_size))
 242
 243      hdr_size     = closureTypeHdrSize dflags cl_type_info
 244      payload_size = ptr_wds + nonptr_wds
 245
 246 mkRTSRep :: Int -> SMRep -> SMRep
 247 mkRTSRep = RTSRep
 248
 249 mkStackRep :: [Bool] -> SMRep
 250 mkStackRep liveness = StackRep liveness
 251
 252 blackHoleRep :: SMRep
 253 blackHoleRep = HeapRep False 0 0 BlackHole
 254
 255 indStaticRep :: SMRep
 256 indStaticRep = HeapRep True 1 0 IndStatic
 257
 258 arrPtrsRep :: DynFlags -> WordOff -> SMRep
 259 arrPtrsRep dflags elems = ArrayPtrsRep elems (cardTableSizeW dflags elems)
 260
 261 smallArrPtrsRep :: WordOff -> SMRep
 262 smallArrPtrsRep elems = SmallArrayPtrsRep elems
 263
 264 arrWordsRep :: DynFlags -> ByteOff -> SMRep
 265 arrWordsRep dflags bytes = ArrayWordsRep (bytesToWordsRoundUp dflags bytes)
 266
 267 -----------------------------------------------------------------------------
 268 -- Predicates
 269
 270 isStaticRep :: SMRep -> IsStatic
 271 isStaticRep (HeapRep is_static _ _ _) = is_static
 272 isStaticRep (RTSRep _ rep)            = isStaticRep rep
 273 isStaticRep _                         = False
 274
 275 isStackRep :: SMRep -> Bool
 276 isStackRep StackRep{}     = True
 277 isStackRep (RTSRep _ rep) = isStackRep rep
 278 isStackRep _              = False
 279
 280 isConRep :: SMRep -> Bool
 281 isConRep (HeapRep _ _ _ Constr{}) = True
 282 isConRep _                        = False
 283
 284 isThunkRep :: SMRep -> Bool
 285 isThunkRep (HeapRep _ _ _ Thunk{})         = True
 286 isThunkRep (HeapRep _ _ _ ThunkSelector{}) = True
 287 isThunkRep (HeapRep _ _ _ BlackHole{})     = True
 288 isThunkRep (HeapRep _ _ _ IndStatic{})     = True
 289 isThunkRep _                               = False
 290
 291 isFunRep :: SMRep -> Bool
 292 isFunRep (HeapRep _ _ _ Fun{}) = True
 293 isFunRep _                     = False
 294
 295 isStaticNoCafCon :: SMRep -> Bool
 296 -- This should line up exactly with CONSTR_NOCAF below
 297 -- See Note [Static NoCaf constructors]
 298 isStaticNoCafCon (HeapRep _ 0 _ Constr{}) = True
 299 isStaticNoCafCon _                        = False
 300
 301
 302 -----------------------------------------------------------------------------
 303 -- Size-related things
 304
 305 fixedHdrSize :: DynFlags -> ByteOff
 306 fixedHdrSize dflags = wordsToBytes dflags (fixedHdrSizeW dflags)
 307
 308 -- | Size of a closure header (StgHeader in includes/rts/storage/Closures.h)
 309 fixedHdrSizeW :: DynFlags -> WordOff
 310 fixedHdrSizeW dflags = sTD_HDR_SIZE dflags + profHdrSize dflags
 311
 312 -- | Size of the profiling part of a closure header
 313 -- (StgProfHeader in includes/rts/storage/Closures.h)
 314 profHdrSize  :: DynFlags -> WordOff
 315 profHdrSize dflags
 316  | gopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags
 317  | otherwise                      = 0
 318
 319 -- | The garbage collector requires that every closure is at least as
 320 --   big as this.
 321 minClosureSize :: DynFlags -> WordOff
 322 minClosureSize dflags = fixedHdrSizeW dflags + mIN_PAYLOAD_SIZE dflags
 323
 324 arrWordsHdrSize :: DynFlags -> ByteOff
 325 arrWordsHdrSize dflags
 326  = fixedHdrSize dflags + sIZEOF_StgArrBytes_NoHdr dflags
 327
 328 arrWordsHdrSizeW :: DynFlags -> WordOff
 329 arrWordsHdrSizeW dflags =
 330     fixedHdrSizeW dflags +
 331     (sIZEOF_StgArrBytes_NoHdr dflags `quot` wORD_SIZE dflags)
 332
 333 arrPtrsHdrSize :: DynFlags -> ByteOff
 334 arrPtrsHdrSize dflags
 335  = fixedHdrSize dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags
 336
 337 arrPtrsHdrSizeW :: DynFlags -> WordOff
 338 arrPtrsHdrSizeW dflags =
 339     fixedHdrSizeW dflags +
 340     (sIZEOF_StgMutArrPtrs_NoHdr dflags `quot` wORD_SIZE dflags)
 341
 342 smallArrPtrsHdrSize :: DynFlags -> ByteOff
 343 smallArrPtrsHdrSize dflags
 344  = fixedHdrSize dflags + sIZEOF_StgSmallMutArrPtrs_NoHdr dflags
 345
 346 smallArrPtrsHdrSizeW :: DynFlags -> WordOff
 347 smallArrPtrsHdrSizeW dflags =
 348     fixedHdrSizeW dflags +
 349     (sIZEOF_StgSmallMutArrPtrs_NoHdr dflags `quot` wORD_SIZE dflags)
 350
 351 -- Thunks have an extra header word on SMP, so the update doesn't
 352 -- splat the payload.
 353 thunkHdrSize :: DynFlags -> WordOff
 354 thunkHdrSize dflags = fixedHdrSizeW dflags + smp_hdr
 355         where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE dflags
 356
 357 hdrSize :: DynFlags -> SMRep -> ByteOff
 358 hdrSize dflags rep = wordsToBytes dflags (hdrSizeW dflags rep)
 359
 360 hdrSizeW :: DynFlags -> SMRep -> WordOff
 361 hdrSizeW dflags (HeapRep _ _ _ ty)    = closureTypeHdrSize dflags ty
 362 hdrSizeW dflags (ArrayPtrsRep _ _)    = arrPtrsHdrSizeW dflags
 363 hdrSizeW dflags (SmallArrayPtrsRep _) = smallArrPtrsHdrSizeW dflags
 364 hdrSizeW dflags (ArrayWordsRep _)     = arrWordsHdrSizeW dflags
 365 hdrSizeW _ _                          = panic "SMRep.hdrSizeW"
 366
 367 nonHdrSize :: DynFlags -> SMRep -> ByteOff
 368 nonHdrSize dflags rep = wordsToBytes dflags (nonHdrSizeW rep)
 369
 370 nonHdrSizeW :: SMRep -> WordOff
 371 nonHdrSizeW (HeapRep _ p np _) = p + np
 372 nonHdrSizeW (ArrayPtrsRep elems ct) = elems + ct
 373 nonHdrSizeW (SmallArrayPtrsRep elems) = elems
 374 nonHdrSizeW (ArrayWordsRep words) = words
 375 nonHdrSizeW (StackRep bs)      = length bs
 376 nonHdrSizeW (RTSRep _ rep)     = nonHdrSizeW rep
 377
 378 -- | The total size of the closure, in words.
 379 heapClosureSizeW :: DynFlags -> SMRep -> WordOff
 380 heapClosureSizeW dflags (HeapRep _ p np ty)
 381  = closureTypeHdrSize dflags ty + p + np
 382 heapClosureSizeW dflags (ArrayPtrsRep elems ct)
 383  = arrPtrsHdrSizeW dflags + elems + ct
 384 heapClosureSizeW dflags (SmallArrayPtrsRep elems)
 385  = smallArrPtrsHdrSizeW dflags + elems
 386 heapClosureSizeW dflags (ArrayWordsRep words)
 387  = arrWordsHdrSizeW dflags + words
 388 heapClosureSizeW _ _ = panic "SMRep.heapClosureSize"
 389
 390 closureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> WordOff
 391 closureTypeHdrSize dflags ty = case ty of
 392                   Thunk{}         -> thunkHdrSize dflags
 393                   ThunkSelector{} -> thunkHdrSize dflags
 394                   BlackHole{}     -> thunkHdrSize dflags
 395                   IndStatic{}     -> thunkHdrSize dflags
 396                   _               -> fixedHdrSizeW dflags
 397         -- All thunks use thunkHdrSize, even if they are non-updatable.
 398         -- this is because we don't have separate closure types for
 399         -- updatable vs. non-updatable thunks, so the GC can't tell the
 400         -- difference.  If we ever have significant numbers of non-
 401         -- updatable thunks, it might be worth fixing this.
 402
 403 -- ---------------------------------------------------------------------------
 404 -- Arrays
 405
 406 -- | The byte offset into the card table of the card for a given element
 407 card :: DynFlags -> Int -> Int
 408 card dflags i = i `shiftR` mUT_ARR_PTRS_CARD_BITS dflags
 409
 410 -- | Convert a number of elements to a number of cards, rounding up
 411 cardRoundUp :: DynFlags -> Int -> Int
 412 cardRoundUp dflags i =
 413   card dflags (i + ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS dflags) - 1))
 414
 415 -- | The size of a card table, in bytes
 416 cardTableSizeB :: DynFlags -> Int -> ByteOff
 417 cardTableSizeB dflags elems = cardRoundUp dflags elems
 418
 419 -- | The size of a card table, in words
 420 cardTableSizeW :: DynFlags -> Int -> WordOff
 421 cardTableSizeW dflags elems =
 422   bytesToWordsRoundUp dflags (cardTableSizeB dflags elems)
 423
 424 -----------------------------------------------------------------------------
 425 -- deriving the RTS closure type from an SMRep
 426
 427 #include "../includes/rts/storage/ClosureTypes.h"
 428 #include "../includes/rts/storage/FunTypes.h"
 429 -- Defines CONSTR, CONSTR_1_0 etc
 430
 431 -- | Derives the RTS closure type from an 'SMRep'
 432 rtsClosureType :: SMRep -> Int
 433 rtsClosureType rep
 434     = case rep of
 435       RTSRep ty _ -> ty
 436
 437       -- See Note [static constructors]
 438       HeapRep _     1 0 Constr{} -> CONSTR_1_0
 439       HeapRep _     0 1 Constr{} -> CONSTR_0_1
 440       HeapRep _     2 0 Constr{} -> CONSTR_2_0
 441       HeapRep _     1 1 Constr{} -> CONSTR_1_1
 442       HeapRep _     0 2 Constr{} -> CONSTR_0_2
 443       HeapRep _     0 _ Constr{} -> CONSTR_NOCAF
 444            -- See Note [Static NoCaf constructors]
 445       HeapRep _     _ _ Constr{} -> CONSTR
 446
 447       HeapRep False 1 0 Fun{} -> FUN_1_0
 448       HeapRep False 0 1 Fun{} -> FUN_0_1
 449       HeapRep False 2 0 Fun{} -> FUN_2_0
 450       HeapRep False 1 1 Fun{} -> FUN_1_1
 451       HeapRep False 0 2 Fun{} -> FUN_0_2
 452       HeapRep False _ _ Fun{} -> FUN
 453
 454       HeapRep False 1 0 Thunk{} -> THUNK_1_0
 455       HeapRep False 0 1 Thunk{} -> THUNK_0_1
 456       HeapRep False 2 0 Thunk{} -> THUNK_2_0
 457       HeapRep False 1 1 Thunk{} -> THUNK_1_1
 458       HeapRep False 0 2 Thunk{} -> THUNK_0_2
 459       HeapRep False _ _ Thunk{} -> THUNK
 460
 461       HeapRep False _ _ ThunkSelector{} ->  THUNK_SELECTOR
 462
 463       HeapRep True _ _ Fun{}    -> FUN_STATIC
 464       HeapRep True _ _ Thunk{}  -> THUNK_STATIC
 465
 466       HeapRep False _ _ BlackHole{} -> BLACKHOLE
 467
 468       HeapRep False _ _ IndStatic{} -> IND_STATIC
 469
 470       _ -> panic "rtsClosureType"
 471
 472 -- We export these ones
 473 rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: Int
 474 rET_SMALL   = RET_SMALL
 475 rET_BIG     = RET_BIG
 476 aRG_GEN     = ARG_GEN
 477 aRG_GEN_BIG = ARG_GEN_BIG
 478
 479 {-
 480 Note [static constructors]
 481 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 482
 483 We used to have a CONSTR_STATIC closure type, and each constructor had
 484 two info tables: one with CONSTR (or CONSTR_1_0 etc.), and one with
 485 CONSTR_STATIC.
 486
 487 This distinction was removed, because when copying a data structure
 488 into a compact region, we must copy static constructors into the
 489 compact region too.  If we didn't do this, we would need to track the
 490 references from the compact region out to the static constructors,
 491 because they might (indirectly) refer to CAFs.
 492
 493 Since static constructors will be copied to the heap, if we wanted to
 494 use different info tables for static and dynamic constructors, we
 495 would have to switch the info pointer when copying the constructor
 496 into the compact region, which means we would need an extra field of
 497 the static info table to point to the dynamic one.
 498
 499 However, since the distinction between static and dynamic closure
 500 types is never actually needed (other than for assertions), we can
 501 just drop the distinction and use the same info table for both.
 502
 503 The GC *does* need to distinguish between static and dynamic closures,
 504 but it does this using the HEAP_ALLOCED() macro which checks whether
 505 the address of the closure resides within the dynamic heap.
 506 HEAP_ALLOCED() doesn't read the closure's info table.
 507
 508 Note [Static NoCaf constructors]
 509 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 510 If we know that a top-level binding 'x' is not Caffy (ie no CAFs are
 511 reachable from 'x'), then a statically allocated constructor (Just x)
 512 is also not Caffy, and the garbage collector need not follow its
 513 argument fields.  Exploiting this would require two static info tables
 514 for Just, for the two cases where the argument was Caffy or non-Caffy.
 515
 516 Currently we don't do this; instead we treat nullary constructors
 517 as non-Caffy, and the others as potentially Caffy.
 518
 519
 520 ************************************************************************
 521 *                                                                      *
 522              Pretty printing of SMRep and friends
 523 *                                                                      *
 524 ************************************************************************
 525 -}
 526
 527 instance Outputable ClosureTypeInfo where
 528    ppr = pprTypeInfo
 529
 530 instance Outputable SMRep where
 531    ppr (HeapRep static ps nps tyinfo)
 532      = hang (header <+> lbrace) 2 (ppr tyinfo <+> rbrace)
 533      where
 534        header = text "HeapRep"
 535                 <+> if static then text "static" else empty
 536                 <+> pp_n "ptrs" ps <+> pp_n "nonptrs" nps
 537        pp_n :: String -> Int -> SDoc
 538        pp_n _ 0 = empty
 539        pp_n s n = int n <+> text s
 540
 541    ppr (ArrayPtrsRep size _) = text "ArrayPtrsRep" <+> ppr size
 542
 543    ppr (SmallArrayPtrsRep size) = text "SmallArrayPtrsRep" <+> ppr size
 544
 545    ppr (ArrayWordsRep words) = text "ArrayWordsRep" <+> ppr words
 546
 547    ppr (StackRep bs) = text "StackRep" <+> ppr bs
 548
 549    ppr (RTSRep ty rep) = text "tag:" <> ppr ty <+> ppr rep
 550
 551 instance Outputable ArgDescr where
 552   ppr (ArgSpec n) = text "ArgSpec" <+> ppr n
 553   ppr (ArgGen ls) = text "ArgGen" <+> ppr ls
 554
 555 pprTypeInfo :: ClosureTypeInfo -> SDoc
 556 pprTypeInfo (Constr tag descr)
 557   = text "Con" <+>
 558     braces (sep [ text "tag:" <+> ppr tag
 559                 , text "descr:" <> text (show descr) ])
 560
 561 pprTypeInfo (Fun arity args)
 562   = text "Fun" <+>
 563     braces (sep [ text "arity:" <+> ppr arity
 564                 , ptext (sLit ("fun_type:")) <+> ppr args ])
 565
 566 pprTypeInfo (ThunkSelector offset)
 567   = text "ThunkSel" <+> ppr offset
 568
 569 pprTypeInfo Thunk     = text "Thunk"
 570 pprTypeInfo BlackHole = text "BlackHole"
 571 pprTypeInfo IndStatic = text "IndStatic"
 572
 573 -- XXX Does not belong here!!
 574 stringToWord8s :: String -> [Word8]
 575 stringToWord8s s = map (fromIntegral . ord) s
 576
 577 pprWord8String :: [Word8] -> SDoc
 578 -- Debug printing.  Not very clever right now.
 579 pprWord8String ws = text (show ws)