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