ghc/compiler/absCSyn/CLabel.lhs

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