merge GHC HEAD

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

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index c151a26..1ba1126 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.
@@ -592,7 +596,7 @@ maybeAsmTemp _                              = Nothing
 
 -- | Check whether a label corresponds to a C function that has 
 --      a prototype in a system header somehere, or is built-in
---      to the C compiler. For these labels we abovoid generating our
+--      to the C compiler. For these labels we avoid generating our
 --      own C prototypes.
 isMathFun :: CLabel -> Bool
 isMathFun (ForeignLabel fs _ _ _)      = fs `elementOfUniqSet` math_funs
@@ -850,8 +854,8 @@ instance Outputable CLabel where
 
 pprCLabel :: CLabel -> SDoc
 
-#if ! OMIT_NATIVE_CODEGEN
 pprCLabel (AsmTempLabel u)
+ | cGhcWithNativeCodeGen == "YES"
   =  getPprStyle $ \ sty ->
      if asmStyle sty then 
        ptext asmTempLabelPrefix <> pprUnique u
@@ -859,23 +863,22 @@ pprCLabel (AsmTempLabel u)
        char '_' <> pprUnique u
 
 pprCLabel (DynamicLinkerLabel info lbl)
+ | cGhcWithNativeCodeGen == "YES"
    = pprDynamicLinkerAsmLabel info lbl
    
 pprCLabel PicBaseLabel
+ | cGhcWithNativeCodeGen == "YES"
    = ptext (sLit "1b")
    
 pprCLabel (DeadStripPreventer lbl)
+ | cGhcWithNativeCodeGen == "YES"
    = pprCLabel lbl <> ptext (sLit "_dsp")
-#endif
 
-pprCLabel lbl = 
-#if ! OMIT_NATIVE_CODEGEN
-    getPprStyle $ \ sty ->
-    if asmStyle sty then 
-       maybe_underscore (pprAsmCLbl lbl)
-    else
-#endif
-       pprCLbl lbl
+pprCLabel lbl
+   = getPprStyle $ \ sty ->
+     if cGhcWithNativeCodeGen == "YES" && asmStyle sty
+     then maybe_underscore (pprAsmCLbl lbl)
+     else pprCLbl lbl
 
 maybe_underscore doc
   | underscorePrefix = pp_cSEP <> doc
@@ -965,7 +968,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 +979,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")