X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FPprCmm.hs;h=d8d34c32c2e1b9396b7da5f100d89913a73a479c;hb=f4b727487a65e6b611bbaafbd2207bd63a8df706;hp=4478dfd966d72cf3d222b6c0f1d934969c1c8696;hpb=176fa33f17dd78355cc572e006d2ab26898e2c69;p=ghc-hetmet.git

diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index 4478dfd..d8d34c3 100644
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -42,10 +42,10 @@ import BlockId
 import Cmm
 import CmmUtils
 import CLabel
+import BasicTypes
 
 
 import ForeignCall
-import Unique
 import Outputable
 import FastString
 
@@ -56,7 +56,7 @@ import Data.Maybe
 -- Temp Jan08
 import SMRep
 import ClosureInfo
-#include "../includes/StgFun.h"
+#include "../includes/rts/storage/FunTypes.h"
 
 
 pprCmms :: (Outputable info, Outputable g) => [GenCmm CmmStatic info g] -> SDoc
@@ -115,7 +115,7 @@ instance Outputable CmmInfo where
 -----------------------------------------------------------------------------
 
 pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc
-pprCmm (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
+pprCmm (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops
 
 -- --------------------------------------------------------------------------
 -- Top level `procedure' blocks.
@@ -125,7 +125,7 @@ pprTop 	:: (Outputable d, Outputable info, Outputable i)
 
 pprTop (CmmProc info lbl params graph )
 
-  = vcat [ pprCLabel lbl <> parens (commafy $ map ppr params) <+> lbrace
+  = vcat [ pprCLabel lbl <> parens (commafy $ map ppr params)
          , nest 8 $ lbrace <+> ppr info $$ rbrace
          , nest 4 $ ppr graph
          , rbrace ]
@@ -154,13 +154,14 @@ instance Outputable CmmSafety where
 pprInfo :: CmmInfo -> SDoc
 pprInfo (CmmInfo _gc_target update_frame CmmNonInfoTable) =
     vcat [{-ptext (sLit "gc_target: ") <>
-                maybe (ptext (sLit "<none>")) pprBlockId gc_target,-}
+                maybe (ptext (sLit "<none>")) ppr 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)) =
+         (CmmInfoTable stat_clos (ProfilingInfo closure_type closure_desc) tag info)) =
     vcat [{-ptext (sLit "gc_target: ") <>
-                maybe (ptext (sLit "<none>")) pprBlockId gc_target,-}
+                maybe (ptext (sLit "<none>")) ppr gc_target,-}
+          ptext (sLit "has static closure: ") <> ppr stat_clos <+>
           ptext (sLit "update_frame: ") <>
                 maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame,
           ptext (sLit "type: ") <> pprLit closure_type,
@@ -228,7 +229,7 @@ pprUpdateFrame (UpdateFrame expr args) =
 --      lbl: stmt ; stmt ; .. 
 pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
 pprBBlock (BasicBlock ident stmts) =
-    hang (pprBlockId ident <> colon) 4 (vcat (map ppr stmts))
+    hang (ppr ident <> colon) 4 (vcat (map ppr stmts))
 
 -- --------------------------------------------------------------------------
 -- Statements. C-- usually, exceptions to this should be obvious.
@@ -275,7 +276,7 @@ pprStmt stmt = case stmt of
         pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
                         results args safety ret)
         where
-          lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
+          lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False IsFunction)
 
     CmmBranch ident          -> genBranch ident
     CmmCondBranch expr ident -> genCondBranch expr ident
@@ -302,7 +303,7 @@ instance (Outputable a) => Outputable (CmmHinted a) where
 --
 genBranch :: BlockId -> SDoc
 genBranch ident = 
-    ptext (sLit "goto") <+> pprBlockId ident <> semi
+    ptext (sLit "goto") <+> ppr ident <> semi
 
 -- --------------------------------------------------------------------------
 -- Conditional. [1], section 6.4
@@ -314,7 +315,7 @@ genCondBranch expr ident =
     hsep [ ptext (sLit "if")
          , parens(ppr expr)
          , ptext (sLit "goto")
-         , pprBlockId ident <> semi ]
+         , ppr ident <> semi ]
 
 -- --------------------------------------------------------------------------
 -- A tail call. [1], Section 6.9
@@ -381,7 +382,7 @@ genSwitch expr maybe_ids
           in hsep [ ptext (sLit "case")
                   , hcat (punctuate comma (map int is))
                   , ptext (sLit ": goto")
-                  , pprBlockId (head [ id | Just id <- ids]) <> semi ]
+                  , ppr (head [ id | Just id <- ids]) <> semi ]
 
 -- --------------------------------------------------------------------------
 -- Expressions
@@ -505,15 +506,16 @@ pprLit :: CmmLit -> SDoc
 pprLit lit = case lit of
     CmmInt i rep ->
         hcat [ (if i < 0 then parens else id)(integer i)
-             , (if rep == wordWidth
-                    then empty 
-                    else space <> dcolon <+> ppr rep) ]
+             , ppUnless (rep == wordWidth) $
+               space <> dcolon <+> ppr rep ]
 
     CmmFloat f rep     -> hsep [ rational f, dcolon, ppr rep ]
     CmmLabel clbl      -> pprCLabel clbl
     CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i
     CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'  
                                   <> pprCLabel clbl2 <> ppr_offset i
+    CmmBlock id        -> ppr id
+    CmmHighStackMark -> text "<highSp>"
 
 pprLit1 :: CmmLit -> SDoc
 pprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit)
@@ -614,12 +616,6 @@ pprSection s = case s of
  where
     section = ptext (sLit "section")
 
--- --------------------------------------------------------------------------
--- Basic block ids
---
-pprBlockId :: BlockId -> SDoc
-pprBlockId b = ppr $ getUnique b
-
 -----------------------------------------------------------------------------
 
 commafy :: [SDoc] -> SDoc