[project @ 2000-06-07 15:33:50 by keithw]
authorkeithw <unknown>
Wed, 7 Jun 2000 15:33:50 +0000 (15:33 +0000)
committerkeithw <unknown>
Wed, 7 Jun 2000 15:33:50 +0000 (15:33 +0000)
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

index c7f3c2f..4124ad8 100644 (file)
@@ -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