+data Prec = TopPrec -- No parens
+ | FunPrec -- Function args; no parens for tycon apps
+ | TyConPrec -- Tycon args; no parens for atomic
+ deriving( Eq, Ord )
+
+maybeParen :: Prec -> Prec -> SDoc -> SDoc
+maybeParen ctxt_prec inner_prec pretty
+ | ctxt_prec < inner_prec = pretty
+ | otherwise = parens pretty
+
+------------------
+pprType, pprParendType :: Type -> SDoc
+pprType ty = ppr_type TopPrec ty
+pprParendType ty = ppr_type TyConPrec ty
+
+------------------
+pprPred :: PredType -> SDoc
+pprPred (ClassP cls tys) = pprClassPred cls tys
+pprPred (IParam ip ty) = ppr ip <> dcolon <> pprType ty
+
+pprClassPred :: Class -> [Type] -> SDoc
+pprClassPred clas tys = ppr clas <+> sep (map pprParendType tys)
+
+pprTheta :: ThetaType -> SDoc
+pprTheta theta = parens (sep (punctuate comma (map pprPred theta)))
+
+pprThetaArrow :: ThetaType -> SDoc
+pprThetaArrow theta
+ | null theta = empty
+ | otherwise = parens (sep (punctuate comma (map pprPred theta))) <+> ptext SLIT("=>")
+
+------------------
+instance Outputable Type where
+ ppr ty = pprType ty
+
+instance Outputable PredType where
+ ppr = pprPred
+
+instance Outputable name => OutputableBndr (IPName name) where
+ pprBndr _ n = ppr n -- Simple for now
+
+------------------
+ -- OK, here's the main printer
+
+ppr_type :: Prec -> Type -> SDoc
+ppr_type p (TyVarTy tv) = ppr tv
+ppr_type p (PredTy pred) = braces (ppr pred)
+ppr_type p (NoteTy (SynNote ty1) ty2) = ppr_type p ty1
+ppr_type p (NoteTy other ty2) = ppr_type p ty2
+
+ppr_type p (TyConApp tc tys) = ppr_tc_app p tc tys
+ppr_type p (NewTcApp tc tys) = ifPprDebug (if isRecursiveTyCon tc
+ then ptext SLIT("<recnt>")
+ else ptext SLIT("<nt>")
+ ) <>
+ ppr_tc_app p tc tys
+
+ppr_type p (AppTy t1 t2) = maybeParen p TyConPrec $
+ pprType t1 <+> ppr_type TyConPrec t2
+
+ppr_type p (FunTy ty1 ty2)
+ = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
+ maybeParen p FunPrec $
+ sep (ppr_type FunPrec ty1 : ppr_fun_tail ty2)
+ where
+ ppr_fun_tail (FunTy ty1 ty2) = (arrow <+> ppr_type FunPrec ty1) : ppr_fun_tail ty2
+ ppr_fun_tail other_ty = [arrow <+> pprType other_ty]