SMRep.lhs 19.1 KB
Newer Older
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow 2006
3
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
%
Simon Marlow's avatar
Simon Marlow committed
5 6

Storage manager representation of closures
7 8

\begin{code}
9
{-# LANGUAGE CPP,GeneralizedNewtypeDeriving #-}
10

11
module SMRep (
Simon Marlow's avatar
Simon Marlow committed
12
        -- * Words and bytes
13 14 15 16
        WordOff, ByteOff,
        wordsToBytes, bytesToWordsRoundUp,
        roundUpToWords,

17
        StgWord, fromStgWord, toStgWord,
18
        StgHalfWord, fromStgHalfWord, toStgHalfWord,
19
        hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
20

Simon Marlow's avatar
Simon Marlow committed
21
        -- * Closure repesentation
22 23
        SMRep(..), -- CmmInfo sees the rep; no one else does
        IsStatic,
24
        ClosureTypeInfo(..), ArgDescr(..), Liveness,
25
        ConstrDescription,
Simon Marlow's avatar
Simon Marlow committed
26 27

        -- ** Construction
28
        mkHeapRep, blackHoleRep, indStaticRep, mkStackRep, mkRTSRep, arrPtrsRep,
29
        smallArrPtrsRep, arrWordsRep,
30

Simon Marlow's avatar
Simon Marlow committed
31
        -- ** Predicates
Simon Marlow's avatar
Simon Marlow committed
32
        isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon,
33
        isStackRep,
Simon Marlow's avatar
Simon Marlow committed
34 35

        -- ** Size-related things
36
        heapClosureSizeW,
37
        fixedHdrSizeW, arrWordsHdrSize, arrWordsHdrSizeW, arrPtrsHdrSize,
38
        arrPtrsHdrSizeW, profHdrSize, thunkHdrSize, nonHdrSize, nonHdrSizeW,
39 40
        smallArrPtrsHdrSize, smallArrPtrsHdrSizeW, hdrSize, hdrSizeW,
        fixedHdrSize,
41

Simon Marlow's avatar
Simon Marlow committed
42 43
        -- ** RTS closure types
        rtsClosureType, rET_SMALL, rET_BIG,
44 45
        aRG_GEN, aRG_GEN_BIG,

46 47 48
        -- ** Arrays
        card, cardRoundUp, cardTableSizeB, cardTableSizeW,

Simon Marlow's avatar
Simon Marlow committed
49
        -- * Operations over [Word8] strings that don't belong here
50
        pprWord8String, stringToWord8s
51 52
    ) where

53
#include "../HsVersions.h"
54
#include "../includes/MachDeps.h"
55

56
import DynFlags
sof's avatar
sof committed
57
import Outputable
58
import Platform
59
import FastString
60

61
import Data.Char( ord )
Simon Marlow's avatar
Simon Marlow committed
62
import Data.Word
63
import Data.Bits
64 65
\end{code}

66 67

%************************************************************************
68 69 70
%*                                                                      *
                Words and bytes
%*                                                                      *
71 72 73
%************************************************************************

\begin{code}
tibbe's avatar
tibbe committed
74 75
-- | Word offset, or word count
type WordOff = Int
76

tibbe's avatar
tibbe committed
77 78 79 80 81
-- | 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.
82
roundUpToWords :: DynFlags -> ByteOff -> ByteOff
83 84 85
roundUpToWords dflags n =
  (n + (wORD_SIZE dflags - 1)) .&. (complement (wORD_SIZE dflags - 1))

tibbe's avatar
tibbe committed
86 87 88 89
-- | 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
90 91 92 93 94
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 #-}
95

tibbe's avatar
tibbe committed
96 97
-- | First round the given byte count up to a multiple of the
-- machine's word size and then convert the result to words.
98 99 100
bytesToWordsRoundUp :: DynFlags -> ByteOff -> WordOff
bytesToWordsRoundUp dflags n = (n + word_size - 1) `quot` word_size
 where word_size = wORD_SIZE dflags
101 102 103 104 105
\end{code}

StgWord is a type representing an StgWord on the target platform.

\begin{code}
106
-- A Word64 is large enough to hold a Word for either a 32bit or 64bit platform
107
newtype StgWord = StgWord Word64
108
    deriving (Eq, Bits)
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126

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)

