ghc/compiler/types/PprType.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996
   3 %
   4 \section[PprType]{Printing Types, TyVars, Classes, ClassOps, TyCons}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module PprType(
  10         GenTyVar, pprGenTyVar,
  11         TyCon, pprTyCon, showTyCon,
  12         GenType,
  13         pprGenType, pprParendGenType,
  14         pprType, pprParendType,
  15         pprMaybeTy,
  16         getTypeString,
  17         typeMaybeString,
  18         specMaybeTysSuffix,
  19         GenClass,
  20         GenClassOp, pprGenClassOp
  21  ) where
  22
  23 import Ubiq
  24 import IdLoop   -- for paranoia checking
  25 import TyLoop   -- for paranoia checking
  26 import NameLoop -- for paranoia checking
  27
  28 -- friends:
  29 -- (PprType can see all the representations it's trying to print)
  30 import Type             ( GenType(..), maybeAppTyCon,
  31                           splitForAllTy, splitSigmaTy, splitRhoTy, splitAppTy )
  32 import TyVar            ( GenTyVar(..) )
  33 import TyCon            ( TyCon(..), NewOrData )
  34 import Class            ( Class(..), GenClass(..),
  35                           ClassOp(..), GenClassOp(..) )
  36 import Kind             ( Kind(..) )
  37
  38 -- others:
  39 import CStrings         ( identToC )
  40 import CmdLineOpts      ( opt_OmitInterfacePragmas )
  41 import Maybes           ( maybeToBool )
  42 import NameTypes        ( ShortName, FullName )
  43 import Outputable       ( ifPprShowAll, isAvarop, interpp'SP )
  44 import PprStyle         ( PprStyle(..), codeStyle, showUserishTypes )
  45 import Pretty
  46 import TysWiredIn       ( listTyCon )
  47 import Unique           ( pprUnique10, pprUnique )
  48 import Usage            ( UVar(..), pprUVar )
  49 import Util
  50 \end{code}
  51
  52 \begin{code}
  53 instance (Eq tyvar, Outputable tyvar,
  54           Eq uvar,  Outputable uvar  ) => Outputable (GenType tyvar uvar) where
  55     ppr sty ty = pprGenType sty ty
  56
  57 instance Outputable TyCon where
  58     ppr sty tycon = pprTyCon sty tycon
  59
  60 instance Outputable (GenClass tyvar uvar) where
  61     -- we use pprIfaceClass for printing in interfaces
  62     ppr sty (Class u n _ _ _ _ _ _ _ _) = ppr sty n
  63
  64 instance Outputable ty => Outputable (GenClassOp ty) where
  65     ppr sty clsop = pprGenClassOp sty clsop
  66
  67 instance Outputable (GenTyVar flexi) where
  68     ppr sty tv = pprGenTyVar sty tv
  69
  70 -- and two SPECIALIZEd ones:
  71 instance Outputable {-Type, i.e.:-}(GenType TyVar UVar) where
  72     ppr sty ty = pprGenType sty ty
  73
  74 instance Outputable {-TyVar, i.e.:-}(GenTyVar Usage) where
  75     ppr sty ty = pprGenTyVar sty ty
  76 \end{code}
  77
  78 %************************************************************************
  79 %*                                                                      *
  80 \subsection[Type]{@Type@}
  81 %*                                                                      *
  82 %************************************************************************
  83
  84 @pprGenType@ is the std @Type@ printer; the overloaded @ppr@ function is
  85 defined to use this.  @pprParendGenType@ is the same, except it puts
  86 parens around the type, except for the atomic cases.  @pprParendGenType@
  87 works just by setting the initial context precedence very high.
  88
  89 \begin{code}
  90 pprGenType, pprParendGenType :: (Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
  91                        => PprStyle -> GenType tyvar uvar -> Pretty
  92
  93 pprGenType       sty ty = ppr_ty sty (initial_ve sty) tOP_PREC   ty
  94 pprParendGenType sty ty = ppr_ty sty (initial_ve sty) tYCON_PREC ty
  95
  96 pprType          sty ty = ppr_ty sty (initial_ve sty) tOP_PREC   (ty :: Type)
  97 pprParendType    sty ty = ppr_ty sty (initial_ve sty) tYCON_PREC (ty :: Type)
  98
  99 pprMaybeTy :: (Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 100            => PprStyle -> Maybe (GenType tyvar uvar) -> Pretty
 101 pprMaybeTy sty Nothing   = ppChar '*'
 102 pprMaybeTy sty (Just ty) = pprParendGenType sty ty
 103 \end{code}
 104
 105 \begin{code}
 106 ppr_ty :: (Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 107        => PprStyle -> VarEnv tyvar uvar -> Int
 108        -> GenType tyvar uvar
 109        -> Pretty
 110
 111 ppr_ty sty env ctxt_prec (TyVarTy tyvar)
 112   = ppr_tyvar env tyvar
 113
 114 ppr_ty sty env ctxt_prec (TyConTy tycon usage)
 115   = ppr sty tycon
 116
 117 ppr_ty sty env ctxt_prec ty@(ForAllTy _ _)
 118   | showUserishTypes sty = ppr_ty sty env' ctxt_prec body_ty
 119
 120   | otherwise = ppSep [ ppPStr SLIT("_forall_"),
 121                         ppIntersperse pp'SP pp_tyvars,
 122                         ppPStr SLIT("=>"),
 123                         ppr_ty sty env' ctxt_prec body_ty
 124                       ]
 125   where
 126     (tyvars, body_ty) = splitForAllTy ty
 127     env'              = foldl add_tyvar env tyvars
 128     pp_tyvars         = map (ppr_tyvar env') tyvars
 129
 130 ppr_ty sty env ctxt_prec (ForAllUsageTy uv uvs ty)
 131   = panic "ppr_ty:ForAllUsageTy"
 132
 133 ppr_ty sty env ctxt_prec ty@(FunTy (DictTy _ _ _) _ _)
 134   | showUserishTypes sty
 135     -- Print a nice looking context  (Eq a, Text b) => ...
 136   = ppSep [ppBesides [ppLparen,
 137                       ppIntersperse pp'SP (map (ppr_dict sty env tOP_PREC) theta),
 138                       ppRparen],
 139            ppPStr SLIT("=>"),
 140            ppr_ty sty env ctxt_prec body_ty
 141     ]
 142   where
 143     (theta, body_ty) = splitRhoTy ty
 144
 145 ppr_ty sty env ctxt_prec (FunTy ty1 ty2 usage)
 146     -- We fiddle the precedences passed to left/right branches,
 147     -- so that right associativity comes out nicely...
 148   = maybeParen ctxt_prec fUN_PREC
 149         (ppCat [ppr_ty sty env fUN_PREC ty1,
 150                 ppPStr SLIT("->"),
 151                 ppr_ty sty env tOP_PREC ty2])
 152
 153 ppr_ty sty env ctxt_prec ty@(AppTy _ _)
 154   = ppr_corner sty env ctxt_prec fun_ty arg_tys
 155   where
 156     (fun_ty, arg_tys) = splitAppTy ty
 157
 158 ppr_ty PprInterface env ctxt_prec (SynTy tycon tys expansion)
 159   -- always expand types in an interface
 160   = ppr_ty PprInterface env ctxt_prec expansion
 161
 162 ppr_ty sty env ctxt_prec (SynTy tycon tys expansion)
 163   = ppBeside
 164      (ppr_app sty env ctxt_prec (ppr sty tycon) tys)
 165      (ifPprShowAll sty (ppCat [ppStr " {- expansion:",
 166                                ppr_ty sty env tOP_PREC expansion,
 167                                ppStr "-}"]))
 168
 169 ppr_ty sty env ctxt_prec (DictTy clas ty usage)
 170   = ppr_dict sty env ctxt_prec (clas, ty)
 171
 172
 173 -- Some help functions
 174 ppr_corner sty env ctxt_prec (TyConTy FunTyCon usage) arg_tys
 175   = ASSERT(length arg_tys == 2)
 176     ppr_ty sty env ctxt_prec (FunTy ty1 ty2 usage)
 177   where
 178     (ty1:ty2:_) = arg_tys
 179
 180 ppr_corner sty env ctxt_prec (TyConTy (TupleTyCon a) usage) arg_tys
 181   = ASSERT(length arg_tys == a)
 182     ppBesides [ppLparen, arg_tys_w_commas, ppRparen]
 183   where
 184     arg_tys_w_commas = ppIntersperse pp'SP (map (ppr_ty sty env tOP_PREC) arg_tys)
 185
 186 ppr_corner sty env ctxt_prec (TyConTy tycon usage) arg_tys
 187   | tycon == listTyCon
 188   = ASSERT(length arg_tys == 1)
 189     ppBesides [ppLbrack, ppr_ty sty env tOP_PREC ty1, ppRbrack]
 190   where
 191     (ty1:_) = arg_tys
 192
 193 ppr_corner sty env ctxt_prec (TyConTy tycon usage) arg_tys
 194   = ppr_app sty env ctxt_prec (ppr sty tycon) arg_tys
 195
 196 ppr_corner sty env ctxt_prec (TyVarTy tyvar) arg_tys
 197   = ppr_app sty env ctxt_prec (ppr_tyvar env tyvar) arg_tys
 198
 199
 200 ppr_app sty env ctxt_prec pp_fun []
 201   = pp_fun
 202 ppr_app sty env ctxt_prec pp_fun arg_tys
 203   = maybeParen ctxt_prec tYCON_PREC (ppCat [pp_fun, arg_tys_w_spaces])
 204   where
 205     arg_tys_w_spaces = ppIntersperse ppSP (map (ppr_ty sty env tYCON_PREC) arg_tys)
 206
 207
 208 ppr_dict sty env ctxt_prec (clas, ty)
 209   = maybeParen ctxt_prec tYCON_PREC
 210         (ppCat [ppr sty clas, ppr_ty sty env tYCON_PREC ty])
 211 \end{code}
 212
 213 Nota Bene: we must assign print-names to the forall'd type variables
 214 alphabetically, with the first forall'd variable having the alphabetically
 215 first name.  Reason: so anyone reading the type signature printed without
 216 explicit forall's will be able to reconstruct them in the right order.
 217
 218 \begin{code}
 219 -- Entirely local to this module
 220 data VarEnv tyvar uvar
 221   = VE  [Pretty]                -- Tyvar pretty names
 222         (tyvar -> Pretty)       -- Tyvar lookup function
 223         [Pretty]                -- Uvar  pretty names
 224         (uvar -> Pretty)        -- Uvar  lookup function
 225
 226 initial_ve PprForC = VE [] (\tv -> ppChar '*')
 227                         [] (\tv -> ppChar '#')
 228
 229 initial_ve sty = VE tv_pretties (ppr sty)
 230                     uv_pretties (ppr sty)
 231   where
 232     tv_pretties = map (\ c -> ppChar c ) ['a' .. 'h']
 233                   ++
 234                   map (\ n -> ppBeside (ppChar 'a') (ppInt n))
 235                       ([0 .. ] :: [Int])        -- a0 ... aN
 236
 237     uv_pretties = map (\ c -> ppChar c ) ['u' .. 'y']
 238                   ++
 239                   map (\ n -> ppBeside (ppChar 'u') (ppInt n))
 240                       ([0 .. ] :: [Int])        -- u0 ... uN
 241
 242
 243 ppr_tyvar (VE _ ppr _ _) tyvar = ppr tyvar
 244 ppr_uvar  (VE _ _ _ ppr) uvar  = ppr uvar
 245
 246 add_tyvar ve@(VE [] _ _ _) tyvar = ve
 247 add_tyvar (VE (tv_pp:tv_supply') tv_ppr uv_supply uv_ppr) tyvar
 248   = VE tv_supply' tv_ppr' uv_supply uv_ppr
 249   where
 250     tv_ppr' tv | tv==tyvar = tv_pp
 251                | otherwise = tv_ppr tv
 252
 253 add_uvar ve@(VE _ _ [] _) uvar = ve
 254 add_uvar (VE tv_supply tv_ppr (uv_pp:uv_supply') uv_ppr) uvar
 255   = VE tv_supply tv_ppr uv_supply' uv_ppr'
 256   where
 257     uv_ppr' uv | uv==uvar = uv_pp
 258                | otherwise = uv_ppr uv
 259 \end{code}
 260
 261 @ppr_ty@ takes an @Int@ that is the precedence of the context.
 262 The precedence levels are:
 263 \begin{description}
 264 \item[0:] What we start with.
 265 \item[1:] Function application (@FunTys@).
 266 \item[2:] Type constructors.
 267 \end{description}
 268
 269
 270 \begin{code}
 271 tOP_PREC    = (0 :: Int)
 272 fUN_PREC    = (1 :: Int)
 273 tYCON_PREC  = (2 :: Int)
 274
 275 maybeParen ctxt_prec inner_prec pretty
 276   | ctxt_prec < inner_prec = pretty
 277   | otherwise              = ppParens pretty
 278 \end{code}
 279
 280 %************************************************************************
 281 %*                                                                      *
 282 \subsection[TyVar]{@TyVar@}
 283 %*                                                                      *
 284 %************************************************************************
 285
 286 \begin{code}
 287 pprGenTyVar sty (TyVar uniq kind name usage)
 288   = ppBesides [pp_name, pprUnique10 uniq]
 289   where
 290     pp_name = case name of
 291                 Just n  -> ppr sty n
 292                 Nothing -> case kind of
 293                                 TypeKind        -> ppChar 'o'
 294                                 BoxedTypeKind   -> ppChar 't'
 295                                 UnboxedTypeKind -> ppChar 'u'
 296                                 ArrowKind _ _   -> ppChar 'a'
 297 \end{code}
 298
 299 %************************************************************************
 300 %*                                                                      *
 301 \subsection[TyCon]{@TyCon@}
 302 %*                                                                      *
 303 %************************************************************************
 304
 305 ToDo; all this is suspiciously like getOccurrenceName!
 306
 307 \begin{code}
 308 showTyCon :: PprStyle -> TyCon -> String
 309 showTyCon sty tycon = ppShow 80 (pprTyCon sty tycon)
 310
 311 pprTyCon :: PprStyle -> TyCon -> Pretty
 312
 313 pprTyCon sty FunTyCon                   = ppStr "(->)"
 314 pprTyCon sty (TupleTyCon arity)         = ppBeside (ppPStr SLIT("Tuple")) (ppInt arity)
 315 pprTyCon sty (PrimTyCon uniq name kind) = ppr sty name
 316
 317 pprTyCon sty tycon@(DataTyCon uniq kind name tyvars ctxt cons derivings nd)
 318   = case sty of
 319       PprDebug   -> pp_tycon_and_uniq
 320       PprShowAll -> pp_tycon_and_uniq
 321       _          -> pp_tycon
 322   where
 323     pp_tycon_and_uniq = ppBesides [pp_tycon, ppChar '.', pprUnique uniq]
 324     pp_tycon          = ppr sty name
 325
 326 pprTyCon sty (SpecTyCon tc ty_maybes)
 327   = ppBeside (pprTyCon sty tc)
 328              (if (codeStyle sty)
 329               then identToC tys_stuff
 330               else ppPStr   tys_stuff)
 331   where
 332     tys_stuff = specMaybeTysSuffix ty_maybes
 333
 334 pprTyCon sty (SynTyCon uniq name kind arity tyvars expansion)
 335   = ppBeside (ppr sty name)
 336              (ifPprShowAll sty
 337                 (ppCat [ ppStr " {-",
 338                          ppInt arity,
 339                          interpp'SP sty tyvars,
 340                          pprParendGenType sty expansion,
 341                          ppStr "-}"]))
 342 \end{code}
 343
 344
 345 %************************************************************************
 346 %*                                                                      *
 347 \subsection[Class]{@Class@}
 348 %*                                                                      *
 349 %************************************************************************
 350
 351 \begin{code}
 352 pprGenClassOp :: Outputable ty => PprStyle -> GenClassOp ty -> Pretty
 353
 354 pprGenClassOp sty op = ppr_class_op sty [] op
 355
 356 ppr_class_op sty tyvars (ClassOp op_name i ty)
 357   = case sty of
 358       PprForC       -> pp_C
 359       PprForAsm _ _ -> pp_C
 360       PprInterface  -> ppCat [pp_user, ppPStr SLIT("::"), ppr sty ty]
 361       PprShowAll    -> ppCat [pp_user, ppPStr SLIT("::"), ppr sty ty]
 362       _             -> pp_user
 363   where
 364     pp_C    = ppPStr op_name
 365     pp_user = if isAvarop op_name
 366               then ppBesides [ppLparen, pp_C, ppRparen]
 367               else pp_C
 368 \end{code}
 369
 370
 371 %************************************************************************
 372 %*                                                                      *
 373 \subsection[]{Mumbo jumbo}
 374 %*                                                                      *
 375 %************************************************************************
 376
 377 \begin{code}
 378     -- Shallowly magical; converts a type into something
 379     -- vaguely close to what can be used in C identifier.
 380     -- Don't forget to include the module name!!!
 381 getTypeString :: Type -> [FAST_STRING]
 382 getTypeString ty
 383   | is_prelude_ty = [string]
 384   | otherwise     = [mod, string]
 385   where
 386     string = _PK_ (tidy (ppShow 1000 ppr_t))
 387     ppr_t  = pprGenType PprForC ty
 388                         -- PprForC expands type synonyms as it goes
 389
 390     (is_prelude_ty, mod)
 391       = case (maybeAppTyCon ty) of
 392           Nothing -> true_bottom
 393           Just (tycon,_) ->
 394             if fromPreludeCore tycon
 395             then true_bottom
 396             else (False, fst (getOrigName tycon))
 397
 398     true_bottom = (True, panic "getTypeString")
 399
 400     --------------------------------------------------
 401     -- tidy: very ad-hoc
 402     tidy [] = [] -- done
 403
 404     tidy (' ' : more)
 405       = case more of
 406           ' ' : _        -> tidy more
 407           '-' : '>' : xs -> '-' : '>' : tidy (no_leading_sps xs)
 408           other          -> ' ' : tidy more
 409
 410     tidy (',' : more) = ',' : tidy (no_leading_sps more)
 411
 412     tidy (x : xs) = x : tidy xs  -- catch all
 413
 414     no_leading_sps [] = []
 415     no_leading_sps (' ':xs) = no_leading_sps xs
 416     no_leading_sps other = other
 417
 418 typeMaybeString :: Maybe Type -> [FAST_STRING]
 419 typeMaybeString Nothing  = [SLIT("!")]
 420 typeMaybeString (Just t) = getTypeString t
 421
 422 specMaybeTysSuffix :: [Maybe Type] -> FAST_STRING
 423 specMaybeTysSuffix ty_maybes
 424   = let
 425         ty_strs  = concat (map typeMaybeString ty_maybes)
 426         dotted_tys = [ _CONS_ '.' str | str <- ty_strs ]
 427     in
 428     _CONCAT_ dotted_tys
 429 \end{code}
 430
 431 ========================================================
 432         INTERFACE STUFF; move it out
 433
 434
 435 \begin{pseudocode}
 436 pprTyCon sty@PprInterface (SynonymTyCon k n a vs exp unabstract) specs
 437   = ASSERT (null specs)
 438     let
 439         lookup_fn   = mk_lookup_tyvar_fn sty vs
 440         pp_tyvars   = map lookup_fn vs
 441     in
 442     ppCat [ppPStr SLIT("type"), ppr sty n, ppIntersperse ppSP pp_tyvars,
 443            ppEquals, ppr_ty sty lookup_fn tOP_PREC exp]
 444
 445 pprTyCon sty@PprInterface this_tycon@(DataTyCon k n a vs ctxt cons derivings data_or_new) specs
 446   = ppHang (ppCat [pp_data_or_new,
 447                    pprContext sty ctxt,
 448                    ppr sty n,
 449                    ppIntersperse ppSP (map lookup_fn vs)])
 450            4
 451            (ppCat [pp_unabstract_condecls,
 452                    pp_pragma])
 453            -- NB: we do not print deriving info in interfaces
 454   where
 455     lookup_fn = mk_lookup_tyvar_fn sty vs
 456
 457     pp_data_or_new = case data_or_new of
 458                       DataType -> ppPStr SLIT("data")
 459                       NewType  -> ppPStr SLIT("newtype")
 460
 461     yes_we_print_condecls
 462       = unabstract
 463         && not (null cons)      -- we know what they are
 464         && (case (getExportFlag n) of
 465               ExportAbs -> False
 466               other     -> True)
 467
 468     yes_we_print_pragma_condecls
 469       = not yes_we_print_condecls
 470         && not opt_OmitInterfacePragmas
 471         && not (null cons)
 472         && not (maybeToBool (maybePurelyLocalTyCon this_tycon))
 473         {- && not (any (dataConMentionsNonPreludeTyCon this_tycon) cons) -}
 474
 475     yes_we_print_pragma_specs
 476       = not (null specs)
 477
 478     pp_unabstract_condecls
 479       = if yes_we_print_condecls
 480         then ppCat [ppSP, ppEquals, pp_condecls]
 481         else ppNil
 482
 483     pp_pragma_condecls
 484       = if yes_we_print_pragma_condecls
 485         then pp_condecls
 486         else ppNil
 487
 488     pp_pragma_specs
 489       = if yes_we_print_pragma_specs
 490         then pp_specs
 491         else ppNil
 492
 493     pp_pragma
 494       = if (yes_we_print_pragma_condecls || yes_we_print_pragma_specs)
 495         then ppCat [ppStr "\t{-# GHC_PRAGMA", pp_pragma_condecls, pp_pragma_specs, ppStr "#-}"]
 496         else ppNil
 497
 498     pp_condecls
 499       = let
 500             (c:cs) = cons
 501         in
 502         ppCat ((ppr_con c) : (map ppr_next_con cs))
 503       where
 504         ppr_con con
 505           = let
 506                 (_, _, con_arg_tys, _) = dataConSig con
 507             in
 508             ppCat [pprNonOp PprForUser con, -- the data con's name...
 509                    ppIntersperse ppSP (map (ppr_ty sty lookup_fn tYCON_PREC) con_arg_tys)]
 510
 511         ppr_next_con con = ppCat [ppChar '|', ppr_con con]
 512
 513     pp_specs
 514       = ppBesides [ppPStr SLIT("_SPECIALIZE_ "), pp_the_list [
 515           ppCat [ppLbrack, ppInterleave ppComma (map pp_maybe ty_maybes), ppRbrack]
 516           | ty_maybes <- specs ]]
 517
 518     pp_the_list [p]    = p
 519     pp_the_list (p:ps) = ppAbove (ppBeside p ppComma) (pp_the_list ps)
 520
 521     pp_maybe Nothing   = pp_NONE
 522     pp_maybe (Just ty) = pprParendGenType sty ty
 523
 524     pp_NONE = ppPStr SLIT("_N_")
 525
 526 pprTyCon PprInterface (TupleTyCon a) specs
 527   = ASSERT (null specs)
 528     ppCat [ ppStr "{- Tuple", ppInt a, ppStr "-}" ]
 529
 530 pprTyCon PprInterface (PrimTyCon k n a kind_fn) specs
 531   = ASSERT (null specs)
 532     ppCat [ ppStr "{- data", ppr PprForUser n, ppStr " *built-in* -}" ]
 533
 534
 535
 536
 537
 538 pprIfaceClass :: (Id -> Id) -> IdEnv UnfoldingDetails -> Class -> Pretty
 539
 540 pprIfaceClass better_id_fn inline_env
 541         (Class k n tyvar super_classes sdsels ops sels defms insts links)
 542   = let
 543         sdsel_infos = map (getIdInfo . better_id_fn) sdsels
 544     in
 545     ppAboves [ ppCat [ppPStr SLIT("class"), ppr_theta tyvar super_classes,
 546                       ppr sty n, lookup_fn tyvar,
 547                       if null sdsel_infos
 548                       || opt_OmitInterfacePragmas
 549                       || (any boringIdInfo sdsel_infos)
 550                         -- ToDo: really should be "all bor..."
 551                         -- but then parsing is more tedious,
 552                         -- and this is really as good in practice.
 553                       then ppNil
 554                       else pp_sdsel_pragmas (sdsels `zip` sdsel_infos),
 555                       if (null ops)
 556                       then ppNil
 557                       else ppPStr SLIT("where")],
 558                ppNest 8  (ppAboves
 559                  [ ppr_op op (better_id_fn sel) (better_id_fn defm)
 560                  | (op,sel,defm) <- zip3 ops sels defms]) ]
 561   where
 562     lookup_fn = mk_lookup_tyvar_fn sty [tyvar]
 563
 564     ppr_theta :: TyVar -> [Class] -> Pretty
 565     ppr_theta tv [] = ppNil
 566     ppr_theta tv super_classes
 567       = ppBesides [ppLparen,
 568                    ppIntersperse pp'SP{-'-} (map ppr_assert super_classes),
 569                    ppStr ") =>"]
 570       where
 571         ppr_assert (Class _ n _ _ _ _ _ _ _ _) = ppCat [ppr sty n, lookup_fn tv]
 572
 573     pp_sdsel_pragmas sdsels_and_infos
 574       = ppCat [ppStr "{-# GHC_PRAGMA {-superdicts-}",
 575                ppIntersperse pp'SP{-'-}
 576                  [ppIdInfo sty sdsel False{-NO specs-} better_id_fn inline_env info
 577                  | (sdsel, info) <- sdsels_and_infos ],
 578                ppStr "#-}"]
 579
 580     ppr_op op opsel_id defm_id
 581       = let
 582             stuff = ppBeside (ppChar '\t') (ppr_class_op sty [tyvar] op)
 583         in
 584         if opt_OmitInterfacePragmas
 585         then stuff
 586         else ppAbove stuff
 587                 (ppCat [ppStr "\t {-# GHC_PRAGMA", ppAbove pp_opsel pp_defm, ppStr "#-}"])
 588       where
 589         pp_opsel = ppCat [ppPStr SLIT("{-meth-}"), ppIdInfo sty opsel_id False{-no specs-} better_id_fn inline_env (getIdInfo opsel_id)]
 590         pp_defm  = ppCat [ppPStr SLIT("\t\t{-defm-}"), ppIdInfo sty defm_id False{-no specs-} better_id_fn inline_env (getIdInfo defm_id)]
 591 \end{pseudocode}