Fix recursive superclasses (again). Fixes Trac #4809.

[ghc-hetmet.git] / compiler / coreSyn / PprCore.lhs

diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs
index c78516a..041b842 100644 (file)
--- a/compiler/coreSyn/PprCore.lhs
+++ b/compiler/coreSyn/PprCore.lhs
@@ -186,7 +186,7 @@ ppr_expr add_par (Case expr var ty alts)
                <+> pprCoreExpr expr
                <+> ifPprDebug (braces (ppr ty)),
              ptext (sLit "of") <+> ppr_bndr var <+> char '{'],
-        nest 2 (sep (punctuate semi (map pprCoreAlt alts))),
+        nest 2 (vcat (punctuate semi (map pprCoreAlt alts))),
         char '}'
     ]
   where
@@ -415,8 +415,7 @@ instance Outputable Unfolding where
   ppr NoUnfolding               = ptext (sLit "No unfolding")
   ppr (OtherCon cs)             = ptext (sLit "OtherCon") <+> ppr cs
   ppr (DFunUnfolding ar con ops) = ptext (sLit "DFun") <> parens (ptext (sLit "arity=") <> int ar)  
-                                   <+> ppr con
-                                   <+> brackets (pprWithCommas pprParendExpr ops)
+                                   <+> ppr con <+> brackets (pprWithCommas ppr ops)
   ppr (CoreUnfolding { uf_src = src
                      , uf_tmpl=rhs, uf_is_top=top, uf_is_value=hnf
                      , uf_is_conlike=conlike, uf_is_cheap=cheap
@@ -437,6 +436,11 @@ instance Outputable Unfolding where
              | otherwise          = empty
             -- Don't print the RHS or we get a quadratic 
            -- blowup in the size of the printout!
+
+instance Outputable e => Outputable (DFunArg e) where
+  ppr (DFunPolyArg e)  = braces (ppr e)
+  ppr (DFunConstArg e) = ppr e
+  ppr (DFunLamArg i)   = char '<' <> int i <> char '>'
 \end{code}
 
 -----------------------------------------------------