merge upstream HEAD

[ghc-hetmet.git] / compiler / cmm / CLabel.hs

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 901b13b..a7dabc6 100644 (file)
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -254,6 +254,10 @@ data ForeignLabelSource
       
    deriving (Eq, Ord)   
 
+closureSuffix' :: Name -> SDoc
+closureSuffix' hs_fn =
+    if depth==0 then ptext (sLit "") else ptext (sLit $ (show depth))
+          where depth = getNameDepth hs_fn
 
 -- | For debugging problems with the CLabel representation.
 --     We can't make a Show instance for CLabel because lots of its components don't have instances.
@@ -973,7 +977,7 @@ pprCLbl (RtsLabel (RtsSlowTickyCtr pat))
 pprCLbl (ForeignLabel str _ _ _)
   = ftext str
 
-pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor flavor
+pprCLbl (IdLabel name cafs flavor) = ppr name <> ppIdFlavor name flavor
 
 pprCLbl (CC_Label cc)          = ppr cc
 pprCLbl (CCS_Label ccs)        = ppr ccs
@@ -984,8 +988,8 @@ pprCLbl (PlainModuleInitLabel mod)
 pprCLbl (HpcTicksLabel mod)
   = ptext (sLit "_hpc_tickboxes_")  <> ppr mod <> ptext (sLit "_hpc")
 
-ppIdFlavor :: IdLabelInfo -> SDoc
-ppIdFlavor x = pp_cSEP <>
+ppIdFlavor :: Name -> IdLabelInfo -> SDoc
+ppIdFlavor n x = pp_cSEP <> closureSuffix' n <>
               (case x of
                       Closure          -> ptext (sLit "closure")
                       SRT              -> ptext (sLit "srt")