ghc/compiler/absCSyn/CLabel.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 % $Id: CLabel.lhs,v 1.54 2002/07/18 09:16:12 simonmar Exp $
   5 %
   6 \section[CLabel]{@CLabel@: Information to make C Labels}
   7
   8 \begin{code}
   9 module CLabel (
  10         CLabel, -- abstract type
  11
  12         mkClosureLabel,
  13         mkSRTLabel,
  14         mkInfoTableLabel,
  15         mkStdEntryLabel,
  16         mkFastEntryLabel,
  17         mkConEntryLabel,
  18         mkStaticConEntryLabel,
  19         mkRednCountsLabel,
  20         mkConInfoTableLabel,
  21         mkStaticInfoTableLabel,
  22         mkApEntryLabel,
  23         mkApInfoTableLabel,
  24
  25         mkReturnPtLabel,
  26         mkReturnInfoLabel,
  27         mkVecTblLabel,
  28         mkAltLabel,
  29         mkDefaultLabel,
  30         mkBitmapLabel,
  31
  32         mkClosureTblLabel,
  33
  34         mkAsmTempLabel,
  35
  36         mkModuleInitLabel,
  37         mkPlainModuleInitLabel,
  38
  39         mkErrorStdEntryLabel,
  40
  41         mkStgUpdatePAPLabel,
  42         mkSplitMarkerLabel,
  43         mkUpdInfoLabel,
  44         mkSeqInfoLabel,
  45         mkIndInfoLabel,
  46         mkIndStaticInfoLabel,
  47         mkRtsGCEntryLabel,
  48         mkMainCapabilityLabel,
  49         mkCharlikeClosureLabel,
  50         mkIntlikeClosureLabel,
  51         mkMAP_FROZEN_infoLabel,
  52         mkEMPTY_MVAR_infoLabel,
  53
  54         mkTopTickyCtrLabel,
  55         mkBlackHoleInfoTableLabel,
  56         mkCAFBlackHoleInfoTableLabel,
  57         mkSECAFBlackHoleInfoTableLabel,
  58         mkRtsPrimOpLabel,
  59
  60         moduleRegdLabel,
  61
  62         mkSelectorInfoLabel,
  63         mkSelectorEntryLabel,
  64
  65         mkForeignLabel,
  66
  67         mkCC_Label, mkCCS_Label,
  68
  69         needsCDecl, isAsmTemp, externallyVisibleCLabel,
  70
  71         CLabelType(..), labelType, labelDynamic,
  72
  73         pprCLabel
  74     ) where
  75
  76
  77 #include "HsVersions.h"
  78
  79 #if ! OMIT_NATIVE_CODEGEN
  80 import {-# SOURCE #-} MachMisc ( underscorePrefix, fmtAsmLbl )
  81 #endif
  82
  83 import CmdLineOpts      ( opt_Static, opt_DoTickyProfiling )
  84 import CStrings         ( pp_cSEP )
  85 import DataCon          ( ConTag )
  86 import Module           ( moduleName, moduleNameFS,
  87                           Module, isHomeModule )
  88 import Name             ( Name, getName, isDllName, isExternalName )
  89 import TyCon            ( TyCon )
  90 import Unique           ( pprUnique, Unique )
  91 import PrimOp           ( PrimOp )
  92 import CostCentre       ( CostCentre, CostCentreStack )
  93 import BasicTypes       ( Version )
  94 import Outputable
  95 import FastString
  96 \end{code}
  97
  98 things we want to find out:
  99
 100 * should the labelled things be declared "static" (visible only in this file)?
 101
 102 * should it be declared "const" (read-only text space)?
 103
 104 * does it need declarations at all? (v common Prelude things are pre-declared)
 105
 106 * what type does it have? (for generating accurate enough C declarations
 107   so that the C compiler won't complain).
 108
 109 \begin{code}
 110 data CLabel
 111   = IdLabel                     -- A family of labels related to the
 112         Name                    -- definition of a particular Id
 113         IdLabelInfo
 114
 115   | DataConLabel                -- Ditto data constructors
 116         Name
 117         DataConLabelInfo
 118
 119   | CaseLabel                   -- A family of labels related to a particular case expression
 120         Unique                  -- Unique says which case expression
 121         CaseLabelInfo
 122
 123   | TyConLabel TyCon            -- currently only one kind of TyconLabel,
 124                                 -- a 'Closure Table'.
 125
 126   | AsmTempLabel    Unique
 127
 128   | ModuleInitLabel
 129         Module                  -- the module name
 130         String                  -- its "way"
 131         -- at some point we might want some kind of version number in
 132         -- the module init label, to guard against compiling modules in
 133         -- the wrong order.  We can't use the interface file version however,
 134         -- because we don't always recompile modules which depend on a module
 135         -- whose version has changed.
 136
 137   | PlainModuleInitLabel Module  -- without the vesrion & way info
 138
 139   | RtsLabel        RtsLabelInfo
 140
 141   | ForeignLabel FastString Bool  -- a 'C' (or otherwise foreign) label
 142                                    -- Bool <=> is dynamic
 143
 144   | CC_Label CostCentre
 145   | CCS_Label CostCentreStack
 146
 147   deriving (Eq, Ord)
 148 \end{code}
 149
 150 \begin{code}
 151 data IdLabelInfo
 152   = Closure             -- Label for (static???) closure
 153
 154   | SRT                 -- Static reference table
 155
 156   | InfoTbl             -- Info table for a closure; always read-only
 157
 158   | EntryStd            -- Thunk, or "slow", code entry point
 159
 160   | EntryFast Int       -- entry pt when no arg satisfaction chk needed;
 161                         -- Int is the arity of the function (to be
 162                         -- encoded into the name)
 163
 164                         -- Ticky-ticky counting
 165   | RednCounts          -- Label of place to keep reduction-count info for
 166                         -- this Id
 167   deriving (Eq, Ord)
 168
 169 data DataConLabelInfo
 170   = ConEntry            -- the only kind of entry pt for constructors
 171   | ConInfoTbl          -- corresponding info table
 172   | StaticConEntry      -- static constructor entry point
 173   | StaticInfoTbl       -- corresponding info table
 174   deriving (Eq, Ord)
 175
 176 data CaseLabelInfo
 177   = CaseReturnPt
 178   | CaseReturnInfo
 179   | CaseVecTbl
 180   | CaseAlt ConTag
 181   | CaseDefault
 182   | CaseBitmap
 183   deriving (Eq, Ord)
 184
 185 data RtsLabelInfo
 186   = RtsShouldNeverHappenCode
 187
 188   | RtsBlackHoleInfoTbl FastString  -- black hole with info table name
 189
 190   | RtsUpdInfo                  -- upd_frame_info
 191   | RtsSeqInfo                  -- seq_frame_info
 192   | RtsGCEntryLabel String      -- a heap check fail handler, eg  stg_chk_2
 193   | RtsMainCapability           -- MainCapability
 194   | Rts_Closure String          -- misc rts closures, eg CHARLIKE_closure
 195   | Rts_Info String             -- misc rts itbls, eg MUT_ARR_PTRS_FROZEN_info
 196   | Rts_Code String             -- misc rts code
 197
 198   | RtsSelectorInfoTbl Bool{-updatable-} Int{-offset-}  -- Selector thunks
 199   | RtsSelectorEntry   Bool{-updatable-} Int{-offset-}
 200
 201   | RtsApInfoTbl Bool{-updatable-} Int{-arity-}         -- AP thunks
 202   | RtsApEntry   Bool{-updatable-} Int{-arity-}
 203
 204   | RtsPrimOp PrimOp
 205
 206   | RtsTopTickyCtr
 207
 208   | RtsModuleRegd
 209
 210   deriving (Eq, Ord)
 211
 212 -- Label Type: for generating C declarations.
 213
 214 data CLabelType
 215   = InfoTblType
 216   | ClosureType
 217   | VecTblType
 218   | ClosureTblType
 219   | CodeType
 220   | DataType
 221 \end{code}
 222
 223 \begin{code}
 224 mkClosureLabel          id              = IdLabel id  Closure
 225 mkSRTLabel              id              = IdLabel id  SRT
 226 mkInfoTableLabel        id              = IdLabel id  InfoTbl
 227 mkStdEntryLabel         id              = IdLabel id  EntryStd
 228 mkFastEntryLabel        id arity        = ASSERT(arity > 0)
 229                                           IdLabel id  (EntryFast arity)
 230
 231 mkRednCountsLabel       id              = IdLabel id  RednCounts
 232
 233 mkStaticInfoTableLabel  con             = DataConLabel con StaticInfoTbl
 234 mkConInfoTableLabel     con             = DataConLabel con ConInfoTbl
 235 mkConEntryLabel         con             = DataConLabel con ConEntry
 236 mkStaticConEntryLabel   con             = DataConLabel con StaticConEntry
 237
 238
 239 mkReturnPtLabel uniq            = CaseLabel uniq CaseReturnPt
 240 mkReturnInfoLabel uniq          = CaseLabel uniq CaseReturnInfo
 241 mkVecTblLabel   uniq            = CaseLabel uniq CaseVecTbl
 242 mkAltLabel      uniq tag        = CaseLabel uniq (CaseAlt tag)
 243 mkDefaultLabel  uniq            = CaseLabel uniq CaseDefault
 244 mkBitmapLabel   uniq            = CaseLabel uniq CaseBitmap
 245
 246 mkClosureTblLabel tycon         = TyConLabel tycon
 247
 248 mkAsmTempLabel                  = AsmTempLabel
 249
 250 mkModuleInitLabel               = ModuleInitLabel
 251 mkPlainModuleInitLabel          = PlainModuleInitLabel
 252
 253         -- Some fixed runtime system labels
 254
 255 mkErrorStdEntryLabel            = RtsLabel RtsShouldNeverHappenCode
 256 mkStgUpdatePAPLabel             = RtsLabel (Rts_Code "stg_update_PAP")
 257 mkSplitMarkerLabel              = RtsLabel (Rts_Code "__stg_split_marker")
 258 mkUpdInfoLabel                  = RtsLabel RtsUpdInfo
 259 mkSeqInfoLabel                  = RtsLabel RtsSeqInfo
 260 mkIndInfoLabel                  = RtsLabel (Rts_Info "stg_IND_info")
 261 mkIndStaticInfoLabel            = RtsLabel (Rts_Info "stg_IND_STATIC_info")
 262 mkRtsGCEntryLabel str           = RtsLabel (RtsGCEntryLabel str)
 263 mkMainCapabilityLabel           = RtsLabel RtsMainCapability
 264 mkCharlikeClosureLabel          = RtsLabel (Rts_Closure "stg_CHARLIKE_closure")
 265 mkIntlikeClosureLabel           = RtsLabel (Rts_Closure "stg_INTLIKE_closure")
 266 mkMAP_FROZEN_infoLabel          = RtsLabel (Rts_Info "stg_MUT_ARR_PTRS_FROZEN_info")
 267 mkEMPTY_MVAR_infoLabel          = RtsLabel (Rts_Info "stg_EMPTY_MVAR_info")
 268
 269 mkTopTickyCtrLabel              = RtsLabel RtsTopTickyCtr
 270 mkBlackHoleInfoTableLabel       = RtsLabel (RtsBlackHoleInfoTbl FSLIT("stg_BLACKHOLE_info"))
 271 mkCAFBlackHoleInfoTableLabel    = RtsLabel (RtsBlackHoleInfoTbl FSLIT("stg_CAF_BLACKHOLE_info"))
 272 mkSECAFBlackHoleInfoTableLabel  = if opt_DoTickyProfiling then
 273                                     RtsLabel (RtsBlackHoleInfoTbl FSLIT("stg_SE_CAF_BLACKHOLE_info"))
 274                                   else  -- RTS won't have info table unless -ticky is on
 275                                     panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
 276 mkRtsPrimOpLabel primop         = RtsLabel (RtsPrimOp primop)
 277
 278 moduleRegdLabel                 = RtsLabel RtsModuleRegd
 279
 280 mkSelectorInfoLabel  upd off    = RtsLabel (RtsSelectorInfoTbl upd off)
 281 mkSelectorEntryLabel upd off    = RtsLabel (RtsSelectorEntry   upd off)
 282
 283 mkApInfoTableLabel  upd off     = RtsLabel (RtsApInfoTbl upd off)
 284 mkApEntryLabel upd off          = RtsLabel (RtsApEntry   upd off)
 285
 286         -- Foreign labels
 287
 288 mkForeignLabel :: FastString -> Bool -> CLabel
 289 mkForeignLabel str is_dynamic   = ForeignLabel str is_dynamic
 290
 291         -- Cost centres etc.
 292
 293 mkCC_Label      cc              = CC_Label cc
 294 mkCCS_Label     ccs             = CCS_Label ccs
 295 \end{code}
 296
 297 \begin{code}
 298 needsCDecl :: CLabel -> Bool    -- False <=> it's pre-declared; don't bother
 299 isAsmTemp  :: CLabel -> Bool    -- is a local temporary for native code generation
 300 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 301 \end{code}
 302
 303 @needsCDecl@ is @True@ unless the thing is a deeply-@PreludeCore@-ish
 304 object.  {\em Also:} No need to spit out labels for things generated
 305 by the flattener (in @AbsCUtils@)---it is careful to ensure references
 306 to them are always backwards.  These are return-point and vector-table
 307 labels.
 308
 309 Declarations for (non-prelude) @Id@-based things are needed because of
 310 mutual recursion.
 311
 312 Declarations for direct return points are needed, because they may be
 313 let-no-escapes, which can be recursive.
 314
 315 \begin{code}
 316 needsCDecl (IdLabel _ _)                = True
 317 needsCDecl (CaseLabel _ CaseReturnPt)   = True
 318 needsCDecl (DataConLabel _ _)           = True
 319 needsCDecl (TyConLabel _)               = True
 320 needsCDecl (ModuleInitLabel _ _)        = True
 321 needsCDecl (PlainModuleInitLabel _)     = True
 322
 323 needsCDecl (CaseLabel _ _)              = False
 324 needsCDecl (AsmTempLabel _)             = False
 325 needsCDecl (RtsLabel _)                 = False
 326 needsCDecl (ForeignLabel _ _)           = False
 327 needsCDecl (CC_Label _)                 = False
 328 needsCDecl (CCS_Label _)                = False
 329 \end{code}
 330
 331 Whether the label is an assembler temporary:
 332
 333 \begin{code}
 334 isAsmTemp (AsmTempLabel _) = True
 335 isAsmTemp _                = False
 336 \end{code}
 337
 338 C ``static'' or not...
 339 From the point of view of the code generator, a name is
 340 externally visible if it has to be declared as exported
 341 in the .o file's symbol table; that is, made non-static.
 342
 343 \begin{code}
 344 externallyVisibleCLabel (DataConLabel _ _) = True
 345 externallyVisibleCLabel (TyConLabel tc)    = True
 346 externallyVisibleCLabel (CaseLabel _ _)    = False
 347 externallyVisibleCLabel (AsmTempLabel _)   = False
 348 externallyVisibleCLabel (ModuleInitLabel _ _)= True
 349 externallyVisibleCLabel (PlainModuleInitLabel _)= True
 350 externallyVisibleCLabel (RtsLabel RtsModuleRegd) = False --hack
 351 externallyVisibleCLabel (RtsLabel _)       = True
 352 externallyVisibleCLabel (ForeignLabel _ _) = True
 353 externallyVisibleCLabel (IdLabel id _)     = isExternalName id
 354 externallyVisibleCLabel (CC_Label _)       = False -- not strictly true
 355 externallyVisibleCLabel (CCS_Label _)      = False -- not strictly true
 356 \end{code}
 357
 358 For generating correct types in label declarations...
 359
 360 \begin{code}
 361 labelType :: CLabel -> CLabelType
 362 labelType (RtsLabel (RtsBlackHoleInfoTbl _))  = InfoTblType
 363 labelType (RtsLabel (RtsSelectorInfoTbl _ _)) = InfoTblType
 364 labelType (RtsLabel (RtsApInfoTbl _ _))       = InfoTblType
 365 labelType (RtsLabel RtsUpdInfo)               = InfoTblType
 366 labelType (RtsLabel (Rts_Info _))             = InfoTblType
 367 labelType (CaseLabel _ CaseReturnInfo)        = InfoTblType
 368 labelType (CaseLabel _ CaseReturnPt)          = CodeType
 369 labelType (CaseLabel _ CaseVecTbl)            = VecTblType
 370 labelType (TyConLabel _)                      = ClosureTblType
 371 labelType (ModuleInitLabel _ _)               = CodeType
 372 labelType (PlainModuleInitLabel _)            = CodeType
 373
 374 labelType (IdLabel _ info) =
 375   case info of
 376     InfoTbl       -> InfoTblType
 377     Closure       -> ClosureType
 378     _             -> CodeType
 379
 380 labelType (DataConLabel _ info) =
 381   case info of
 382      ConInfoTbl    -> InfoTblType
 383      StaticInfoTbl -> InfoTblType
 384      _             -> CodeType
 385
 386 labelType _        = DataType
 387 \end{code}
 388
 389 When referring to data in code, we need to know whether
 390 that data resides in a DLL or not. [Win32 only.]
 391 @labelDynamic@ returns @True@ if the label is located
 392 in a DLL, be it a data reference or not.
 393
 394 \begin{code}
 395 labelDynamic :: CLabel -> Bool
 396 labelDynamic lbl =
 397   case lbl of
 398    -- The special case for RtsShouldNeverHappenCode is because the associated address is
 399    -- NULL, i.e. not a DLL entry point
 400    RtsLabel RtsShouldNeverHappenCode -> False
 401    RtsLabel _        -> not opt_Static  -- i.e., is the RTS in a DLL or not?
 402    IdLabel n k       -> isDllName n
 403    DataConLabel n k  -> isDllName n
 404    TyConLabel tc     -> isDllName (getName tc)
 405    ForeignLabel _ d  -> d
 406    ModuleInitLabel m _  -> (not opt_Static) && (not (isHomeModule m))
 407    PlainModuleInitLabel m -> (not opt_Static) && (not (isHomeModule m))
 408    _                 -> False
 409 \end{code}
 410
 411
 412 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
 413 right places. It is used to detect when the abstractC statement of an
 414 CCodeBlock actually contains the code for a slow entry point.  -- HWL
 415
 416 We need at least @Eq@ for @CLabels@, because we want to avoid
 417 duplicate declarations in generating C (see @labelSeenTE@ in
 418 @PprAbsC@).
 419
 420 -----------------------------------------------------------------------------
 421 Printing out CLabels.
 422
 423 Convention:
 424
 425       <name>_<type>
 426
 427 where <name> is <Module>_<name> for external names and <unique> for
 428 internal names. <type> is one of the following:
 429
 430          info                   Info table
 431          srt                    Static reference table
 432          entry                  Entry code
 433          ret                    Direct return address
 434          vtbl                   Vector table
 435          <n>_alt                Case alternative (tag n)
 436          dflt                   Default case alternative
 437          btm                    Large bitmap vector
 438          closure                Static closure
 439          con_entry              Dynamic Constructor entry code
 440          con_info               Dynamic Constructor info table
 441          static_entry           Static Constructor entry code
 442          static_info            Static Constructor info table
 443          sel_info               Selector info table
 444          sel_entry              Selector entry code
 445          cc                     Cost centre
 446          ccs                    Cost centre stack
 447
 448 \begin{code}
 449 pprCLabel :: CLabel -> SDoc
 450
 451 #if ! OMIT_NATIVE_CODEGEN
 452 pprCLabel (AsmTempLabel u)
 453   = text (fmtAsmLbl (show u))
 454 #endif
 455
 456 pprCLabel lbl =
 457 #if ! OMIT_NATIVE_CODEGEN
 458     getPprStyle $ \ sty ->
 459     if asmStyle sty && underscorePrefix then
 460        pp_cSEP <> pprCLbl lbl
 461     else
 462 #endif
 463        pprCLbl lbl
 464
 465 pprCLbl (CaseLabel u CaseReturnPt)
 466   = hcat [pprUnique u, pp_cSEP, ptext SLIT("ret")]
 467 pprCLbl (CaseLabel u CaseReturnInfo)
 468   = hcat [pprUnique u, pp_cSEP, ptext SLIT("info")]
 469 pprCLbl (CaseLabel u CaseVecTbl)
 470   = hcat [pprUnique u, pp_cSEP, ptext SLIT("vtbl")]
 471 pprCLbl (CaseLabel u (CaseAlt tag))
 472   = hcat [pprUnique u, pp_cSEP, int tag, pp_cSEP, ptext SLIT("alt")]
 473 pprCLbl (CaseLabel u CaseDefault)
 474   = hcat [pprUnique u, pp_cSEP, ptext SLIT("dflt")]
 475 pprCLbl (CaseLabel u CaseBitmap)
 476   = hcat [pprUnique u, pp_cSEP, ptext SLIT("btm")]
 477
 478 pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("NULL")
 479 -- used to be stg_error_entry but Windows can't have DLL entry points as static
 480 -- initialisers, and besides, this ShouldNeverHappen, right?
 481
 482 pprCLbl (RtsLabel RtsUpdInfo)            = ptext SLIT("stg_upd_frame_info")
 483 pprCLbl (RtsLabel RtsSeqInfo)            = ptext SLIT("stg_seq_frame_info")
 484 pprCLbl (RtsLabel RtsMainCapability)     = ptext SLIT("MainCapability")
 485 pprCLbl (RtsLabel (RtsGCEntryLabel str)) = text str
 486 pprCLbl (RtsLabel (Rts_Closure str))     = text str
 487 pprCLbl (RtsLabel (Rts_Info str))        = text str
 488 pprCLbl (RtsLabel (Rts_Code str))        = text str
 489
 490 pprCLbl (RtsLabel RtsTopTickyCtr) = ptext SLIT("top_ct")
 491
 492 pprCLbl (RtsLabel (RtsBlackHoleInfoTbl info)) = ftext info
 493
 494 pprCLbl (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
 495   = hcat [ptext SLIT("stg_sel_"), text (show offset),
 496                 ptext (if upd_reqd
 497                         then SLIT("_upd_info")
 498                         else SLIT("_noupd_info"))
 499         ]
 500
 501 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
 502   = hcat [ptext SLIT("stg_sel_"), text (show offset),
 503                 ptext (if upd_reqd
 504                         then SLIT("_upd_entry")
 505                         else SLIT("_noupd_entry"))
 506         ]
 507
 508 pprCLbl (RtsLabel (RtsApInfoTbl upd_reqd arity))
 509   = hcat [ptext SLIT("stg_ap_"), text (show arity),
 510                 ptext (if upd_reqd
 511                         then SLIT("_upd_info")
 512                         else SLIT("_noupd_info"))
 513         ]
 514
 515 pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
 516   = hcat [ptext SLIT("stg_ap_"), text (show arity),
 517                 ptext (if upd_reqd
 518                         then SLIT("_upd_entry")
 519                         else SLIT("_noupd_entry"))
 520         ]
 521
 522 pprCLbl (RtsLabel (RtsPrimOp primop))
 523   = ppr primop <> ptext SLIT("_fast")
 524
 525 pprCLbl (RtsLabel RtsModuleRegd)
 526   = ptext SLIT("module_registered")
 527
 528 pprCLbl (ForeignLabel str _)
 529   = ftext str
 530
 531 pprCLbl (TyConLabel tc)
 532   = hcat [ppr tc, pp_cSEP, ptext SLIT("closure_tbl")]
 533
 534 pprCLbl (IdLabel      id  flavor) = ppr id <> ppIdFlavor flavor
 535 pprCLbl (DataConLabel con flavor) = ppr con <> ppConFlavor flavor
 536
 537 pprCLbl (CC_Label cc)           = ppr cc
 538 pprCLbl (CCS_Label ccs)         = ppr ccs
 539
 540 pprCLbl (ModuleInitLabel mod way)
 541    = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
 542         <> char '_' <> text way
 543
 544 pprCLbl (PlainModuleInitLabel mod)
 545    = ptext SLIT("__stginit_") <> ftext (moduleNameFS (moduleName mod))
 546
 547 ppIdFlavor :: IdLabelInfo -> SDoc
 548
 549 ppIdFlavor x = pp_cSEP <>
 550                (case x of
 551                        Closure          -> ptext SLIT("closure")
 552                        SRT              -> ptext SLIT("srt")
 553                        InfoTbl          -> ptext SLIT("info")
 554                        EntryStd         -> ptext SLIT("entry")
 555                        EntryFast arity  -> --false:ASSERT (arity > 0)
 556                                            (<>) (ptext SLIT("fast")) (int arity)
 557                        RednCounts       -> ptext SLIT("ct")
 558                       )
 559
 560 ppConFlavor x = pp_cSEP <>
 561                 (case x of
 562                        ConEntry         -> ptext SLIT("con_entry")
 563                        ConInfoTbl       -> ptext SLIT("con_info")
 564                        StaticConEntry   -> ptext SLIT("static_entry")
 565                        StaticInfoTbl    -> ptext SLIT("static_info")
 566                 )
 567 \end{code}
 568