X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsCore.lhs;h=23d4d01e9f41d4273e5ff5f8321dc3514dfcc579;hb=4bac90dcd705b922910995b2cdf2fc4ee7a0f09b;hp=424401f279d338910ae540a720acbc2904c457af;hpb=11980a5d6609e95f22b74b48f37b1dfa323bd9a5;p=ghc-hetmet.git

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