From: simonpj <unknown>
Date: Thu, 11 Jan 2001 13:58:05 +0000 (+0000)
Subject: [project @ 2001-01-11 13:58:05 by simonpj]
X-Git-Tag: Approximately_9120_patches~2948
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=4bac90dcd705b922910995b2cdf2fc4ee7a0f09b;p=ghc-hetmet.git

[project @ 2001-01-11 13:58:05 by simonpj]
Fix a grotesque bug in the HsCore.pprUfExpr
The expression

	((\x -> f x y) a b)

printed as

	(\x -> f x y a b)

which in turn caused any importing module to
behave most oddly.

This didn't show up before, because such expressions don't
happen much (they are simplified).  But one showed up in a
RULE (which happens to be simplified only very gently), and
that tickled this bug.
---

diff --git a/ghc/compiler/hsSyn/HsCore.lhs b/ghc/compiler/hsSyn/HsCore.lhs
index 424401f..23d4d01 100644
--- a/ghc/compiler/hsSyn/HsCore.lhs
+++ b/ghc/compiler/hsSyn/HsCore.lhs
@@ -213,7 +213,7 @@ pprUfExpr add_par (UfType ty)     = char '@' <+> pprParendHsType ty
 pprUfExpr add_par e@(UfLam _ _)   = add_par (char '\\' <+> hsep (map ppr bndrs)
                                              <+> ptext SLIT("->") <+> pprUfExpr noParens body)
                                   where (bndrs,body) = collectUfBndrs e
-pprUfExpr add_par (UfApp fun arg) = add_par (pprUfExpr noParens fun <+> pprUfExpr parens arg)
+pprUfExpr add_par app@(UfApp _ _) = add_par (pprUfApp app)
 pprUfExpr add_par (UfTuple c as)  = hsTupParens c (interpp'SP as)
 
 pprUfExpr add_par (UfCase scrut bndr alts)
@@ -242,6 +242,8 @@ pprUfExpr add_par (UfLet (UfRec pairs) body)
 
 pprUfExpr add_par (UfNote note body) = add_par (ppr note <+> pprUfExpr parens body)
 
+pprUfApp (UfApp fun arg) = pprUfApp fun <+> pprUfExpr parens arg
+pprUfApp fun	         = pprUfExpr parens fun
 
 collectUfBndrs :: UfExpr name -> ([UfBinder name], UfExpr name)
 collectUfBndrs expr