ghc/compiler/absCSyn/CLabel.lhs

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