X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FPprCmm.hs;h=602f51ce4d384962ce6462387418694c271737fe;hb=1f8efd5d6214c490ef4942134abf5de9f468d29c;hp=866a1c92c50e19d2c6657381964e4e9dd06322cc;hpb=f672e79d632ade7238d51fc8da4283da71bea9a4;p=ghc-hetmet.git

diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index 866a1c9..602f51c 100644
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -129,17 +129,19 @@ instance Outputable CmmSafety where
 -- For ideas on how to refine it, they used to be printed in the
 -- style of C--'s 'stackdata' declaration, just inside the proc body,
 -- and were labelled with the procedure name ++ "_info".
-pprInfo (CmmNonInfo gc_target) =
-    ptext SLIT("gc_target: ") <>
-          ptext SLIT("TODO") --maybe (ptext SLIT("<none>")) pprBlockId gc_target
-          -- ^ gc_target is currently unused and wired to a panic
-pprInfo (CmmInfo (ProfilingInfo closure_type closure_desc)
-                 gc_target tag info) =
-    vcat [ptext SLIT("type: ") <> pprLit closure_type,
+pprInfo (CmmInfo gc_target update_frame CmmNonInfoTable) =
+    vcat [ptext SLIT("gc_target: ") <>
+                maybe (ptext SLIT("<none>")) pprBlockId gc_target,
+          ptext SLIT("update_frame: ") <>
+                maybe (ptext SLIT("<none>")) pprUpdateFrame update_frame]
+pprInfo (CmmInfo gc_target update_frame
+         (CmmInfoTable (ProfilingInfo closure_type closure_desc) tag info)) =
+    vcat [ptext SLIT("gc_target: ") <>
+                maybe (ptext SLIT("<none>")) pprBlockId gc_target,
+          ptext SLIT("update_frame: ") <>
+                maybe (ptext SLIT("<none>")) pprUpdateFrame update_frame,
+          ptext SLIT("type: ") <> pprLit closure_type,
           ptext SLIT("desc: ") <> pprLit closure_desc,
-          ptext SLIT("gc_target: ") <>
-                ptext SLIT("TODO"), --maybe (ptext SLIT("<none>")) pprBlockId gc_target,
-                -- ^ gc_target is currently unused and wired to a panic
           ptext SLIT("tag: ") <> integer (toInteger tag),
           pprTypeInfo info]
 
@@ -168,6 +170,19 @@ pprTypeInfo (ContInfo stack srt) =
     vcat [ptext SLIT("stack: ") <> ppr stack,
           ptext SLIT("srt: ") <> ppr srt]
 
+pprUpdateFrame :: UpdateFrame -> SDoc
+pprUpdateFrame (UpdateFrame expr args) = 
+    hcat [ ptext SLIT("jump")
+         , space
+         , if isTrivialCmmExpr expr
+                then pprExpr expr
+                else case expr of
+                    CmmLoad (CmmReg _) _ -> pprExpr expr 
+                    _ -> parens (pprExpr expr)
+         , space
+         , parens  ( commafy $ map ppr args ) ]
+
+
 -- --------------------------------------------------------------------------
 -- Basic blocks look like assembly blocks.
 --      lbl: stmt ; stmt ; ..