From b9fcd926be155ddf79d65d61bd0caa04244b32a3 Mon Sep 17 00:00:00 2001
From: keithw <unknown>
Date: Wed, 7 Jun 2000 15:33:50 +0000
Subject: [PATCH] [project @ 2000-06-07 15:33:50 by keithw] Fix printing of
unfoldings in hi-files: lambda binders are now grouped again like they used
to be, rather than printed one-at-a-time.
---
ghc/compiler/hsSyn/HsCore.lhs | 12 +++++++++++-
1 file changed, 11 insertions(+), 1 deletion(-)
diff --git a/ghc/compiler/hsSyn/HsCore.lhs b/ghc/compiler/hsSyn/HsCore.lhs
index c7f3c2fe4a58..4124ad83f8d1 100644
--- a/ghc/compiler/hsSyn/HsCore.lhs
+++ b/ghc/compiler/hsSyn/HsCore.lhs
@@ -194,7 +194,10 @@ pprUfExpr add_par (UfLit l) = ppr l
pprUfExpr add_par (UfLitLit l ty) = add_par (hsep [ptext SLIT("__litlit"), pprFSAsString l, pprParendHsType ty])
pprUfExpr add_par (UfCCall cc ty) = braces (pprCCallOp cc <+> ppr ty)
pprUfExpr add_par (UfType ty) = char '@' <+> pprParendHsType ty
-pprUfExpr add_par (UfLam b body) = add_par (hsep [char '\\', ppr b, ptext SLIT("->"), pprUfExpr noParens body])
+
+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 (UfTuple c as) = hsTupParens c (interpp'SP as)
@@ -220,6 +223,13 @@ pprUfExpr add_par (UfLet (UfRec pairs) body)
pprUfExpr add_par (UfNote note body) = add_par (ppr note <+> pprUfExpr parens body)
+collectUfBndrs :: UfExpr name -> ([UfBinder name], UfExpr name)
+collectUfBndrs expr
+ = go [] expr
+ where
+ go bs (UfLam b e) = go (b:bs) e
+ go bs e = (reverse bs, e)
+
instance Outputable name => Outputable (UfNote name) where
ppr (UfSCC cc) = pprCostCentreCore cc
ppr (UfCoerce ty) = ptext SLIT("__coerce") <+> pprParendHsType ty
--
GitLab