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             ( isLexVarSym, isPreludeDefined, origName, moduleOf,
  42                           Name{-instance Outputable-}
  43                         )
  44 import Outputable       ( ifPprShowAll, interpp'SP )
  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   | length arg_tys == 2
 177   = (if length arg_tys /= 2 then pprTrace "ppr_corner:" (ppCat (map (ppr_ty sty env ctxt_prec) arg_tys)) else id) $
 178     ASSERT(length arg_tys == 2)
 179     ppr_ty sty env ctxt_prec (FunTy ty1 ty2 usage)
 180   where
 181     (ty1:ty2:_) = arg_tys
 182
 183 ppr_corner sty env ctxt_prec (TyConTy (TupleTyCon _ _ a) usage) arg_tys
 184   = --ASSERT(length arg_tys == a)
 185     (if (length arg_tys /= a) then pprTrace "ppr_corner:" (ppCat [ppInt a, ppInterleave ppComma (map (pprGenType PprDebug) arg_tys)]) else id) $
 186     ppBesides [ppLparen, arg_tys_w_commas, ppRparen]
 187   where
 188     arg_tys_w_commas = ppIntersperse pp'SP (map (ppr_ty sty env tOP_PREC) arg_tys)
 189
 190 ppr_corner sty env ctxt_prec (TyConTy tycon usage) arg_tys
 191   | tycon == listTyCon
 192   = ASSERT(length arg_tys == 1)
 193     ppBesides [ppLbrack, ppr_ty sty env tOP_PREC ty1, ppRbrack]
 194   where
 195     (ty1:_) = arg_tys
 196
 197 ppr_corner sty env ctxt_prec (TyConTy tycon usage) arg_tys
 198   = ppr_app sty env ctxt_prec (ppr sty tycon) arg_tys
 199
 200 ppr_corner sty env ctxt_prec (TyVarTy tyvar) arg_tys
 201   = ppr_app sty env ctxt_prec (ppr_tyvar env tyvar) arg_tys
 202
 203
 204 ppr_app sty env ctxt_prec pp_fun []
 205   = pp_fun
 206 ppr_app sty env ctxt_prec pp_fun arg_tys
 207   = maybeParen ctxt_prec tYCON_PREC (ppCat [pp_fun, arg_tys_w_spaces])
 208   where
 209     arg_tys_w_spaces = ppIntersperse ppSP (map (ppr_ty sty env tYCON_PREC) arg_tys)
 210
 211
 212 ppr_dict sty env ctxt_prec (clas, ty)
 213   = maybeParen ctxt_prec tYCON_PREC
 214         (ppCat [ppr sty clas, ppr_ty sty env tYCON_PREC ty])
 215 \end{code}
 216
 217 Nota Bene: we must assign print-names to the forall'd type variables
 218 alphabetically, with the first forall'd variable having the alphabetically
 219 first name.  Reason: so anyone reading the type signature printed without
 220 explicit forall's will be able to reconstruct them in the right order.
 221
 222 \begin{code}
 223 -- Entirely local to this module
 224 data VarEnv tyvar uvar
 225   = VE  [Pretty]                -- Tyvar pretty names
 226         (tyvar -> Pretty)       -- Tyvar lookup function
 227         [Pretty]                -- Uvar  pretty names
 228         (uvar -> Pretty)        -- Uvar  lookup function
 229
 230 initial_ve PprForC = VE [] (\tv -> ppChar '*')
 231                         [] (\tv -> ppChar '#')
 232
 233 initial_ve sty = VE tv_pretties (ppr sty)
 234                     uv_pretties (ppr sty)
 235   where
 236     tv_pretties = map (\ c -> ppChar c ) ['a' .. 'h']
 237                   ++
 238                   map (\ n -> ppBeside (ppChar 'a') (ppInt n))
 239                       ([0 .. ] :: [Int])        -- a0 ... aN
 240
 241     uv_pretties = map (\ c -> ppChar c ) ['u' .. 'y']
 242                   ++
 243                   map (\ n -> ppBeside (ppChar 'u') (ppInt n))
 244                       ([0 .. ] :: [Int])        -- u0 ... uN
 245
 246
 247 ppr_tyvar (VE _ ppr _ _) tyvar = ppr tyvar
 248 ppr_uvar  (VE _ _ _ ppr) uvar  = ppr uvar
 249
 250 add_tyvar ve@(VE [] _ _ _) tyvar = ve
 251 add_tyvar (VE (tv_pp:tv_supply') tv_ppr uv_supply uv_ppr) tyvar
 252   = VE tv_supply' tv_ppr' uv_supply uv_ppr
 253   where
 254     tv_ppr' tv | tv==tyvar = tv_pp
 255                | otherwise = tv_ppr tv
 256
 257 add_uvar ve@(VE _ _ [] _) uvar = ve
 258 add_uvar (VE tv_supply tv_ppr (uv_pp:uv_supply') uv_ppr) uvar
 259   = VE tv_supply tv_ppr uv_supply' uv_ppr'
 260   where
 261     uv_ppr' uv | uv==uvar = uv_pp
 262                | otherwise = uv_ppr uv
 263 \end{code}
 264
 265 @ppr_ty@ takes an @Int@ that is the precedence of the context.
 266 The precedence levels are:
 267 \begin{description}
 268 \item[0:] What we start with.
 269 \item[1:] Function application (@FunTys@).
 270 \item[2:] Type constructors.
 271 \end{description}
 272
 273
 274 \begin{code}
 275 tOP_PREC    = (0 :: Int)
 276 fUN_PREC    = (1 :: Int)
 277 tYCON_PREC  = (2 :: Int)
 278
 279 maybeParen ctxt_prec inner_prec pretty
 280   | ctxt_prec < inner_prec = pretty
 281   | otherwise              = ppParens pretty
 282 \end{code}
 283
 284 %************************************************************************
 285 %*                                                                      *
 286 \subsection[TyVar]{@TyVar@}
 287 %*                                                                      *
 288 %************************************************************************
 289
 290 \begin{code}
 291 pprGenTyVar sty (TyVar uniq kind name usage)
 292   = ppBesides [pp_name, pprUnique10 uniq]
 293   where
 294     pp_name = case name of
 295                 Just n  -> ppr sty n
 296                 Nothing -> case kind of
 297                                 TypeKind        -> ppChar 'o'
 298                                 BoxedTypeKind   -> ppChar 't'
 299                                 UnboxedTypeKind -> ppChar 'u'
 300                                 ArrowKind _ _   -> ppChar 'a'
 301 \end{code}
 302
 303 %************************************************************************
 304 %*                                                                      *
 305 \subsection[TyCon]{@TyCon@}
 306 %*                                                                      *
 307 %************************************************************************
 308
 309 ToDo; all this is suspiciously like getOccName!
 310
 311 \begin{code}
 312 showTyCon :: PprStyle -> TyCon -> String
 313 showTyCon sty tycon = ppShow 80 (pprTyCon sty tycon)
 314
 315 pprTyCon :: PprStyle -> TyCon -> Pretty
 316
 317 pprTyCon sty FunTyCon                   = ppStr "(->)"
 318 pprTyCon sty (TupleTyCon _ name _)      = ppr sty name
 319 pprTyCon sty (PrimTyCon uniq name kind) = ppr sty name
 320
 321 pprTyCon sty tycon@(DataTyCon uniq name kind tyvars ctxt cons derivings nd)
 322   = ppr sty name
 323
 324 pprTyCon sty (SpecTyCon tc ty_maybes)
 325   = ppBeside (pprTyCon sty tc)
 326              (if (codeStyle sty)
 327               then identToC tys_stuff
 328               else ppPStr   tys_stuff)
 329   where
 330     tys_stuff = specMaybeTysSuffix ty_maybes
 331
 332 pprTyCon sty (SynTyCon uniq name kind arity tyvars expansion)
 333   = ppBeside (ppr sty name)
 334              (ifPprShowAll sty
 335                 (ppCat [ ppStr " {-",
 336                          ppInt arity,
 337                          interpp'SP sty tyvars,
 338                          pprParendGenType sty expansion,
 339                          ppStr "-}"]))
 340 \end{code}
 341
 342
 343 %************************************************************************
 344 %*                                                                      *
 345 \subsection[Class]{@Class@}
 346 %*                                                                      *
 347 %************************************************************************
 348
 349 \begin{code}
 350 pprGenClassOp :: Outputable ty => PprStyle -> GenClassOp ty -> Pretty
 351
 352 pprGenClassOp sty op = ppr_class_op sty [] op
 353
 354 ppr_class_op sty tyvars (ClassOp op_name i ty)
 355   = case sty of
 356       PprForC       -> pp_C
 357       PprForAsm _ _ -> pp_C
 358       PprInterface  -> ppCat [pp_user, ppPStr SLIT("::"), ppr sty ty]
 359       PprShowAll    -> ppCat [pp_user, ppPStr SLIT("::"), ppr sty ty]
 360       _             -> pp_user
 361   where
 362     pp_C    = ppPStr op_name
 363     pp_user = if isLexVarSym op_name
 364               then ppBesides [ppLparen, pp_C, ppRparen]
 365               else pp_C
 366 \end{code}
 367
 368
 369 %************************************************************************
 370 %*                                                                      *
 371 \subsection[]{Mumbo jumbo}
 372 %*                                                                      *
 373 %************************************************************************
 374
 375 \begin{code}
 376     -- Shallowly magical; converts a type into something
 377     -- vaguely close to what can be used in C identifier.
 378     -- Don't forget to include the module name!!!
 379 getTypeString :: Type -> [FAST_STRING]
 380 getTypeString ty
 381   | is_prelude_ty = [string]
 382   | otherwise     = [mod, string]
 383   where
 384     string = _PK_ (tidy (ppShow 1000 ppr_t))
 385     ppr_t  = pprGenType PprForC ty
 386                         -- PprForC expands type synonyms as it goes
 387
 388     (is_prelude_ty, mod)
 389       = case (maybeAppTyCon ty) of
 390           Nothing -> true_bottom
 391           Just (tycon,_) ->
 392             if isPreludeDefined tycon
 393             then true_bottom
 394             else (False, moduleOf (origName tycon))
 395
 396     true_bottom = (True, panic "getTypeString")
 397
 398     --------------------------------------------------
 399     -- tidy: very ad-hoc
 400     tidy [] = [] -- done
 401
 402     tidy (' ' : more)
 403       = case more of
 404           ' ' : _        -> tidy more
 405           '-' : '>' : xs -> '-' : '>' : tidy (no_leading_sps xs)
 406           other          -> ' ' : tidy more
 407
 408     tidy (',' : more) = ',' : tidy (no_leading_sps more)
 409
 410     tidy (x : xs) = x : tidy xs  -- catch all
 411
 412     no_leading_sps [] = []
 413     no_leading_sps (' ':xs) = no_leading_sps xs
 414     no_leading_sps other = other
 415
 416 typeMaybeString :: Maybe Type -> [FAST_STRING]
 417 typeMaybeString Nothing  = [SLIT("!")]
 418 typeMaybeString (Just t) = getTypeString t
 419
 420 specMaybeTysSuffix :: [Maybe Type] -> FAST_STRING
 421 specMaybeTysSuffix ty_maybes
 422   = let
 423         ty_strs  = concat (map typeMaybeString ty_maybes)
 424         dotted_tys = [ _CONS_ '.' str | str <- ty_strs ]
 425     in
 426     _CONCAT_ dotted_tys
 427 \end{code}
 428
 429 ========================================================
 430         INTERFACE STUFF; move it out
 431
 432
 433 \begin{pseudocode}
 434 pprTyCon sty@PprInterface (SynonymTyCon k n a vs exp unabstract) specs
 435   = ASSERT (null specs)
 436     let
 437         lookup_fn   = mk_lookup_tyvar_fn sty vs
 438         pp_tyvars   = map lookup_fn vs
 439     in
 440     ppCat [ppPStr SLIT("type"), ppr sty n, ppIntersperse ppSP pp_tyvars,
 441            ppEquals, ppr_ty sty lookup_fn tOP_PREC exp]
 442
 443 pprTyCon sty@PprInterface this_tycon@(DataTyCon u n k vs ctxt cons derivings data_or_new) specs
 444   = ppHang (ppCat [pp_data_or_new,
 445                    pprContext sty ctxt,
 446                    ppr sty n,
 447                    ppIntersperse ppSP (map lookup_fn vs)])
 448            4
 449            (ppCat [pp_unabstract_condecls,
 450                    pp_pragma])
 451            -- NB: we do not print deriving info in interfaces
 452   where
 453     lookup_fn = mk_lookup_tyvar_fn sty vs
 454
 455     pp_data_or_new = case data_or_new of
 456                       DataType -> ppPStr SLIT("data")
 457                       NewType  -> ppPStr SLIT("newtype")
 458
 459     yes_we_print_condecls
 460       = unabstract
 461         && not (null cons)      -- we know what they are
 462         && (case (getExportFlag n) of
 463               ExportAbs -> False
 464               other     -> True)
 465
 466     yes_we_print_pragma_condecls
 467       = not yes_we_print_condecls
 468         && not opt_OmitInterfacePragmas
 469         && not (null cons)
 470         && not (maybeToBool (maybePurelyLocalTyCon this_tycon))
 471         {- && not (any (dataConMentionsNonPreludeTyCon this_tycon) cons) -}
 472
 473     yes_we_print_pragma_specs
 474       = not (null specs)
 475
 476     pp_unabstract_condecls
 477       = if yes_we_print_condecls
 478         then ppCat [ppSP, ppEquals, pp_condecls]
 479         else ppNil
 480
 481     pp_pragma_condecls
 482       = if yes_we_print_pragma_condecls
 483         then pp_condecls
 484         else ppNil
 485
 486     pp_pragma_specs
 487       = if yes_we_print_pragma_specs
 488         then pp_specs
 489         else ppNil
 490
 491     pp_pragma
 492       = if (yes_we_print_pragma_condecls || yes_we_print_pragma_specs)
 493         then ppCat [ppStr "\t{-# GHC_PRAGMA", pp_pragma_condecls, pp_pragma_specs, ppStr "#-}"]
 494         else ppNil
 495
 496     pp_condecls
 497       = let
 498             (c:cs) = cons
 499         in
 500         ppCat ((ppr_con c) : (map ppr_next_con cs))
 501       where
 502         ppr_con con
 503           = let
 504                 (_, _, con_arg_tys, _) = dataConSig con
 505             in
 506             ppCat [pprNonSym PprForUser con, -- the data con's name...
 507                    ppIntersperse ppSP (map (ppr_ty sty lookup_fn tYCON_PREC) con_arg_tys)]
 508
 509         ppr_next_con con = ppCat [ppChar '|', ppr_con con]
 510
 511     pp_specs
 512       = ppBesides [ppPStr SLIT("_SPECIALIZE_ "), pp_the_list [
 513           ppCat [ppLbrack, ppInterleave ppComma (map pp_maybe ty_maybes), ppRbrack]
 514           | ty_maybes <- specs ]]
 515
 516     pp_the_list [p]    = p
 517     pp_the_list (p:ps) = ppAbove (ppBeside p ppComma) (pp_the_list ps)
 518
 519     pp_maybe Nothing   = pp_NONE
 520     pp_maybe (Just ty) = pprParendGenType sty ty
 521
 522     pp_NONE = ppPStr SLIT("_N_")
 523
 524 pprTyCon PprInterface (TupleTyCon _ name _) specs
 525   = ASSERT (null specs)
 526     ppCat [ ppStr "{- ", ppr PprForUser name, ppStr "-}" ]
 527
 528 pprTyCon PprInterface (PrimTyCon k n a kind_fn) specs
 529   = ASSERT (null specs)
 530     ppCat [ ppStr "{- data", ppr PprForUser n, ppStr " *built-in* -}" ]
 531
 532
 533
 534
 535
 536 pprIfaceClass :: (Id -> Id) -> IdEnv UnfoldingDetails -> Class -> Pretty
 537
 538 pprIfaceClass better_id_fn inline_env
 539         (Class k n tyvar super_classes sdsels ops sels defms insts links)
 540   = let
 541         sdsel_infos = map (getIdInfo . better_id_fn) sdsels
 542     in
 543     ppAboves [ ppCat [ppPStr SLIT("class"), ppr_theta tyvar super_classes,
 544                       ppr sty n, lookup_fn tyvar,
 545                       if null sdsel_infos
 546                       || opt_OmitInterfacePragmas
 547                       || (any boringIdInfo sdsel_infos)
 548                         -- ToDo: really should be "all bor..."
 549                         -- but then parsing is more tedious,
 550                         -- and this is really as good in practice.
 551                       then ppNil
 552                       else pp_sdsel_pragmas (sdsels `zip` sdsel_infos),
 553                       if (null ops)
 554                       then ppNil
 555                       else ppPStr SLIT("where")],
 556                ppNest 8  (ppAboves
 557                  [ ppr_op op (better_id_fn sel) (better_id_fn defm)
 558                  | (op,sel,defm) <- zip3 ops sels defms]) ]
 559   where
 560     lookup_fn = mk_lookup_tyvar_fn sty [tyvar]
 561
 562     ppr_theta :: TyVar -> [Class] -> Pretty
 563     ppr_theta tv [] = ppNil
 564     ppr_theta tv super_classes
 565       = ppBesides [ppLparen,
 566                    ppIntersperse pp'SP{-'-} (map ppr_assert super_classes),
 567                    ppStr ") =>"]
 568       where
 569         ppr_assert (Class _ n _ _ _ _ _ _ _ _) = ppCat [ppr sty n, lookup_fn tv]
 570
 571     pp_sdsel_pragmas sdsels_and_infos
 572       = ppCat [ppStr "{-# GHC_PRAGMA {-superdicts-}",
 573                ppIntersperse pp'SP{-'-}
 574                  [ppIdInfo sty sdsel False{-NO specs-} better_id_fn inline_env info
 575                  | (sdsel, info) <- sdsels_and_infos ],
 576                ppStr "#-}"]
 577
 578     ppr_op op opsel_id defm_id
 579       = let
 580             stuff = ppBeside (ppChar '\t') (ppr_class_op sty [tyvar] op)
 581         in
 582         if opt_OmitInterfacePragmas
 583         then stuff
 584         else ppAbove stuff
 585                 (ppCat [ppStr "\t {-# GHC_PRAGMA", ppAbove pp_opsel pp_defm, ppStr "#-}"])
 586       where
 587         pp_opsel = ppCat [ppPStr SLIT("{-meth-}"), ppIdInfo sty opsel_id False{-no specs-} better_id_fn inline_env (getIdInfo opsel_id)]
 588         pp_defm  = ppCat [ppPStr SLIT("\t\t{-defm-}"), ppIdInfo sty defm_id False{-no specs-} better_id_fn inline_env (getIdInfo defm_id)]
 589 \end{pseudocode}