--

127 128 129
-- A Word32 is large enough to hold half a Word for either a 32bit or
-- 64bit platform
newtype StgHalfWord = StgHalfWord Word32
130 131 132
    deriving Eq

fromStgHalfWord :: StgHalfWord -> Integer
133
fromStgHalfWord (StgHalfWord w) = toInteger w
134 135 136 137 138 139

toStgHalfWord :: DynFlags -> Integer -> StgHalfWord
toStgHalfWord dflags i
    = case platformWordSize (targetPlatform dflags) of
      -- These conversions mean that things like toStgHalfWord (-1)
      -- do the right thing
140 141
      4 -> StgHalfWord (fromIntegral (fromInteger i :: Word16))
      8 -> StgHalfWord (fromInteger i :: Word32)
142 143 144
      w -> panic ("toStgHalfWord: Unknown platformWordSize: " ++ show w)

instance Outputable StgHalfWord where
145
    ppr (StgHalfWord w) = integer (toInteger w)
146

ian@well-typed.com's avatar
ian@well-typed.com committed
147 148 149 150
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
151 152
\end{code}

153
%************************************************************************
154
%*                                                                      *
155
\subsubsection[SMRep-datatype]{@SMRep@---storage manager representation}
156
%*                                                                      *
157 158 159
%************************************************************************

\begin{code}
160 161
-- | A description of the layout of a closure.  Corresponds directly
-- to the closure types in includes/rts/storage/ClosureTypes.h.
162
data SMRep
163 164 165 166 167 168
  = 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

169 170 171 172
  | ArrayPtrsRep
        !WordOff        -- # ptr words
        !WordOff        -- # card table words

173 174 175
  | SmallArrayPtrsRep
        !WordOff        -- # ptr words

176 177 178
  | ArrayWordsRep
        !WordOff        -- # bytes expressed in words, rounded up

179 180 181
  | StackRep            -- Stack frame (RET_SMALL or RET_BIG)
        Liveness

182
  | RTSRep              -- The RTS needs to declare info tables with specific
183
        Int             -- type tags, so this form lets us override the default
184 185
        SMRep           -- tag for an SMRep.

186 187 188 189 190 191 192 193 194 195 196 197 198 199
-- | True <=> This is a static closure.  Affects how we garbage-collect it.
-- Static closure have an extra static link field at the end.
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
  = Constr        ConstrTag ConstrDescription
  | Fun           FunArity ArgDescr
  | Thunk
  | ThunkSelector SelectorOffset
  | BlackHole
200
  | IndStatic
201

202
type ConstrTag         = Int
203
type ConstrDescription = [Word8] -- result of dataConIdentity
204 205
type FunArity          = Int
type SelectorOffset    = Int
206 207 208 209 210

-------------------------
-- 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.
211
--
212 213
-- In the compiled program, liveness bitmaps that fit inside a single
-- word (StgWord) are stored as a single word, while larger bitmaps are
214
-- stored as a pointer to an array of words.
215 216 217 218 219 220 221 222

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
223
  = ArgSpec             -- Fits one of the standard patterns
224
        !Int            -- RTS type identifier ARG_P, ARG_N, ...
225

226 227
  | ArgGen              -- General case
        Liveness        -- Details about the arguments
228 229 230 231 232


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

233 234 235
mkHeapRep :: DynFlags -> IsStatic -> WordOff -> WordOff -> ClosureTypeInfo
          -> SMRep
mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type_info
236 237 238 239 240 241 242
  = HeapRep is_static
            ptr_wds
            (nonptr_wds + slop_wds)
            cl_type_info
  where
     slop_wds
      | is_static = 0
243
      | otherwise = max 0 (minClosureSize dflags - (hdr_size + payload_size))
244

245
     hdr_size     = closureTypeHdrSize dflags cl_type_info
246
     payload_size = ptr_wds + nonptr_wds
247

248
mkRTSRep :: Int -> SMRep -> SMRep
249
mkRTSRep = RTSRep
250 251

