compiler/types/TypeRep.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1998
   4 %
   5 \section[TypeRep]{Type - friends' interface}
   6
   7 \begin{code}
   8 module TypeRep (
   9         TyThing(..),
  10         Type(..), TyNote(..),           -- Representation visible
  11         PredType(..),                   -- to friends
  12
  13         Kind, ThetaType,                -- Synonyms
  14
  15         funTyCon,
  16
  17         -- Pretty-printing
  18         pprType, pprParendType, pprTypeApp,
  19         pprTyThing, pprTyThingCategory,
  20         pprPred, pprTheta, pprForAll, pprThetaArrow, pprClassPred,
  21
  22         -- Kinds
  23         liftedTypeKind, unliftedTypeKind, openTypeKind,
  24         argTypeKind, ubxTupleKind,
  25         isLiftedTypeKindCon, isLiftedTypeKind,
  26         mkArrowKind, mkArrowKinds, isCoercionKind,
  27         coVarPred,
  28
  29         -- Kind constructors...
  30         liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
  31         argTypeKindTyCon, ubxTupleKindTyCon,
  32
  33         -- And their names
  34         unliftedTypeKindTyConName, openTypeKindTyConName,
  35         ubxTupleKindTyConName, argTypeKindTyConName,
  36         liftedTypeKindTyConName,
  37
  38         -- Super Kinds
  39         tySuperKind, coSuperKind,
  40         isTySuperKind, isCoSuperKind,
  41         tySuperKindTyCon, coSuperKindTyCon,
  42
  43         pprKind, pprParendKind
  44     ) where
  45
  46 #include "HsVersions.h"
  47
  48 import {-# SOURCE #-} DataCon( DataCon, dataConName )
  49
  50 -- friends:
  51 import Var
  52 import VarSet
  53 import Name
  54 import OccName
  55 import BasicTypes
  56 import TyCon
  57 import Class
  58
  59 -- others
  60 import PrelNames
  61 import Outputable
  62 import FastString
  63 \end{code}
  64
  65 %************************************************************************
  66 %*                                                                      *
  67 \subsection{Type Classifications}
  68 %*                                                                      *
  69 %************************************************************************
  70
  71 A type is
  72
  73         *unboxed*       iff its representation is other than a pointer
  74                         Unboxed types are also unlifted.
  75
  76         *lifted*        A type is lifted iff it has bottom as an element.
  77                         Closures always have lifted types:  i.e. any
  78                         let-bound identifier in Core must have a lifted
  79                         type.  Operationally, a lifted object is one that
  80                         can be entered.
  81
  82                         Only lifted types may be unified with a type variable.
  83
  84         *algebraic*     A type with one or more constructors, whether declared
  85                         with "data" or "newtype".
  86                         An algebraic type is one that can be deconstructed
  87                         with a case expression.
  88                         *NOT* the same as lifted types,  because we also
  89                         include unboxed tuples in this classification.
  90
  91         *data*          A type declared with "data".  Also boxed tuples.
  92
  93         *primitive*     iff it is a built-in type that can't be expressed
  94                         in Haskell.
  95
  96 Currently, all primitive types are unlifted, but that's not necessarily
  97 the case.  (E.g. Int could be primitive.)
  98
  99 Some primitive types are unboxed, such as Int#, whereas some are boxed
 100 but unlifted (such as ByteArray#).  The only primitive types that we
 101 classify as algebraic are the unboxed tuples.
 102
 103 examples of type classifications:
 104
 105 Type            primitive       boxed           lifted          algebraic
 106 -----------------------------------------------------------------------------
 107 Int#,           Yes             No              No              No
 108 ByteArray#      Yes             Yes             No              No
 109 (# a, b #)      Yes             No              No              Yes
 110 (  a, b  )      No              Yes             Yes             Yes
 111 [a]             No              Yes             Yes             Yes
 112
 113
 114
 115         ----------------------
 116         A note about newtypes
 117         ----------------------
 118
 119 Consider
 120         newtype N = MkN Int
 121
 122 Then we want N to be represented as an Int, and that's what we arrange.
 123 The front end of the compiler [TcType.lhs] treats N as opaque,
 124 the back end treats it as transparent [Type.lhs].
 125
 126 There's a bit of a problem with recursive newtypes
 127         newtype P = MkP P
 128         newtype Q = MkQ (Q->Q)
 129
 130 Here the 'implicit expansion' we get from treating P and Q as transparent
 131 would give rise to infinite types, which in turn makes eqType diverge.
 132 Similarly splitForAllTys and splitFunTys can get into a loop.
 133
 134 Solution:
 135
 136 * Newtypes are always represented using TyConApp.
 137
 138 * For non-recursive newtypes, P, treat P just like a type synonym after
 139   type-checking is done; i.e. it's opaque during type checking (functions
 140   from TcType) but transparent afterwards (functions from Type).
 141   "Treat P as a type synonym" means "all functions expand NewTcApps
 142   on the fly".
 143
 144   Applications of the data constructor P simply vanish:
 145         P x = x
 146
 147
 148 * For recursive newtypes Q, treat the Q and its representation as
 149   distinct right through the compiler.  Applications of the data consructor
 150   use a coerce:
 151         Q = \(x::Q->Q). coerce Q x
 152   They are rare, so who cares if they are a tiny bit less efficient.
 153
 154 The typechecker (TcTyDecls) identifies enough type construtors as 'recursive'
 155 to cut all loops.  The other members of the loop may be marked 'non-recursive'.
 156
 157
 158 %************************************************************************
 159 %*                                                                      *
 160 \subsection{The data type}
 161 %*                                                                      *
 162 %************************************************************************
 163
 164
 165 \begin{code}
 166 data Type
 167   = TyVarTy TyVar
 168
 169   | AppTy
 170         Type            -- Function is *not* a TyConApp
 171         Type            -- It must be another AppTy, or TyVarTy
 172                         -- (or NoteTy of these)
 173
 174   | TyConApp            -- Application of a TyCon, including newtypes *and* synonyms
 175         TyCon           --  *Invariant* saturated appliations of FunTyCon and
 176                         --      synonyms have their own constructors, below.
 177                         -- However, *unsaturated* FunTyCons do appear as TyConApps.
 178                         --
 179         [Type]          -- Might not be saturated.
 180                         -- Even type synonyms are not necessarily saturated;
 181                         -- for example unsaturated type synonyms can appear as the
 182                         -- RHS of a type synonym.
 183
 184   | FunTy               -- Special case of TyConApp: TyConApp FunTyCon [t1,t2]
 185         Type
 186         Type
 187
 188   | ForAllTy            -- A polymorphic type
 189         TyVar
 190         Type
 191
 192   | PredTy              -- The type of evidence for a type predictate
 193         PredType        -- See Note [PredTy], and Note [Equality predicates]
 194         -- NB: A PredTy (EqPred _ _) can appear only as the kind
 195         --     of a coercion variable; never as the argument or result
 196         --     of a FunTy (unlike ClassP, IParam)
 197
 198   | NoteTy              -- A type with a note attached
 199         TyNote
 200         Type            -- The expanded version
 201
 202 type Kind = Type        -- Invariant: a kind is always
 203                         --      FunTy k1 k2
 204                         -- or   TyConApp PrimTyCon [...]
 205                         -- or   TyVar kv (during inference only)
 206                         -- or   ForAll ... (for top-level coercions)
 207
 208 type SuperKind = Type   -- Invariant: a super kind is always
 209                         --   TyConApp SuperKindTyCon ...
 210
 211 data TyNote = FTVNote TyVarSet  -- The free type variables of the noted expression
 212 \end{code}
 213
 214 -------------------------------------
 215                 Note [PredTy]
 216
 217 A type of the form
 218         PredTy p
 219 represents a value whose type is the Haskell predicate p,
 220 where a predicate is what occurs before the '=>' in a Haskell type.
 221 It can be expanded into its representation, but:
 222
 223         * The type checker must treat it as opaque
 224         * The rest of the compiler treats it as transparent
 225
 226 Consider these examples:
 227         f :: (Eq a) => a -> Int
 228         g :: (?x :: Int -> Int) => a -> Int
 229         h :: (r\l) => {r} => {l::Int | r}
 230
 231 Here the "Eq a" and "?x :: Int -> Int" and "r\l" are all called *predicates*
 232 Predicates are represented inside GHC by PredType:
 233
 234 \begin{code}
 235 data PredType
 236   = ClassP Class [Type]         -- Class predicate
 237   | IParam (IPName Name) Type   -- Implicit parameter
 238   | EqPred Type Type            -- Equality predicate (ty1 ~ ty2)
 239
 240 type ThetaType = [PredType]
 241 \end{code}
 242
 243 (We don't support TREX records yet, but the setup is designed
 244 to expand to allow them.)
 245
 246 A Haskell qualified type, such as that for f,g,h above, is
 247 represented using
 248         * a FunTy for the double arrow
 249         * with a PredTy as the function argument
 250
 251 The predicate really does turn into a real extra argument to the
 252 function.  If the argument has type (PredTy p) then the predicate p is
 253 represented by evidence (a dictionary, for example, of type (predRepTy p).
 254
 255 Note [Equality predicates]
 256 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 257         forall a b. (a ~ S b) => a -> b
 258 could be represented by
 259         ForAllTy a (ForAllTy b (FunTy (PredTy (EqPred a (S b))) ...))
 260 OR
 261         ForAllTy a (ForAllTy b (ForAllTy (c::PredTy (EqPred a (S b))) ...))
 262
 263 The latter is what we do.  (Unlike for class and implicit parameter
 264 constraints, which do use FunTy.)
 265
 266 Reason:
 267         * FunTy is always a *value* function
 268         * ForAllTy is discarded at runtime
 269
 270 We often need to make a "wildcard" (c::PredTy..).  We always use the same
 271 name (wildCoVarName), since it's not mentioned.
 272
 273
 274 %************************************************************************
 275 %*                                                                      *
 276                         TyThing
 277 %*                                                                      *
 278 %************************************************************************
 279
 280 Despite the fact that DataCon has to be imported via a hi-boot route,
 281 this module seems the right place for TyThing, because it's needed for
 282 funTyCon and all the types in TysPrim.
 283
 284 \begin{code}
 285 data TyThing = AnId     Id
 286              | ADataCon DataCon
 287              | ATyCon   TyCon
 288              | AClass   Class
 289
 290 instance Outputable TyThing where
 291   ppr = pprTyThing
 292
 293 pprTyThing :: TyThing -> SDoc
 294 pprTyThing thing = pprTyThingCategory thing <+> quotes (ppr (getName thing))
 295
 296 pprTyThingCategory :: TyThing -> SDoc
 297 pprTyThingCategory (ATyCon _)   = ptext SLIT("Type constructor")
 298 pprTyThingCategory (AClass _)   = ptext SLIT("Class")
 299 pprTyThingCategory (AnId   _)   = ptext SLIT("Identifier")
 300 pprTyThingCategory (ADataCon _) = ptext SLIT("Data constructor")
 301
 302 instance NamedThing TyThing where       -- Can't put this with the type
 303   getName (AnId id)     = getName id    -- decl, because the DataCon instance
 304   getName (ATyCon tc)   = getName tc    -- isn't visible there
 305   getName (AClass cl)   = getName cl
 306   getName (ADataCon dc) = dataConName dc
 307 \end{code}
 308
 309
 310 %************************************************************************
 311 %*                                                                      *
 312                 Wired-in type constructors
 313 %*                                                                      *
 314 %************************************************************************
 315
 316 We define a few wired-in type constructors here to avoid module knots
 317
 318 \begin{code}
 319 --------------------------
 320 -- First the TyCons...
 321
 322 funTyCon, tySuperKindTyCon, coSuperKindTyCon, liftedTypeKindTyCon,
 323       openTypeKindTyCon, unliftedTypeKindTyCon,
 324       ubxTupleKindTyCon, argTypeKindTyCon
 325    :: TyCon
 326 funTyConName, tySuperKindTyConName, coSuperKindTyConName, liftedTypeKindTyConName,
 327       openTypeKindTyConName, unliftedTypeKindTyConName,
 328       ubxTupleKindTyConName, argTypeKindTyConName
 329    :: Name
 330
 331 funTyCon = mkFunTyCon funTyConName (mkArrowKinds [argTypeKind, openTypeKind] liftedTypeKind)
 332         -- You might think that (->) should have type (?? -> ? -> *), and you'd be right
 333         -- But if we do that we get kind errors when saying
 334         --      instance Control.Arrow (->)
 335         -- becuase the expected kind is (*->*->*).  The trouble is that the
 336         -- expected/actual stuff in the unifier does not go contra-variant, whereas
 337         -- the kind sub-typing does.  Sigh.  It really only matters if you use (->) in
 338         -- a prefix way, thus:  (->) Int# Int#.  And this is unusual.
 339
 340
 341 tySuperKindTyCon     = mkSuperKindTyCon tySuperKindTyConName
 342 coSuperKindTyCon     = mkSuperKindTyCon coSuperKindTyConName
 343
 344 liftedTypeKindTyCon   = mkKindTyCon liftedTypeKindTyConName
 345 openTypeKindTyCon     = mkKindTyCon openTypeKindTyConName
 346 unliftedTypeKindTyCon = mkKindTyCon unliftedTypeKindTyConName
 347 ubxTupleKindTyCon     = mkKindTyCon ubxTupleKindTyConName
 348 argTypeKindTyCon      = mkKindTyCon argTypeKindTyConName
 349
 350 mkKindTyCon :: Name -> TyCon
 351 mkKindTyCon name = mkVoidPrimTyCon name tySuperKind 0
 352
 353 --------------------------
 354 -- ... and now their names
 355
 356 tySuperKindTyConName      = mkPrimTyConName FSLIT("BOX") tySuperKindTyConKey tySuperKindTyCon
 357 coSuperKindTyConName      = mkPrimTyConName FSLIT("COERCION") coSuperKindTyConKey coSuperKindTyCon
 358 liftedTypeKindTyConName   = mkPrimTyConName FSLIT("*") liftedTypeKindTyConKey liftedTypeKindTyCon
 359 openTypeKindTyConName     = mkPrimTyConName FSLIT("?") openTypeKindTyConKey openTypeKindTyCon
 360 unliftedTypeKindTyConName = mkPrimTyConName FSLIT("#") unliftedTypeKindTyConKey unliftedTypeKindTyCon
 361 ubxTupleKindTyConName     = mkPrimTyConName FSLIT("(#)") ubxTupleKindTyConKey ubxTupleKindTyCon
 362 argTypeKindTyConName      = mkPrimTyConName FSLIT("??") argTypeKindTyConKey argTypeKindTyCon
 363 funTyConName              = mkPrimTyConName FSLIT("(->)") funTyConKey funTyCon
 364
 365 mkPrimTyConName :: FastString -> Unique -> TyCon -> Name
 366 mkPrimTyConName occ key tycon = mkWiredInName gHC_PRIM (mkOccNameFS tcName occ)
 367                                               key
 368                                               (ATyCon tycon)
 369                                               BuiltInSyntax
 370         -- All of the super kinds and kinds are defined in Prim and use BuiltInSyntax,
 371         -- because they are never in scope in the source
 372
 373 ------------------
 374 -- We also need Kinds and SuperKinds, locally and in TyCon
 375
 376 kindTyConType :: TyCon -> Type
 377 kindTyConType kind = TyConApp kind []
 378
 379 liftedTypeKind, unliftedTypeKind, openTypeKind, argTypeKind, ubxTupleKind :: Kind
 380
 381 liftedTypeKind   = kindTyConType liftedTypeKindTyCon
 382 unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
 383 openTypeKind     = kindTyConType openTypeKindTyCon
 384 argTypeKind      = kindTyConType argTypeKindTyCon
 385 ubxTupleKind     = kindTyConType ubxTupleKindTyCon
 386
 387 mkArrowKind :: Kind -> Kind -> Kind
 388 mkArrowKind k1 k2 = FunTy k1 k2
 389
 390 mkArrowKinds :: [Kind] -> Kind -> Kind
 391 mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind arg_kinds
 392
 393 tySuperKind, coSuperKind :: SuperKind
 394 tySuperKind = kindTyConType tySuperKindTyCon
 395 coSuperKind = kindTyConType coSuperKindTyCon
 396
 397 isTySuperKind :: SuperKind -> Bool
 398 isTySuperKind (NoteTy _ ty)    = isTySuperKind ty
 399 isTySuperKind (TyConApp kc []) = kc `hasKey` tySuperKindTyConKey
 400 isTySuperKind _                = False
 401
 402 isCoSuperKind :: SuperKind -> Bool
 403 isCoSuperKind (NoteTy _ ty)    = isCoSuperKind ty
 404 isCoSuperKind (TyConApp kc []) = kc `hasKey` coSuperKindTyConKey
 405 isCoSuperKind _                = False
 406
 407 -------------------
 408 -- Lastly we need a few functions on Kinds
 409
 410 isLiftedTypeKindCon :: TyCon -> Bool
 411 isLiftedTypeKindCon tc    = tc `hasKey` liftedTypeKindTyConKey
 412
 413 isLiftedTypeKind :: Kind -> Bool
 414 isLiftedTypeKind (TyConApp tc []) = isLiftedTypeKindCon tc
 415 isLiftedTypeKind _                = False
 416
 417 isCoercionKind :: Kind -> Bool
 418 -- All coercions are of form (ty1 ~ ty2)
 419 -- This function is here rather than in Coercion,
 420 -- because it's used in a knot-tied way to enforce invariants in Var
 421 isCoercionKind (NoteTy _ k)         = isCoercionKind k
 422 isCoercionKind (PredTy (EqPred {})) = True
 423 isCoercionKind _                    = False
 424
 425 coVarPred :: CoVar -> PredType
 426 coVarPred tv
 427   = ASSERT( isCoVar tv )
 428     case tyVarKind tv of
 429         PredTy eq -> eq         -- There shouldn't even be a NoteTy in the way
 430         other     -> pprPanic "coVarPred" (ppr tv $$ ppr other)
 431 \end{code}
 432
 433
 434
 435 %************************************************************************
 436 %*                                                                      *
 437 \subsection{The external interface}
 438 %*                                                                      *
 439 %************************************************************************
 440
 441 @pprType@ is the standard @Type@ printer; the overloaded @ppr@ function is
 442 defined to use this.  @pprParendType@ is the same, except it puts
 443 parens around the type, except for the atomic cases.  @pprParendType@
 444 works just by setting the initial context precedence very high.
 445
 446 \begin{code}
 447 data Prec = TopPrec     -- No parens
 448           | FunPrec     -- Function args; no parens for tycon apps
 449           | TyConPrec   -- Tycon args; no parens for atomic
 450           deriving( Eq, Ord )
 451
 452 maybeParen :: Prec -> Prec -> SDoc -> SDoc
 453 maybeParen ctxt_prec inner_prec pretty
 454   | ctxt_prec < inner_prec = pretty
 455   | otherwise              = parens pretty
 456
 457 ------------------
 458 pprType, pprParendType :: Type -> SDoc
 459 pprType       ty = ppr_type TopPrec   ty
 460 pprParendType ty = ppr_type TyConPrec ty
 461
 462 pprTypeApp :: NamedThing a => a -> SDoc -> [Type] -> SDoc
 463 -- The first arg is the tycon; it's used to arrange printing infix
 464 -- if it looks like an operator
 465 -- Second arg is the pretty-printed tycon
 466 pprTypeApp tc pp_tc tys = ppr_type_app TopPrec (getName tc) pp_tc tys
 467
 468 ------------------
 469 pprPred :: PredType -> SDoc
 470 pprPred (ClassP cls tys) = pprClassPred cls tys
 471 pprPred (IParam ip ty)   = ppr ip <> dcolon <> pprType ty
 472 pprPred (EqPred ty1 ty2) = sep [ppr ty1, nest 2 (ptext SLIT("~")), ppr ty2]
 473 pprClassPred :: Class -> [Type] -> SDoc
 474 pprClassPred clas tys = ppr_type_app TopPrec (getName clas) (ppr clas) tys
 475
 476 pprTheta :: ThetaType -> SDoc
 477 pprTheta theta = parens (sep (punctuate comma (map pprPred theta)))
 478
 479 pprThetaArrow :: ThetaType -> SDoc
 480 pprThetaArrow theta
 481   | null theta = empty
 482   | otherwise  = parens (sep (punctuate comma (map pprPred theta))) <+> ptext SLIT("=>")
 483
 484 ------------------
 485 instance Outputable Type where
 486     ppr ty = pprType ty
 487
 488 instance Outputable PredType where
 489     ppr = pprPred
 490
 491 instance Outputable name => OutputableBndr (IPName name) where
 492     pprBndr _ n = ppr n -- Simple for now
 493
 494 ------------------
 495         -- OK, here's the main printer
 496
 497 pprKind, pprParendKind :: Kind -> SDoc
 498 pprKind = pprType
 499 pprParendKind = pprParendType
 500
 501 ppr_type :: Prec -> Type -> SDoc
 502 ppr_type _ (TyVarTy tv)       = ppr tv
 503 ppr_type _ (PredTy pred)      = ifPprDebug (ptext SLIT("<pred>")) <> (ppr pred)
 504 ppr_type p (NoteTy _ ty2)     = ifPprDebug (ptext SLIT("<note>")) <> ppr_type p ty2
 505 ppr_type p (TyConApp tc tys)  = ppr_tc_app p tc tys
 506
 507 ppr_type p (AppTy t1 t2) = maybeParen p TyConPrec $
 508                            pprType t1 <+> ppr_type TyConPrec t2
 509
 510 ppr_type p ty@(ForAllTy _ _)       = ppr_forall_type p ty
 511 ppr_type p ty@(FunTy (PredTy _) _) = ppr_forall_type p ty
 512
 513 ppr_type p (FunTy ty1 ty2)
 514   = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
 515     maybeParen p FunPrec $
 516     sep (ppr_type FunPrec ty1 : ppr_fun_tail ty2)
 517   where
 518     ppr_fun_tail (FunTy ty1 ty2) = (arrow <+> ppr_type FunPrec ty1) : ppr_fun_tail ty2
 519     ppr_fun_tail other_ty        = [arrow <+> pprType other_ty]
 520
 521 ppr_forall_type :: Prec -> Type -> SDoc
 522 ppr_forall_type p ty
 523   = maybeParen p FunPrec $
 524     sep [pprForAll tvs, pprThetaArrow ctxt, pprType tau]
 525   where
 526     (tvs,  rho) = split1 [] ty
 527     (ctxt, tau) = split2 [] rho
 528
 529     -- We need to be extra careful here as equality constraints will occur as
 530     -- type variables with an equality kind.  So, while collecting quantified
 531     -- variables, we separate the coercion variables out and turn them into
 532     -- equality predicates.
 533     split1 tvs (ForAllTy tv ty)
 534       | not (isCoVar tv)     = split1 (tv:tvs) ty
 535     split1 tvs (NoteTy _ ty) = split1 tvs ty
 536     split1 tvs ty            = (reverse tvs, ty)
 537
 538     split2 ps (NoteTy _ arg     -- Rather a disgusting case
 539                `FunTy` res)         = split2 ps (arg `FunTy` res)
 540     split2 ps (PredTy p `FunTy` ty) = split2 (p:ps) ty
 541     split2 ps (ForAllTy tv ty)
 542         | isCoVar tv                = split2 (coVarPred tv : ps) ty
 543     split2 ps (NoteTy _ ty)         = split2 ps ty
 544     split2 ps ty                    = (reverse ps, ty)
 545
 546 ppr_tc_app :: Prec -> TyCon -> [Type] -> SDoc
 547 ppr_tc_app _ tc []
 548   = ppr_tc tc
 549 ppr_tc_app _ tc [ty]
 550   | tc `hasKey` listTyConKey = brackets (pprType ty)
 551   | tc `hasKey` parrTyConKey = ptext SLIT("[:") <> pprType ty <> ptext SLIT(":]")
 552   | tc `hasKey` liftedTypeKindTyConKey   = ptext SLIT("*")
 553   | tc `hasKey` unliftedTypeKindTyConKey = ptext SLIT("#")
 554   | tc `hasKey` openTypeKindTyConKey     = ptext SLIT("(?)")
 555   | tc `hasKey` ubxTupleKindTyConKey     = ptext SLIT("(#)")
 556   | tc `hasKey` argTypeKindTyConKey      = ptext SLIT("??")
 557
 558 ppr_tc_app p tc tys
 559   | isTupleTyCon tc && tyConArity tc == length tys
 560   = tupleParens (tupleTyConBoxity tc) (sep (punctuate comma (map pprType tys)))
 561   | otherwise
 562   = ppr_type_app p (getName tc) (ppr_naked_tc tc) tys
 563
 564 ppr_type_app :: Prec -> Name -> SDoc -> [Type] -> SDoc
 565 ppr_type_app p tc pp_tc tys
 566   | is_sym_occ          -- Print infix if possible
 567   , [ty1,ty2] <- tys    -- We know nothing of precedence though
 568   = maybeParen p FunPrec (sep [ppr_type FunPrec ty1,
 569                                pp_tc <+> ppr_type FunPrec ty2])
 570   | otherwise
 571   = maybeParen p TyConPrec (hang paren_tc 2 (sep (map pprParendType tys)))
 572   where
 573     is_sym_occ = isSymOcc (getOccName tc)
 574     paren_tc | is_sym_occ = parens pp_tc
 575              | otherwise  = pp_tc
 576
 577 ppr_tc :: TyCon -> SDoc
 578 ppr_tc tc = parenSymOcc (getOccName tc) (ppr_naked_tc tc)
 579
 580 ppr_naked_tc :: TyCon -> SDoc   -- No brackets for SymOcc
 581 ppr_naked_tc tc
 582   = pp_nt_debug <> ppr tc
 583   where
 584    pp_nt_debug | isNewTyCon tc = ifPprDebug (if isRecursiveTyCon tc
 585                                              then ptext SLIT("<recnt>")
 586                                              else ptext SLIT("<nt>"))
 587                | otherwise     = empty
 588
 589 -------------------
 590 pprForAll :: [TyVar] -> SDoc
 591 pprForAll []  = empty
 592 pprForAll tvs = ptext SLIT("forall") <+> sep (map pprTvBndr tvs) <> dot
 593
 594 pprTvBndr :: TyVar -> SDoc
 595 pprTvBndr tv | isLiftedTypeKind kind = ppr tv
 596              | otherwise             = parens (ppr tv <+> dcolon <+> pprKind kind)
 597              where
 598                kind = tyVarKind tv
 599 \end{code}
 600