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