mkStackRep :: [Bool] -> SMRep
252
mkStackRep liveness = StackRep liveness
253 254 255 256

blackHoleRep :: SMRep
blackHoleRep = HeapRep False 0 0 BlackHole

257 258 259
indStaticRep :: SMRep
indStaticRep = HeapRep True 1 0 IndStatic

260 261 262
arrPtrsRep :: DynFlags -> WordOff -> SMRep
arrPtrsRep dflags elems = ArrayPtrsRep elems (cardTableSizeW dflags elems)

263 264 265
smallArrPtrsRep :: WordOff -> SMRep
smallArrPtrsRep elems = SmallArrayPtrsRep elems

266 267 268
arrWordsRep :: DynFlags -> ByteOff -> SMRep
arrWordsRep dflags bytes = ArrayWordsRep (bytesToWordsRoundUp dflags bytes)

Simon Marlow's avatar
Simon Marlow committed
269 270 271 272 273 274
-----------------------------------------------------------------------------
-- Predicates

isStaticRep :: SMRep -> IsStatic
isStaticRep (HeapRep is_static _ _ _) = is_static
isStaticRep (RTSRep _ rep)            = isStaticRep rep
275
isStaticRep _                         = False
Simon Marlow's avatar
Simon Marlow committed
276

277 278 279 280 281
isStackRep :: SMRep -> Bool
isStackRep StackRep{}     = True
isStackRep (RTSRep _ rep) = isStackRep rep
isStackRep _              = False

Simon Marlow's avatar
Simon Marlow committed
282 283 284 285 286 287 288 289
isConRep :: SMRep -> Bool
isConRep (HeapRep _ _ _ Constr{}) = True
isConRep _                        = False

isThunkRep :: SMRep -> Bool
isThunkRep (HeapRep _ _ _ Thunk{})         = True
isThunkRep (HeapRep _ _ _ ThunkSelector{}) = True
isThunkRep (HeapRep _ _ _ BlackHole{})     = True
290
isThunkRep (HeapRep _ _ _ IndStatic{})     = True
Simon Marlow's avatar
Simon Marlow committed
291 292
isThunkRep _                               = False

Simon Marlow's avatar
Simon Marlow committed
293 294 295 296
isFunRep :: SMRep -> Bool
isFunRep (HeapRep _ _ _ Fun{}) = True
isFunRep _                     = False

Simon Marlow's avatar
Simon Marlow committed
297 298 299 300 301 302 303
isStaticNoCafCon :: SMRep -> Bool
-- This should line up exactly with CONSTR_NOCAF_STATIC above
-- See Note [Static NoCaf constructors]
isStaticNoCafCon (HeapRep True 0 _ Constr{}) = True
isStaticNoCafCon _                           = False


304 305 306
-----------------------------------------------------------------------------
-- Size-related things

307 308 309
fixedHdrSize :: DynFlags -> ByteOff
fixedHdrSize dflags = wordsToBytes dflags (fixedHdrSizeW dflags)

310
-- | Size of a closure header (StgHeader in includes/rts/storage/Closures.h)
311 312
fixedHdrSizeW :: DynFlags -> WordOff
fixedHdrSizeW dflags = sTD_HDR_SIZE dflags + profHdrSize dflags
313

314 315
-- | Size of the profiling part of a closure header
-- (StgProfHeader in includes/rts/storage/Closures.h)
316 317
profHdrSize  :: DynFlags -> WordOff
profHdrSize dflags
ian@well-typed.com's avatar
ian@well-typed.com committed
318
 | gopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags
319
 | otherwise                      = 0
320

321 322 323
-- | The garbage collector requires that every closure is at least as
--   big as this.
minClosureSize :: DynFlags -> WordOff
324
minClosureSize dflags = fixedHdrSizeW dflags + mIN_PAYLOAD_SIZE dflags
325

326 327
arrWordsHdrSize :: DynFlags -> ByteOff
arrWordsHdrSize dflags
328
 = fixedHdrSize dflags + sIZEOF_StgArrWords_NoHdr dflags
329

