+ (sep [p1, (<>) (ptext SLIT("-> ")) p2])
+
+ppr_mono_ty ctxt_prec (HsTupleTy con tys) = hsTupParens con (interpp'SP tys)
+ppr_mono_ty ctxt_prec (HsListTy ty) = brackets (ppr_mono_ty pREC_TOP ty)
+
+ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
+ = maybeParen (ctxt_prec >= pREC_CON)
+ (hsep [ppr_mono_ty pREC_FUN fun_ty, ppr_mono_ty pREC_CON arg_ty])
+
+ppr_mono_ty ctxt_prec (HsPredTy pred)
+ = maybeParen (ctxt_prec >= pREC_FUN) $
+ braces (ppr pred)
+
+ppr_mono_ty ctxt_prec ty@(HsUsgForAllTy _ _)
+ =
+ sep [ ptext SLIT("__fuall") <+> brackets pp_uvars <+> ptext SLIT("=>"),
+ ppr_mono_ty pREC_TOP sigma
+ ]
+ where
+ (uvars,sigma) = split [] ty
+ pp_uvars = interppSP uvars
+
+ split uvs (HsUsgForAllTy uv ty') = split (uv:uvs) ty'
+ split uvs ty' = (reverse uvs,ty')
+
+ppr_mono_ty ctxt_prec (HsUsgTy u ty)
+ = maybeParen (ctxt_prec >= pREC_CON) $
+ ptext SLIT("__u") <+> pp_ua <+> ppr_mono_ty pREC_CON ty
+ where
+ pp_ua = case u of
+ HsUsOnce -> ptext SLIT("-")
+ HsUsMany -> ptext SLIT("!")
+ HsUsVar uv -> ppr uv
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{Converting from Type to HsType}
+%* *
+%************************************************************************
+
+@toHsType@ converts from a Type to a HsType, making the latter look as
+user-friendly as possible. Notably, it uses synonyms where possible, and
+expresses overloaded functions using the '=>' context part of a HsForAllTy.
+
+\begin{code}
+toHsTyVar :: TyVar -> HsTyVarBndr RdrName
+toHsTyVar tv = IfaceTyVar (toRdrName tv) (tyVarKind tv)
+
+toHsTyVars tvs = map toHsTyVar tvs
+
+toHsType :: Type -> HsType RdrName
+toHsType ty = toHsType' (unUsgTy ty)
+ -- For now we just discard the usage
+-- = case splitUsgTy ty of
+-- (usg, tau) -> HsUsgTy (toHsUsg usg) (toHsType' tau)
+
+toHsType' :: Type -> HsType RdrName
+-- Called after the usage is stripped off
+-- This function knows the representation of types
+toHsType' (TyVarTy tv) = HsTyVar (toRdrName tv)
+toHsType' (FunTy arg res) = HsFunTy (toHsType arg) (toHsType res)
+toHsType' (AppTy fun arg) = HsAppTy (toHsType fun) (toHsType arg)
+
+toHsType' (NoteTy (SynNote ty) _) = toHsType ty -- Use synonyms if possible!!
+toHsType' (NoteTy _ ty) = toHsType ty
+
+toHsType' ty@(TyConApp tc tys) -- Must be saturated because toHsType's arg is of kind *
+ | not saturated = generic_case
+ | isTupleTyCon tc = HsTupleTy (HsTupCon (toRdrName tc) (tupleTyConBoxity tc)) tys'
+ | tc `hasKey` listTyConKey = HsListTy (head tys')
+ | maybeToBool maybe_class = HsPredTy (HsPClass (toRdrName clas) tys')
+ | otherwise = generic_case
+ where
+ generic_case = foldl HsAppTy (HsTyVar (toRdrName tc)) tys'
+ maybe_class = tyConClass_maybe tc
+ Just clas = maybe_class
+ tys' = map toHsType tys
+ saturated = length tys == tyConArity tc