[project @ 1997-03-14 07:52:06 by simonpj]

[ghc-hetmet.git] / ghc / compiler / absCSyn / CLabel.lhs

diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs
index c4f8ae6..7c9444c 100644 (file)
--- a/ghc/compiler/absCSyn/CLabel.lhs
+++ b/ghc/compiler/absCSyn/CLabel.lhs
@@ -61,16 +61,16 @@ import Id           ( externallyVisibleId, cmpId_withSpecDataCon,
                          isConstMethodId_maybe,
                          isDefaultMethodId_maybe,
                          isSuperDictSelId_maybe, fIRST_TAG,
-                         ConTag(..), GenId{-instance Outputable-}
+                         SYN_IE(ConTag), GenId{-instance Outputable-}
                        )
 import Maybes          ( maybeToBool )
 import PprStyle                ( PprStyle(..) )
 import PprType         ( showTyCon, GenType{-instance Outputable-} )
-import Pretty          ( prettyToUn )
+import Pretty          ( prettyToUn{-, ppPStr ToDo:rm-} )
 import TyCon           ( TyCon{-instance Eq-} )
 import Unique          ( showUnique, pprUnique, Unique{-instance Eq-} )
 import Unpretty                -- NOTE!! ********************
-import Util            ( assertPanic )
+import Util            ( assertPanic{-, pprTraceToDo:rm-} )
 \end{code}
 
 things we want to find out:
@@ -290,22 +290,16 @@ isAsmTemp _                  = False
 \end{code}
 
 C ``static'' or not...
+From the point of view of the code generator, a name is
+externally visible if it should be given put in the .o file's 
+symbol table; that is, made static.
+
 \begin{code}
 externallyVisibleCLabel (TyConLabel tc _) = True
 externallyVisibleCLabel (CaseLabel _ _)          = False
 externallyVisibleCLabel (AsmTempLabel _)  = False
 externallyVisibleCLabel (RtsLabel _)     = True
-externallyVisibleCLabel (IdLabel (CLabelId id) _)
-  | isDataCon id         = True
-  | is_ConstMethodId id   = True  -- These are here to ensure splitting works
-  | isDictFunId id       = True  -- when these values have not been exported
-  | is_DefaultMethodId id = True
-  | is_SuperDictSelId id  = True
-  | otherwise            = externallyVisibleId id
-  where
-    is_ConstMethodId   id = maybeToBool (isConstMethodId_maybe   id)
-    is_DefaultMethodId id = maybeToBool (isDefaultMethodId_maybe id)
-    is_SuperDictSelId  id = maybeToBool (isSuperDictSelId_maybe  id)
+externallyVisibleCLabel (IdLabel (CLabelId id) _) = externallyVisibleId id
 \end{code}
 
 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
@@ -335,11 +329,11 @@ pprCLabel (PprForAsm prepend_cSEP _) lbl
     prLbl = pprCLabel PprForC lbl
 
 pprCLabel sty (TyConLabel tc UnvecConUpdCode)
-  = uppBesides [uppPStr SLIT("ret"), pp_cSEP, uppStr (showTyCon sty tc),
+  = uppBesides [uppPStr SLIT("ret"), pp_cSEP, ppr_tycon sty tc,
               pp_cSEP, uppPStr SLIT("upd")]
 
 pprCLabel sty (TyConLabel tc (VecConUpdCode tag))
-  = uppBesides [uppPStr SLIT("ret"), pp_cSEP, uppStr (showTyCon sty tc), pp_cSEP,
+  = uppBesides [uppPStr SLIT("ret"), pp_cSEP, ppr_tycon sty tc, pp_cSEP,
                     uppInt tag, pp_cSEP, uppPStr SLIT("upd")]
 
 pprCLabel sty (TyConLabel tc (StdUpdCode tag))
@@ -348,10 +342,10 @@ pprCLabel sty (TyConLabel tc (StdUpdCode tag))
        VectoredReturn _ -> uppBeside (uppPStr SLIT("IndUpdRetV")) (uppInt (tag - fIRST_TAG))
 
 pprCLabel sty (TyConLabel tc InfoTblVecTbl)
-  = uppBesides [uppStr (showTyCon sty tc), pp_cSEP, uppPStr SLIT("itblvtbl")]
+  = uppBesides [ppr_tycon sty tc, pp_cSEP, uppPStr SLIT("itblvtbl")]
 
 pprCLabel sty (TyConLabel tc StdUpdVecTbl)
-  = uppBesides [uppPStr SLIT("vtbl"), pp_cSEP, uppStr (showTyCon sty tc),
+  = uppBesides [uppPStr SLIT("vtbl"), pp_cSEP, ppr_tycon sty tc,
               pp_cSEP, uppPStr SLIT("upd")]
 
 pprCLabel sty (CaseLabel u CaseReturnPt)
@@ -369,12 +363,12 @@ pprCLabel sty (RtsLabel RtsBlackHoleInfoTbl) = uppPStr SLIT("BH_UPD_info")
 
 pprCLabel sty (RtsLabel (RtsSelectorInfoTbl upd_reqd offset))
   = uppBesides [uppPStr SLIT("__sel_info_"), uppStr (show offset),
-               uppStr (if upd_reqd then "upd" else "noupd"),
+               uppPStr (if upd_reqd then SLIT("upd") else SLIT("noupd")),
                uppPStr SLIT("__")]
 
 pprCLabel sty (RtsLabel (RtsSelectorEntry upd_reqd offset))
   = uppBesides [uppPStr SLIT("__sel_entry_"), uppStr (show offset),
-               uppStr (if upd_reqd then "upd" else "noupd"),
+               uppPStr (if upd_reqd then SLIT("upd") else SLIT("noupd")),
                uppPStr SLIT("__")]
 
 pprCLabel sty (IdLabel (CLabelId id) flavor)
@@ -382,6 +376,13 @@ pprCLabel sty (IdLabel (CLabelId id) flavor)
 
 ppr_u u = prettyToUn (pprUnique u)
 
+ppr_tycon sty tc
+  = let
+       str = showTyCon sty tc
+    in
+    --pprTrace "ppr_tycon:" (ppStr str) $
+    uppStr str
+
 ppFlavor :: IdLabelInfo -> Unpretty
 
 ppFlavor x = uppBeside pp_cSEP