X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCLabel.hs;fp=compiler%2Fcmm%2FCLabel.hs;h=a7dabc64d9ca5ebc922d07b19215b01543874f46;hp=901b13b3422d151d165e2fe5eb97c366074da9a7;hb=cf5905ea24904cf73a041fd7535e8723a668cb9a;hpb=25fa4bdbff4a84d6717c4ff7cdf7080687616818 diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index 901b13b..a7dabc6 100644 --- 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")