- cmp_tvs [] [] = EQ_
- cmp_tvs [] _ = LT_
- cmp_tvs _ [] = GT_
- cmp_tvs (a:as) (b:bs)
- = thenCmp (cmp a b) (cmp_tvs as bs)
- cmp_tvs _ _ = panic# "cmp_tvs"
-
------------
-cmpMonoType cmp (MonoTyVar n1) (MonoTyVar n2)
- = cmp n1 n2
-
-cmpMonoType cmp (MonoTupleTy tys1) (MonoTupleTy tys2)
- = cmpList (cmpMonoType cmp) tys1 tys2
-cmpMonoType cmp (MonoListTy ty1) (MonoListTy ty2)
- = cmpMonoType cmp ty1 ty2
-
-cmpMonoType cmp (MonoTyApp tc1 tys1) (MonoTyApp tc2 tys2)
- = thenCmp (cmp tc1 tc2) (cmpList (cmpMonoType cmp) tys1 tys2)
-
-cmpMonoType cmp (MonoFunTy a1 b1) (MonoFunTy a2 b2)
- = thenCmp (cmpMonoType cmp a1 a2) (cmpMonoType cmp b1 b2)
-
-cmpMonoType cmp (MonoDictTy c1 ty1) (MonoDictTy c2 ty2)
- = thenCmp (cmp c1 c2) (cmpMonoType cmp ty1 ty2)
-
-cmpMonoType cmp ty1 ty2 -- tags must be different
- = let tag1 = tag ty1
- tag2 = tag ty2
+ show_forall = opt_PprStyle_Debug
+ || (not (null tvs) && is_explicit)
+ is_explicit = case exp of {Explicit -> True; Implicit -> False}
+ forall_part = ptext SLIT("forall") <+> interppSP tvs <> dot
+
+pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
+pprHsContext [] = empty
+pprHsContext cxt = ppr_hs_context cxt <+> ptext SLIT("=>")
+
+ppr_hs_context [] = empty
+ppr_hs_context cxt = parens (interpp'SP cxt)
+\end{code}
+
+\begin{code}
+pREC_TOP = (0 :: Int) -- type in ParseIface.y
+pREC_FUN = (1 :: Int) -- btype in ParseIface.y
+ -- Used for LH arg of (->)
+pREC_OP = (2 :: Int) -- Used for arg of any infix operator
+ -- (we don't keep their fixities around)
+pREC_CON = (3 :: Int) -- Used for arg of type applicn:
+ -- always parenthesise unless atomic
+
+maybeParen :: Int -- Precedence of context
+ -> Int -- Precedence of top-level operator
+ -> SDoc -> SDoc -- Wrap in parens if (ctxt >= op)
+maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
+ | otherwise = p
+
+-- printing works more-or-less as for Types
+
+pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
+
+pprHsType ty = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
+pprParendHsType ty = ppr_mono_ty pREC_CON ty
+
+-- Before printing a type
+-- (a) Remove outermost HsParTy parens
+-- (b) Drop top-level for-all type variables in user style
+-- since they are implicit in Haskell
+prepare sty (HsParTy ty) = prepare sty (unLoc ty)
+prepare sty ty = ty
+
+ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
+
+ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
+ = maybeParen ctxt_prec pREC_FUN $
+ sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
+
+-- gaw 2004
+ppr_mono_ty ctxt_prec (HsBangTy b ty) = ppr b <> ppr ty
+ppr_mono_ty ctxt_prec (HsTyVar name) = ppr name
+ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) = ppr_fun_ty ctxt_prec ty1 ty2
+ppr_mono_ty ctxt_prec (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
+ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
+ppr_mono_ty ctxt_prec (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty)
+ppr_mono_ty ctxt_prec (HsPArrTy ty) = pabrackets (ppr_mono_lty pREC_TOP ty)
+ppr_mono_ty ctxt_prec (HsPredTy pred) = braces (ppr pred)
+ppr_mono_ty ctxt_prec (HsNumTy n) = integer n -- generics only
+ppr_mono_ty ctxt_prec (HsSpliceTy s) = pprSplice s
+
+ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
+ = 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