+ppr_ty :: Int -> Type -> SDoc
+ppr_ty ctxt_prec (TyVarTy tyvar)
+ = ppr tyvar
+
+ppr_ty ctxt_prec ty@(TyConApp tycon tys)
+ -- KIND CASE; it's of the form (Type x)
+ | tycon `hasKey` typeConKey,
+ [ty] <- tys
+ = -- For kinds, print (Type x) as just x if x is a
+ -- type constructor (must be Boxed, Unboxed, AnyBox)
+ -- Otherwise print as (Type x)
+ case ty of
+ TyConApp bx [] -> ppr (getOccName bx) -- Always unqualified
+ other -> maybeParen ctxt_prec tYCON_PREC
+ (ppr tycon <+> ppr_ty tYCON_PREC ty)
+
+ -- USAGE CASE
+ | (tycon `hasKey` usOnceTyConKey || tycon `hasKey` usManyTyConKey),
+ null tys
+ = -- For usages (! and .), always print bare OccName, without pkg/mod/uniq
+ ppr (getOccName (tyConName tycon))
+
+ -- TUPLE CASE (boxed and unboxed)
+ | isTupleTyCon tycon,
+ length tys == tyConArity tycon -- No magic if partially applied
+ = tupleParens (tupleTyConBoxity tycon)
+ (sep (punctuate comma (map (ppr_ty tOP_PREC) tys)))
+
+ -- LIST CASE
+ | tycon `hasKey` listTyConKey,
+ [ty] <- tys
+ = brackets (ppr_ty tOP_PREC ty)
+
+ -- GENERAL CASE
+ | otherwise
+ = ppr_tc_app ctxt_prec tycon tys
+
+
+ppr_ty ctxt_prec ty@(ForAllTy _ _)
+ = getPprStyle $ \ sty ->
+ maybeParen ctxt_prec fUN_PREC $
+ sep [ ptext SLIT("forall") <+> pp_tyvars sty <> ptext SLIT("."),
+ ppr_theta theta,
+ ppr_ty tOP_PREC tau
+ ]
+ where
+ (tyvars, theta, tau) = tcSplitSigmaTy ty
+
+ pp_tyvars sty = sep (map pprTyVarBndr some_tyvars)
+ where
+ some_tyvars | userStyle sty && not opt_PprStyle_RawTypes
+ = filter (not . isUTyVar) tyvars -- hide uvars from user
+ | otherwise
+ = tyvars
+
+ ppr_theta [] = empty
+ ppr_theta theta = pprTheta theta <+> ptext SLIT("=>")
+
+
+ppr_ty ctxt_prec (FunTy ty1 ty2)
+ -- we don't want to lose usage annotations or synonyms,
+ -- so we mustn't use splitFunTys here.
+ = maybeParen ctxt_prec fUN_PREC $
+ sep [ ppr_ty fUN_PREC ty1
+ , ptext arrow <+> ppr_ty tOP_PREC ty2
+ ]
+ where arrow | isPredTy ty1 = SLIT("=>")
+ | otherwise = SLIT("->")
+
+ppr_ty ctxt_prec (AppTy ty1 ty2)
+ = maybeParen ctxt_prec tYCON_PREC $
+ ppr_ty fUN_PREC ty1 <+> ppr_ty tYCON_PREC ty2
+
+ppr_ty ctxt_prec (UsageTy u ty)
+ = maybeParen ctxt_prec tYCON_PREC $
+ ptext SLIT("__u") <+> ppr_ty tYCON_PREC u
+ <+> ppr_ty tYCON_PREC ty
+ -- fUN_PREC would be logical for u, but it yields a reduce/reduce conflict with AppTy
+
+ppr_ty ctxt_prec (NoteTy (SynNote ty) expansion)
+ = ppr_ty ctxt_prec ty
+-- = ppr_ty ctxt_prec expansion -- if we don't want to see syntys
+
+ppr_ty ctxt_prec (NoteTy (FTVNote _) ty) = ppr_ty ctxt_prec ty
+
+ppr_ty ctxt_prec (SourceTy (NType tc tys)) = ppr_tc_app ctxt_prec tc tys
+ppr_ty ctxt_prec (SourceTy pred) = braces (pprPred pred)
+
+ppr_tc_app ctxt_prec tc [] = ppr tc
+ppr_tc_app ctxt_prec tc tys = maybeParen ctxt_prec tYCON_PREC
+ (sep [ppr tc, nest 4 (sep (map (ppr_ty tYCON_PREC) tys))])