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