330 331
arrWordsHdrSizeW :: DynFlags -> WordOff
arrWordsHdrSizeW dflags =
332
    fixedHdrSizeW dflags +
333 334
    (sIZEOF_StgArrWords_NoHdr dflags `quot` wORD_SIZE dflags)

335 336
arrPtrsHdrSize :: DynFlags -> ByteOff
arrPtrsHdrSize dflags
337
 = fixedHdrSize dflags + sIZEOF_StgMutArrPtrs_NoHdr dflags
338

339 340
arrPtrsHdrSizeW :: DynFlags -> WordOff
arrPtrsHdrSizeW dflags =
341
    fixedHdrSizeW dflags +
342 343
    (sIZEOF_StgMutArrPtrs_NoHdr dflags `quot` wORD_SIZE dflags)

344 345 346 347 348 349 350 351 352
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)

353
-- Thunks have an extra header word on SMP, so the update doesn't
354
-- splat the payload.
355
thunkHdrSize :: DynFlags -> WordOff
356
thunkHdrSize dflags = fixedHdrSizeW dflags + smp_hdr
357
        where smp_hdr = sIZEOF_StgSMPThunkHeader dflags `quot` wORD_SIZE dflags
358

359 360 361 362 363 364 365 366 367 368
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"

369 370
nonHdrSize :: DynFlags -> SMRep -> ByteOff
nonHdrSize dflags rep = wordsToBytes dflags (nonHdrSizeW rep)
371

372 373 374
nonHdrSizeW :: SMRep -> WordOff
nonHdrSizeW (HeapRep _ p np _) = p + np
nonHdrSizeW (ArrayPtrsRep elems ct) = elems + ct
375
nonHdrSizeW (SmallArrayPtrsRep elems) = elems
376
nonHdrSizeW (ArrayWordsRep words) = words
377 378
nonHdrSizeW (StackRep bs)      = length bs
nonHdrSizeW (RTSRep _ rep)     = nonHdrSizeW rep
379

380
-- | The total size of the closure, in words.
381 382
heapClosureSizeW :: DynFlags -> SMRep -> WordOff
heapClosureSizeW dflags (HeapRep _ p np ty)
383
 = closureTypeHdrSize dflags ty + p + np
384 385
heapClosureSizeW dflags (ArrayPtrsRep elems ct)
 = arrPtrsHdrSizeW dflags + elems + ct
386 387
heapClosureSizeW dflags (SmallArrayPtrsRep elems)
 = smallArrPtrsHdrSizeW dflags + elems
388 389
heapClosureSizeW dflags (ArrayWordsRep words)
 = arrWordsHdrSizeW dflags + words
390
heapClosureSizeW _ _ = panic "SMRep.heapClosureSize"
391 392 393 394 395 396

closureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> WordOff
closureTypeHdrSize dflags ty = case ty of
                  Thunk{}         -> thunkHdrSize dflags
                  ThunkSelector{} -> thunkHdrSize dflags
                  BlackHole{}     -> thunkHdrSize dflags
397
                  IndStatic{}     -> thunkHdrSize dflags
398
                  _               -> fixedHdrSizeW dflags
399 400 401 402 403
        -- 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.
404

405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425
-- ---------------------------------------------------------------------------
-- 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)

426 427
-----------------------------------------------------------------------------
-- deriving the RTS closure type from an SMRep
428

429 430 431
#include "../includes/rts/storage/ClosureTypes.h"
#include "../includes/rts/storage/FunTypes.h"
-- Defines CONSTR, CONSTR_1_0 etc
432

433
-- | Derives the RTS closure type from an 'SMRep'
434 435 436 437
rtsClosureType :: SMRep -> Int
rtsClosureType rep
    = case rep of
      RTSRep ty _ -> ty
