SMRep.hs 19.8 KB
Newer Older
1 2 3 4
-- (c) The University of Glasgow 2006
-- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
--
-- Storage manager representation of closures
5

6
{-# LANGUAGE CPP,GeneralizedNewtypeDeriving #-}
7

8
module SMRep (
9
        -- * Words and bytes
10 11
        WordOff, ByteOff,
        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 20
        SMRep(..), -- CmmInfo sees the rep; no one else does
        IsStatic,
21
        ClosureTypeInfo(..), ArgDescr(..), Liveness,
22
        ConstrDescription,
23 24

        -- ** Construction
25
        mkHeapRep, blackHoleRep, indStaticRep, mkStackRep, mkRTSRep, arrPtrsRep,
26
        smallArrPtrsRep, arrWordsRep,
27

28
        -- ** Predicates
Simon Marlow's avatar
Simon Marlow committed
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 37
        smallArrPtrsHdrSize, smallArrPtrsHdrSizeW, hdrSize, hdrSizeW,
        fixedHdrSize,
38

39 40
        -- ** RTS closure types
        rtsClosureType, rET_SMALL, rET_BIG,
41
        aRG_GEN, aRG_GEN_BIG,
42

43
        -- ** Arrays
44
        card, cardRoundUp, cardTableSizeB, cardTableSizeW
45 46
    ) where

47 48
import GhcPrelude

49
import BasicTypes( ConTagZ )
50
import DynFlags
sof's avatar
sof committed
51
import Outputable
John Ericson's avatar
John Ericson committed
52
import GHC.Platform
53
import FastString
54

Simon Marlow's avatar
Simon Marlow committed
55
import Data.Word
56
import Data.Bits
57
import Data.ByteString (ByteString)
58

59 60 61
{-
************************************************************************
*                                                                      *
62
                Words and bytes
63 64 65
*                                                                      *
************************************************************************
-}
66

tibbe's avatar
tibbe committed
67 68
-- | Word offset, or word count
type WordOff = Int
69

tibbe's avatar
tibbe committed
70 71 72 73 74
-- | Byte offset, or byte count
type ByteOff = Int

-- | Round up the given byte count to the next byte count that's a
-- multiple of the machine's word size.
75
roundUpToWords :: DynFlags -> ByteOff -> ByteOff
76 77 78 79 80
roundUpToWords dflags n = roundUpTo n (wORD_SIZE dflags)

-- | Round up @base@ to a multiple of @size@.
roundUpTo :: ByteOff -> ByteOff -> ByteOff
roundUpTo base size = (base + (size - 1)) .&. (complement (size - 1))
81

tibbe's avatar
tibbe committed
82 83 84 85
-- | Convert the given number of words to a number of bytes.
--
-- This function morally has type @WordOff -> ByteOff@, but uses @Num
-- a@ to allow for overloading.
tibbe's avatar
tibbe committed
86 87 88 89 90
wordsToBytes :: Num a => DynFlags -> a -> a
wordsToBytes dflags n = fromIntegral (wORD_SIZE dflags) * n
{-# SPECIALIZE wordsToBytes :: DynFlags -> Int -> Int #-}
{-# SPECIALIZE wordsToBytes :: DynFlags -> Word -> Word #-}
{-# SPECIALIZE wordsToBytes :: DynFlags -> Integer -> Integer #-}
91

tibbe's avatar
tibbe committed
92 93
-- | First round the given byte count up to a multiple of the
-- machine's word size and then convert the result to words.
94 95 96
bytesToWordsRoundUp :: DynFlags -> ByteOff -> WordOff
bytesToWordsRoundUp dflags n = (n + word_size - 1) `quot` word_size
 where word_size = wORD_SIZE dflags
97
-- StgWord is a type representing an StgWord on the target platform.
98
-- A Word64 is large enough to hold a Word for either a 32bit or 64bit platform
99
newtype StgWord = StgWord Word64
100
    deriving (Eq, Bits)
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118

fromStgWord :: StgWord -> Integer
fromStgWord (StgWord i) = toInteger i

toStgWord :: DynFlags -> Integer -> StgWord
toStgWord dflags i
    = case platformWordSize (targetPlatform dflags) of
      -- These conversions mean that things like toStgWord (-1)
      -- do the right thing
      4 -> StgWord (fromIntegral (fromInteger i :: Word32))
      8 -> StgWord (fromInteger i :: Word64)
      w -> panic ("toStgWord: Unknown platformWordSize: " ++ show w)

instance Outputable StgWord where
    ppr (StgWord i) = integer (toInteger i)

--

119 120 121
-- A Word32 is large enough to hold half a Word for either a 32bit or
-- 64bit platform
newtype StgHalfWord = StgHalfWord Word32
122 123 124
    deriving Eq

fromStgHalfWord :: StgHalfWord -> Integer
125
fromStgHalfWord (StgHalfWord w) = toInteger w
126 127 128 129 130 131

toStgHalfWord :: DynFlags -> Integer -> StgHalfWord
toStgHalfWord dflags i
    = case platformWordSize (targetPlatform dflags) of
      -- These conversions mean that things like toStgHalfWord (-1)
      -- do the right thing
132 133
      4 -> StgHalfWord (fromIntegral (fromInteger i :: Word16))
      8 -> StgHalfWord (fromInteger i :: Word32)
134 135 136
      w -> panic ("toStgHalfWord: Unknown platformWordSize: " ++ show w)

instance Outputable StgHalfWord where
137
    ppr (StgHalfWord w) = integer (toInteger w)
138

139 140 141 142
hALF_WORD_SIZE :: DynFlags -> ByteOff
hALF_WORD_SIZE dflags = platformWordSize (targetPlatform dflags) `shiftR` 1
hALF_WORD_SIZE_IN_BITS :: DynFlags -> Int
hALF_WORD_SIZE_IN_BITS dflags = platformWordSize (targetPlatform dflags) `shiftL` 2
143

144 145 146
{-
************************************************************************
*                                                                      *
147
\subsubsection[SMRep-datatype]{@SMRep@---storage manager representation}
148 149 150
*                                                                      *
************************************************************************
-}
151

152 153
-- | A description of the layout of a closure.  Corresponds directly
-- to the closure types in includes/rts/storage/ClosureTypes.h.
154
data SMRep
155 156 157 158 159 160
  = HeapRep              -- GC routines consult sizes in info tbl
        IsStatic
        !WordOff         --  # ptr words
        !WordOff         --  # non-ptr words INCLUDING SLOP (see mkHeapRep below)
        ClosureTypeInfo  -- type-specific info

161 162 163 164
  | ArrayPtrsRep
        !WordOff        -- # ptr words
        !WordOff        -- # card table words

165 166 167
  | SmallArrayPtrsRep
        !WordOff        -- # ptr words

168 169 170
  | ArrayWordsRep
        !WordOff        -- # bytes expressed in words, rounded up

171 172 173
  | StackRep            -- Stack frame (RET_SMALL or RET_BIG)
        Liveness

174
  | RTSRep              -- The RTS needs to declare info tables with specific
175
        Int             -- type tags, so this form lets us override the default
176 177
        SMRep           -- tag for an SMRep.

178 179
-- | True <=> This is a static closure.  Affects how we garbage-collect it.
-- Static closure have an extra static link field at the end.
Simon Marlow's avatar
Simon Marlow committed
180
-- Constructors do not have a static variant; see Note [static constructors]
181 182 183 184 185 186 187
type IsStatic = Bool

-- From an SMRep you can get to the closure type defined in
-- includes/rts/storage/ClosureTypes.h. Described by the function
-- rtsClosureType below.

data ClosureTypeInfo
188
  = Constr        ConTagZ ConstrDescription
189 190 191 192
  | Fun           FunArity ArgDescr
  | Thunk
  | ThunkSelector SelectorOffset
  | BlackHole
193
  | IndStatic
194

195
type ConstrDescription = ByteString -- result of dataConIdentity
196 197
type FunArity          = Int
type SelectorOffset    = Int
198 199 200 201 202

-------------------------
-- We represent liveness bitmaps as a Bitmap (whose internal
-- representation really is a bitmap).  These are pinned onto case return
-- vectors to indicate the state of the stack for the garbage collector.
203
--
204 205
-- In the compiled program, liveness bitmaps that fit inside a single
-- word (StgWord) are stored as a single word, while larger bitmaps are
206
-- stored as a pointer to an array of words.
207 208 209 210 211 212 213 214

type Liveness = [Bool]   -- One Bool per word; True  <=> non-ptr or dead
                         --                    False <=> ptr

-------------------------
-- An ArgDescr describes the argument pattern of a function

data ArgDescr
215
  = ArgSpec             -- Fits one of the standard patterns
216
        !Int            -- RTS type identifier ARG_P, ARG_N, ...
217

218 219
  | ArgGen              -- General case
        Liveness        -- Details about the arguments
220 221 222 223 224


-----------------------------------------------------------------------------
-- Construction

225 226 227
mkHeapRep :: DynFlags -> IsStatic -> WordOff -> WordOff -> ClosureTypeInfo
          -> SMRep
mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type_info
228 229 230 231 232 233 234
  = HeapRep is_static
            ptr_wds
            (nonptr_wds + slop_wds)
            cl_type_info
  where
     slop_wds
      | is_static = 0
235
      | otherwise = max 0 (minClosureSize dflags - (hdr_size + payload_size))
236

237
     hdr_size     = closureTypeHdrSize dflags cl_type_info
238
     payload_size = ptr_wds + nonptr_wds
239

240
mkRTSRep :: Int -> SMRep -> SMRep
241
mkRTSRep = RTSRep
242 243

mkStackRep :: [Bool] -> SMRep
244
mkStackRep liveness = StackRep liveness
245 246 247 248

blackHoleRep :: SMRep
blackHoleRep = HeapRep False 0 0 BlackHole

249 250 251
indStaticRep :: SMRep
indStaticRep = HeapRep True 1 0 IndStatic

252 253 254
arrPtrsRep :: DynFlags -> WordOff -> SMRep
arrPtrsRep dflags elems = ArrayPtrsRep elems (cardTableSizeW dflags elems)

255 256 257
smallArrPtrsRep :: WordOff -> SMRep
smallArrPtrsRep elems = SmallArrayPtrsRep elems

258 259 260
arrWordsRep :: DynFlags -> ByteOff -> SMRep
arrWordsRep dflags bytes = ArrayWordsRep (bytesToWordsRoundUp dflags bytes)

261 262 263 264 265 266
-----------------------------------------------------------------------------
-- Predicates

isStaticRep :: SMRep -> IsStatic
isStaticRep (HeapRep is_static _ _ _) = is_static
isStaticRep (RTSRep _ rep)            = isStaticRep rep
267
isStaticRep _                         = False
268

269 270 271 272 273
isStackRep :: SMRep -> Bool
isStackRep StackRep{}     = True
isStackRep (RTSRep _ rep) = isStackRep rep
isStackRep _              = False

274 275 276 277 278
isConRep :: SMRep -> Bool
isConRep (HeapRep _ _ _ Constr{}) = True
isConRep _                        = False

isThunkRep :: SMRep -> Bool
Gabor Greif's avatar
Gabor Greif committed
279
isThunkRep (HeapRep _ _ _ Thunk)           = True
280
isThunkRep (HeapRep _ _ _ ThunkSelector{}) = True
Gabor Greif's avatar
Gabor Greif committed
281 282
isThunkRep (HeapRep _ _ _ BlackHole)       = True
isThunkRep (HeapRep _ _ _ IndStatic)       = True
283 284
isThunkRep _                               = False

Simon Marlow's avatar
Simon Marlow committed
285 286 287 288
isFunRep :: SMRep -> Bool
isFunRep (HeapRep _ _ _ Fun{}) = True
isFunRep _                     = False

289
isStaticNoCafCon :: SMRep -> Bool
Simon Marlow's avatar
Simon Marlow committed
290
-- This should line up exactly with CONSTR_NOCAF below
291
-- See Note [Static NoCaf constructors]
Simon Marlow's avatar
Simon Marlow committed
292 293
isStaticNoCafCon (HeapRep _ 0 _ Constr{}) = True
isStaticNoCafCon _                        = False
294 295


296 297 298
-----------------------------------------------------------------------------
-- Size-related things

299 300 301
fixedHdrSize :: DynFlags -> ByteOff
fixedHdrSize dflags = wordsToBytes dflags (fixedHdrSizeW dflags)

302
-- | Size of a closure header (StgHeader in includes/rts/storage/Closures.h)
303 304
fixedHdrSizeW :: DynFlags -> WordOff
fixedHdrSizeW dflags = sTD_HDR_SIZE dflags + profHdrSize dflags
305

306 307
-- | Size of the profiling part of a closure header
-- (StgProfHeader in includes/rts/storage/Closures.h)
308 309
profHdrSize  :: DynFlags -> WordOff
profHdrSize dflags
ian@well-typed.com's avatar
ian@well-typed.com committed
310
 | gopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags
311
 | otherwise                      = 0
312

313 314 315
-- | The garbage collector requires that every closure is at least as
--   big as this.
minClosureSize :: DynFlags -> WordOff
316
minClosureSize dflags = fixedHdrSizeW dflags + mIN_PAYLOAD_SIZE dflags
317

318 319
arrWordsHdrSize :: DynFlags -> ByteOff
arrWordsHdrSize dflags
siddhanathan's avatar
siddhanathan committed
320
 = fixedHdrSize dflags + sIZEOF_StgArrBytes_NoHdr dflags
321

322 323
arrWordsHdrSizeW :: DynFlags -> WordOff
arrWordsHdrSizeW dflags =
324
    fixedHdrSizeW dflags +
siddhanathan's avatar
siddhanathan committed
325
    (sIZEOF_StgArrBytes_NoHdr dflags `quot` wORD_SIZE dflags)
326

327 328
arrPtrsHdrSize :: DynFlags -> ByteOff
arrPtrsHdrSize dflags
329
 = fixedHdrSize dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags
330

331 332
arrPtrsHdrSizeW :: DynFlags -> WordOff
arrPtrsHdrSizeW dflags =
333
    fixedHdrSizeW dflags +
334 335
    (sIZEOF_StgMutArrPtrs_NoHdr dflags `quot` wORD_SIZE dflags)

336 337 338 339 340 341 342 343 344
smallArrPtrsHdrSize :: DynFlags -> ByteOff
smallArrPtrsHdrSize dflags
 = fixedHdrSize dflags + sIZEOF_StgSmallMutArrPtrs_NoHdr dflags

smallArrPtrsHdrSizeW :: DynFlags -> WordOff
smallArrPtrsHdrSizeW dflags =
    fixedHdrSizeW dflags +
    (sIZEOF_StgSmallMutArrPtrs_NoHdr dflags `quot` wORD_SIZE dflags)

345
-- Thunks have an extra header word on SMP, so the update doesn't
346
-- splat the payload.
347
thunkHdrSize :: DynFlags -> WordOff
348
thunkHdrSize dflags = fixedHdrSizeW dflags + smp_hdr
349
        where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE dflags
350

351 352 353 354 355 356 357 358 359 360
hdrSize :: DynFlags -> SMRep -> ByteOff
hdrSize dflags rep = wordsToBytes dflags (hdrSizeW dflags rep)

hdrSizeW :: DynFlags -> SMRep -> WordOff
hdrSizeW dflags (HeapRep _ _ _ ty)    = closureTypeHdrSize dflags ty
hdrSizeW dflags (ArrayPtrsRep _ _)    = arrPtrsHdrSizeW dflags
hdrSizeW dflags (SmallArrayPtrsRep _) = smallArrPtrsHdrSizeW dflags
hdrSizeW dflags (ArrayWordsRep _)     = arrWordsHdrSizeW dflags
hdrSizeW _ _                          = panic "SMRep.hdrSizeW"

361 362
nonHdrSize :: DynFlags -> SMRep -> ByteOff
nonHdrSize dflags rep = wordsToBytes dflags (nonHdrSizeW rep)
363

364 365 366
nonHdrSizeW :: SMRep -> WordOff
nonHdrSizeW (HeapRep _ p np _) = p + np
nonHdrSizeW (ArrayPtrsRep elems ct) = elems + ct
367
nonHdrSizeW (SmallArrayPtrsRep elems) = elems
368
nonHdrSizeW (ArrayWordsRep words) = words
369 370
nonHdrSizeW (StackRep bs)      = length bs
nonHdrSizeW (RTSRep _ rep)     = nonHdrSizeW rep
371

372
-- | The total size of the closure, in words.
373 374
heapClosureSizeW :: DynFlags -> SMRep -> WordOff
heapClosureSizeW dflags (HeapRep _ p np ty)
375
 = closureTypeHdrSize dflags ty + p + np
376 377
heapClosureSizeW dflags (ArrayPtrsRep elems ct)
 = arrPtrsHdrSizeW dflags + elems + ct
378 379
heapClosureSizeW dflags (SmallArrayPtrsRep elems)
 = smallArrPtrsHdrSizeW dflags + elems
380 381
heapClosureSizeW dflags (ArrayWordsRep words)
 = arrWordsHdrSizeW dflags + words
382
heapClosureSizeW _ _ = panic "SMRep.heapClosureSize"
383 384 385

closureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> WordOff
closureTypeHdrSize dflags ty = case ty of
Gabor Greif's avatar
Gabor Greif committed
386
                  Thunk           -> thunkHdrSize dflags
387
                  ThunkSelector{} -> thunkHdrSize dflags
Gabor Greif's avatar
Gabor Greif committed
388 389
                  BlackHole       -> thunkHdrSize dflags
                  IndStatic       -> thunkHdrSize dflags
390
                  _               -> fixedHdrSizeW dflags
391 392 393 394 395
        -- All thunks use thunkHdrSize, even if they are non-updatable.
        -- this is because we don't have separate closure types for
        -- updatable vs. non-updatable thunks, so the GC can't tell the
        -- difference.  If we ever have significant numbers of non-
        -- updatable thunks, it might be worth fixing this.
396

397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417
-- ---------------------------------------------------------------------------
-- Arrays

-- | The byte offset into the card table of the card for a given element
card :: DynFlags -> Int -> Int
card dflags i = i `shiftR` mUT_ARR_PTRS_CARD_BITS dflags

-- | Convert a number of elements to a number of cards, rounding up
cardRoundUp :: DynFlags -> Int -> Int
cardRoundUp dflags i =
  card dflags (i + ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS dflags) - 1))

-- | The size of a card table, in bytes
cardTableSizeB :: DynFlags -> Int -> ByteOff
cardTableSizeB dflags elems = cardRoundUp dflags elems

-- | The size of a card table, in words
cardTableSizeW :: DynFlags -> Int -> WordOff
cardTableSizeW dflags elems =
  bytesToWordsRoundUp dflags (cardTableSizeB dflags elems)

418 419
-----------------------------------------------------------------------------
-- deriving the RTS closure type from an SMRep
420

421 422 423
#include "../includes/rts/storage/ClosureTypes.h"
#include "../includes/rts/storage/FunTypes.h"
-- Defines CONSTR, CONSTR_1_0 etc
424

425
-- | Derives the RTS closure type from an 'SMRep'
426 427 428 429
rtsClosureType :: SMRep -> Int
rtsClosureType rep
    = case rep of
      RTSRep ty _ -> ty
430

Simon Marlow's avatar
Simon Marlow committed
431 432 433 434 435 436 437 438 439
      -- See Note [static constructors]
      HeapRep _     1 0 Constr{} -> CONSTR_1_0
      HeapRep _     0 1 Constr{} -> CONSTR_0_1
      HeapRep _     2 0 Constr{} -> CONSTR_2_0
      HeapRep _     1 1 Constr{} -> CONSTR_1_1
      HeapRep _     0 2 Constr{} -> CONSTR_0_2
      HeapRep _     0 _ Constr{} -> CONSTR_NOCAF
           -- See Note [Static NoCaf constructors]
      HeapRep _     _ _ Constr{} -> CONSTR
440 441 442 443 444 445 446 447

      HeapRep False 1 0 Fun{} -> FUN_1_0
      HeapRep False 0 1 Fun{} -> FUN_0_1
      HeapRep False 2 0 Fun{} -> FUN_2_0
      HeapRep False 1 1 Fun{} -> FUN_1_1
      HeapRep False 0 2 Fun{} -> FUN_0_2
      HeapRep False _ _ Fun{} -> FUN

Gabor Greif's avatar
Gabor Greif committed
448 449 450 451 452 453
      HeapRep False 1 0 Thunk -> THUNK_1_0
      HeapRep False 0 1 Thunk -> THUNK_0_1
      HeapRep False 2 0 Thunk -> THUNK_2_0
      HeapRep False 1 1 Thunk -> THUNK_1_1
      HeapRep False 0 2 Thunk -> THUNK_0_2
      HeapRep False _ _ Thunk -> THUNK
454 455 456

      HeapRep False _ _ ThunkSelector{} ->  THUNK_SELECTOR

Gabor Greif's avatar
Gabor Greif committed
457 458 459 460
      HeapRep True _ _ Fun{}      -> FUN_STATIC
      HeapRep True _ _ Thunk      -> THUNK_STATIC
      HeapRep False _ _ BlackHole -> BLACKHOLE
      HeapRep False _ _ IndStatic -> IND_STATIC
461

462
      _ -> panic "rtsClosureType"
463 464

-- We export these ones
465
rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: Int
466 467 468 469
rET_SMALL   = RET_SMALL
rET_BIG     = RET_BIG
aRG_GEN     = ARG_GEN
aRG_GEN_BIG = ARG_GEN_BIG
470

471
{-
Simon Marlow's avatar
Simon Marlow committed
472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499
Note [static constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~

We used to have a CONSTR_STATIC closure type, and each constructor had
two info tables: one with CONSTR (or CONSTR_1_0 etc.), and one with
CONSTR_STATIC.

This distinction was removed, because when copying a data structure
into a compact region, we must copy static constructors into the
compact region too.  If we didn't do this, we would need to track the
references from the compact region out to the static constructors,
because they might (indirectly) refer to CAFs.

Since static constructors will be copied to the heap, if we wanted to
use different info tables for static and dynamic constructors, we
would have to switch the info pointer when copying the constructor
into the compact region, which means we would need an extra field of
the static info table to point to the dynamic one.

However, since the distinction between static and dynamic closure
types is never actually needed (other than for assertions), we can
just drop the distinction and use the same info table for both.

The GC *does* need to distinguish between static and dynamic closures,
but it does this using the HEAP_ALLOCED() macro which checks whether
the address of the closure resides within the dynamic heap.
HEAP_ALLOCED() doesn't read the closure's info table.

500 501
Note [Static NoCaf constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
502
If we know that a top-level binding 'x' is not Caffy (ie no CAFs are
503 504 505 506
reachable from 'x'), then a statically allocated constructor (Just x)
is also not Caffy, and the garbage collector need not follow its
argument fields.  Exploiting this would require two static info tables
for Just, for the two cases where the argument was Caffy or non-Caffy.
507

508
Currently we don't do this; instead we treat nullary constructors
509
as non-Caffy, and the others as potentially Caffy.
510

511

512 513
************************************************************************
*                                                                      *
514
             Pretty printing of SMRep and friends
515 516 517
*                                                                      *
************************************************************************
-}
518 519 520 521 522 523 524 525

instance Outputable ClosureTypeInfo where
   ppr = pprTypeInfo

instance Outputable SMRep where
   ppr (HeapRep static ps nps tyinfo)
     = hang (header <+> lbrace) 2 (ppr tyinfo <+> rbrace)
     where
526 527
       header = text "HeapRep"
                <+> if static then text "static" else empty
528 529 530 531 532
                <+> pp_n "ptrs" ps <+> pp_n "nonptrs" nps
       pp_n :: String -> Int -> SDoc
       pp_n _ 0 = empty
       pp_n s n = int n <+> text s

533
   ppr (ArrayPtrsRep size _) = text "ArrayPtrsRep" <+> ppr size
534

535
   ppr (SmallArrayPtrsRep size) = text "SmallArrayPtrsRep" <+> ppr size
536

537
   ppr (ArrayWordsRep words) = text "ArrayWordsRep" <+> ppr words
538

539
   ppr (StackRep bs) = text "StackRep" <+> ppr bs
540

541
   ppr (RTSRep ty rep) = text "tag:" <> ppr ty <+> ppr rep
542

543
instance Outputable ArgDescr where
544 545
  ppr (ArgSpec n) = text "ArgSpec" <+> ppr n
  ppr (ArgGen ls) = text "ArgGen" <+> ppr ls
546

547 548
pprTypeInfo :: ClosureTypeInfo -> SDoc
pprTypeInfo (Constr tag descr)
549 550 551
  = text "Con" <+>
    braces (sep [ text "tag:" <+> ppr tag
                , text "descr:" <> text (show descr) ])
552 553

pprTypeInfo (Fun arity args)
554 555
  = text "Fun" <+>
    braces (sep [ text "arity:" <+> ppr arity
556 557
                , ptext (sLit ("fun_type:")) <+> ppr args ])

558
pprTypeInfo (ThunkSelector offset)
559
  = text "ThunkSel" <+> ppr offset
560

561 562 563
pprTypeInfo Thunk     = text "Thunk"
pprTypeInfo BlackHole = text "BlackHole"
pprTypeInfo IndStatic = text "IndStatic"