Commit 7c537ab2 authored by simonpj's avatar simonpj
Browse files

[project @ 2002-06-17 15:53:42 by simonpj]

Fix HnType parenthesisation; fixes rnfail020, tcfail057
parent 6440f81f
......@@ -121,9 +121,13 @@ data HsType name
| HsOpTy (HsType name) (HsTyOp name) (HsType name)
| HsParTy (HsType name) -- Parenthesis preserved for the
-- precedence parser; are removed by
-- the type checker
| HsParTy (HsType name)
-- Parenthesis preserved for the precedence re-arrangement in RnTypes
-- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
--
-- However, NB that toHsType doesn't add HsParTys (in an effort to keep
-- interface files smaller), so when printing a HsType we may need to
-- add parens.
| HsNumTy Integer -- Generics only
......@@ -282,11 +286,17 @@ ppr_hs_context cxt = parens (interpp'SP cxt)
\begin{code}
pREC_TOP = (0 :: Int) -- type in ParseIface.y
pREC_FUN = (1 :: Int) -- btype in ParseIface.y
pREC_CON = (2 :: Int) -- atype in ParseIface.y
maybeParen :: Bool -> SDoc -> SDoc
maybeParen True p = parens p
maybeParen False p = p
-- 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
......@@ -296,46 +306,49 @@ pprHsType ty = ppr_mono_ty pREC_TOP ty
pprParendHsType ty = ppr_mono_ty pREC_CON ty
ppr_mono_ty ctxt_prec (HsForAllTy maybe_tvs ctxt ty)
= maybeParen (ctxt_prec >= pREC_FUN) $
= maybeParen ctxt_prec pREC_FUN $
sep [pp_header, pprHsType ty]
where
pp_header = case maybe_tvs of
Just tvs -> pprHsForAll tvs ctxt
Nothing -> pprHsContext ctxt
ppr_mono_ty ctxt_prec (HsTyVar name)
= ppr name
ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)
= let p1 = ppr_mono_ty pREC_FUN ty1
p2 = ppr_mono_ty pREC_TOP ty2
in
maybeParen (ctxt_prec >= pREC_FUN)
(sep [p1, ptext SLIT("->") <+> p2])
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) = hsTupParens con (interpp'SP tys)
ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_ty pREC_TOP ty <+> dcolon <+> pprKind kind)
ppr_mono_ty ctxt_prec (HsListTy ty) = brackets (ppr_mono_ty pREC_TOP ty)
ppr_mono_ty ctxt_prec (HsPArrTy ty) = pabrackets (ppr_mono_ty pREC_TOP ty)
where
pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
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 (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 (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)
= braces (ppr pred)
ppr_mono_ty ctxt_prec (HsOpTy ty1 HsArrow ty2)
= ppr_fun_ty ctxt_prec ty1 ty2
ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) =
maybeParen (ctxt_prec >= pREC_FUN)
(ppr_mono_ty pREC_FUN ty1 <+> ppr op <+> ppr_mono_ty pREC_FUN ty2)
ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)
= maybeParen ctxt_prec pREC_OP $
ppr_mono_ty pREC_OP ty1 <+> ppr op <+> ppr_mono_ty pREC_OP ty2
ppr_mono_ty ctxt_prec (HsParTy ty) = ppr_mono_ty ctxt_prec ty
-- `HsParTy' isn't useful for pretty printing, as it is removed by the type
-- checker and we need to be able to pretty print after type checking
ppr_mono_ty ctxt_prec (HsParTy ty)
= parens (ppr_mono_ty 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_mono_ty ctxt_prec (HsNumTy n) = integer n -- generics only
--------------------------
ppr_fun_ty ctxt_prec ty1 ty2
= let p1 = ppr_mono_ty pREC_FUN ty1
p2 = ppr_mono_ty pREC_TOP ty2
in
maybeParen ctxt_prec pREC_FUN $
sep [p1, ptext SLIT("->") <+> p2]
--------------------------
pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
\end{code}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment