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=c40f3b7b609cc688f67f655c939c0ffb905ab570;hp=c151a263915a46c8658cf57aaa690ad23c140eea;hb=6cec61d14a324285dbb8ce73d4c7215f1f8d6766;hpb=11b33eaeaef39fcba8ee9258213068ed90362aa7 diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index c151a26..c40f3b7 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. @@ -965,7 +969,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 @@ -976,8 +980,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")