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=4e9ef8c5ae95f983dca7cc5993655e1462939933;hp=79544445d7049ed483ec96d335f720651b57e192;hb=34c8d0312071f7d0f4d221a997d3408c653ef9e5;hpb=cb8fb4dc68b503474bd65c0a669d9018a3ce96fe diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index 7954444..4e9ef8c 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -277,6 +277,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. @@ -1013,7 +1017,7 @@ pprCLbl ModuleRegdLabel 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 @@ -1034,8 +1038,8 @@ pprCLbl (HpcTicksLabel mod) pprCLbl HpcModuleNameLabel = ptext (sLit "_hpc_module_name_str") -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")