438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470

      HeapRep False 1 0 Constr{} -> CONSTR_1_0
      HeapRep False 0 1 Constr{} -> CONSTR_0_1
      HeapRep False 2 0 Constr{} -> CONSTR_2_0
      HeapRep False 1 1 Constr{} -> CONSTR_1_1
      HeapRep False 0 2 Constr{} -> CONSTR_0_2
      HeapRep False _ _ Constr{} -> CONSTR

      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

      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

      HeapRep False _ _ ThunkSelector{} ->  THUNK_SELECTOR

      -- Approximation: we use the CONSTR_NOCAF_STATIC type for static
      -- constructors -- that have no pointer words only.
      HeapRep True 0 _ Constr{} -> CONSTR_NOCAF_STATIC  -- See isStaticNoCafCon below
      HeapRep True _ _ Constr{} -> CONSTR_STATIC
      HeapRep True _ _ Fun{}    -> FUN_STATIC
      HeapRep True _ _ Thunk{}  -> THUNK_STATIC

      HeapRep False _ _ BlackHole{} -> BLACKHOLE

471 472
      HeapRep False _ _ IndStatic{} -> IND_STATIC

473
      _ -> panic "rtsClosureType"
474 475

-- We export these ones
476 477 478 479 480
rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: Int
rET_SMALL   = RET_SMALL
rET_BIG     = RET_BIG
aRG_GEN     = ARG_GEN
aRG_GEN_BIG = ARG_GEN_BIG
481
\end{code}
482

483 484
Note [Static NoCaf constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
485
If we know that a top-level binding 'x' is not Caffy (ie no CAFs are
486 487 488 489
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.
490

491
Currently we don't do this; instead we treat nullary constructors
492
as non-Caffy, and the others as potentially Caffy.
493

494

495
%************************************************************************
496
%*                                                                      *
497
             Pretty printing of SMRep and friends
498
%*                                                                      *
499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515
%************************************************************************

\begin{code}
instance Outputable ClosureTypeInfo where
   ppr = pprTypeInfo

instance Outputable SMRep where
   ppr (HeapRep static ps nps tyinfo)
     = hang (header <+> lbrace) 2 (ppr tyinfo <+> rbrace)
     where
       header = ptext (sLit "HeapRep")
                <+> if static then ptext (sLit "static") else empty
                <+> 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

516 517
   ppr (ArrayPtrsRep size _) = ptext (sLit "ArrayPtrsRep") <+> ppr size

518 519
   ppr (SmallArrayPtrsRep size) = ptext (sLit "SmallArrayPtrsRep") <+> ppr size

520 521
   ppr (ArrayWordsRep words) = ptext (sLit "ArrayWordsRep") <+> ppr words

522 523
   ppr (StackRep bs) = ptext (sLit "StackRep") <+> ppr bs

524 525
   ppr (RTSRep ty rep) = ptext (sLit "tag:") <> ppr ty <+> ppr rep

526
instance Outputable ArgDescr where
527
  ppr (ArgSpec n) = ptext (sLit "ArgSpec") <+> ppr n
528
  ppr (ArgGen ls) = ptext (sLit "ArgGen") <+> ppr ls
529

530 531
pprTypeInfo :: ClosureTypeInfo -> SDoc
pprTypeInfo (Constr tag descr)
532
  = ptext (sLit "Con") <+>
533
    braces (sep [ ptext (sLit "tag:") <+> ppr tag
534 535 536
                , ptext (sLit "descr:") <> text (show descr) ])

pprTypeInfo (Fun arity args)
537
  = ptext (sLit "Fun") <+>
538
    braces (sep [ ptext (sLit "arity:") <+> ppr arity
539 540
                , ptext (sLit ("fun_type:")) <+> ppr args ])

541
pprTypeInfo (ThunkSelector offset)
542
  = ptext (sLit "ThunkSel") <+> ppr offset
543 544 545

pprTypeInfo Thunk     = ptext (sLit "Thunk")
pprTypeInfo BlackHole = ptext (sLit "BlackHole")
546
pprTypeInfo IndStatic = ptext (sLit "IndStatic")
547

Simon Marlow's avatar
Simon Marlow committed
548
-- XXX Does not belong here!!
549 550 551 552 553 554 555
stringToWord8s :: String -> [Word8]
stringToWord8s s = map (fromIntegral . ord) s

pprWord8String :: [Word8] -> SDoc
-- Debug printing.  Not very clever right now.
pprWord8String ws = text (show ws)
\end{code}