- = 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)
- = braces (ppr pred)
-
-ppr_mono_ty ctxt_prec (HsUsageTy u ty)
- = maybeParen (ctxt_prec >= pREC_CON)
- (sep [ptext SLIT("__u") <+> ppr_mono_ty pREC_CON u,
- ppr_mono_ty pREC_CON ty])
- -- pREC_FUN would be logical for u, but it yields a reduce/reduce conflict with AppTy
-
--- Generics
-ppr_mono_ty ctxt_prec (HsNumTy n) = integer n
-ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) = ppr ty1 <+> ppr op <+> ppr ty2
-\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 Name
-toHsTyVar tv = IfaceTyVar (getName tv) (tyVarKind tv)
-
-toHsTyVars tvs = map toHsTyVar tvs
-
-toHsType :: Type -> HsType Name
--- This function knows the representation of types
-toHsType (TyVarTy tv) = HsTyVar (getName tv)
-toHsType (FunTy arg res) = HsFunTy (toHsType arg) (toHsType res)
-toHsType (AppTy fun arg) = HsAppTy (toHsType fun) (toHsType arg)
-
-toHsType (NoteTy (SynNote ty@(TyConApp tycon tyargs)) real_ty)
- | isNewTyCon tycon = toHsType ty
- | syn_matches = toHsType ty -- Use synonyms if possible!!
- | otherwise =
-#ifdef DEBUG
- pprTrace "WARNING: synonym info lost in .hi file for " (ppr syn_ty) $
-#endif
- toHsType real_ty -- but drop it if not.
- where
- syn_matches = ty_from_syn `tcEqType` real_ty
- (tyvars,syn_ty) = getSynTyConDefn tycon
- ty_from_syn = substTy (mkTyVarSubst tyvars tyargs) syn_ty
-
- -- We only use the type synonym in the file if this doesn't cause
- -- us to lose important information. This matters for usage
- -- annotations. It's an issue if some of the args to the synonym
- -- have arrows in them, or if the synonym's RHS has an arrow; for
- -- example, with nofib/real/ebnf2ps/ in Parsers.using.
-
- -- **! It would be nice if when this test fails we could still
- -- write the synonym in as a Note, so we don't lose the info for
- -- error messages, but it's too much work for right now.
- -- KSW 2000-07.
-
-toHsType (NoteTy _ ty) = toHsType ty
-
-toHsType (SourceTy (NType tc tys)) = foldl HsAppTy (HsTyVar (getName tc)) (map toHsType tys)
-toHsType (SourceTy pred) = HsPredTy (toHsPred pred)
-
-toHsType ty@(TyConApp tc tys) -- Must be saturated because toHsType's arg is of kind *
- | not saturated = generic_case
- | isTupleTyCon tc = HsTupleTy (HsTupCon (getName tc) (tupleTyConBoxity tc) (tyConArity tc)) tys'
- | tc `hasKey` listTyConKey = HsListTy (head tys')
- | tc `hasKey` usOnceTyConKey = hsUsOnce_Name -- must print !, . unqualified
- | tc `hasKey` usManyTyConKey = hsUsMany_Name -- must print !, . unqualified
- | otherwise = generic_case
- where
- generic_case = foldl HsAppTy (HsTyVar (getName tc)) tys'
- tys' = map toHsType tys
- saturated = length tys == tyConArity tc
-
-toHsType ty@(ForAllTy _ _) = case tcSplitSigmaTy ty of
- (tvs, preds, tau) -> HsForAllTy (Just (map toHsTyVar tvs))
- (map toHsPred preds)
- (toHsType tau)
-
-toHsType (UsageTy u ty) = HsUsageTy (toHsType u) (toHsType ty)
- -- **! consider dropping usMany annotations ToDo KSW 2000-10
-
-
-toHsPred (ClassP cls tys) = HsClassP (getName cls) (map toHsType tys)
-toHsPred (IParam n ty) = HsIParam (getName n) (toHsType ty)
-
-toHsContext :: ThetaType -> HsContext Name
-toHsContext theta = map toHsPred theta
-
-toHsFDs :: [FunDep TyVar] -> [FunDep Name]
-toHsFDs fds = [(map getName ns, map getName ms) | (ns,ms) <- fds]
-\end{code}
-
-
-%************************************************************************
-%* *
-\subsection{Comparison}
-%* *
-%************************************************************************
-
-\begin{code}
-instance Ord a => Eq (HsType a) where
- -- The Ord is needed because we keep a
- -- finite map of variables to variables
- (==) a b = eq_hsType emptyEqHsEnv a b
-
-instance Ord a => Eq (HsPred a) where
- (==) a b = eq_hsPred emptyEqHsEnv a b
-
-eqWithHsTyVars :: Ord name =>
- [HsTyVarBndr name] -> [HsTyVarBndr name]
- -> (EqHsEnv name -> Bool) -> Bool
-eqWithHsTyVars = eq_hsTyVars emptyEqHsEnv
-\end{code}
-
-\begin{code}
-type EqHsEnv n = FiniteMap n n
--- Tracks the mapping from L-variables to R-variables
-
-eq_hsVar :: Ord n => EqHsEnv n -> n -> n -> Bool
-eq_hsVar env n1 n2 = case lookupFM env n1 of
- Just n1 -> n1 == n2
- Nothing -> n1 == n2
-
-extendEqHsEnv env n1 n2
- | n1 == n2 = env
- | otherwise = addToFM env n1 n2
-
-emptyEqHsEnv :: EqHsEnv n
-emptyEqHsEnv = emptyFM
-\end{code}
-
-We do define a specialised equality for these \tr{*Type} types; used
-in checking interfaces.
+ = maybeParen ctxt_prec pREC_CON $
+ hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
+
+ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
+ = maybeParen ctxt_prec pREC_OP $
+ ppr_mono_lty pREC_OP ty1 <+> ppr op <+> ppr_mono_lty pREC_OP ty2
+
+ppr_mono_ty ctxt_prec (HsParTy ty)
+ = parens (ppr_mono_lty pREC_TOP ty)
+ -- Put the parens in where the user did
+ -- But we still use the precedence stuff to add parens because
+ -- toHsType doesn't put in any HsParTys, so we may still need them
+
+--------------------------
+ppr_fun_ty ctxt_prec ty1 ty2
+ = let p1 = ppr_mono_lty pREC_FUN ty1
+ p2 = ppr_mono_lty pREC_TOP ty2
+ in
+ maybeParen ctxt_prec pREC_FUN $
+ sep [p1, ptext SLIT("->") <+> p2]