summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndreas Klebinger <klebinger.andreas@gmx.at>2022-02-25 14:51:47 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-02-28 19:17:12 -0500
commit4f0208e53444d32c7f3795b3ac15acbfc75bf58c (patch)
treed06a70f2bd3b00503ba87666fcbe12cc525aa462
parentadfddf7de3a9c1f757cbf027815a4b4f6ee86a7e (diff)
downloadhaskell-4f0208e53444d32c7f3795b3ac15acbfc75bf58c.tar.gz
CLabel cleanup:
Remove these smart constructors for these reasons: * mkLocalClosureTableLabel : Does the same as the non-local variant. * mkLocalClosureLabel : Does the same as the non-local variant. * mkLocalInfoTableLabel : Decide if we make a local label based on the name and just use mkInfoTableLabel everywhere.
-rw-r--r--compiler/GHC/Cmm/CLabel.hs16
-rw-r--r--compiler/GHC/Cmm/Info/Build.hs4
-rw-r--r--compiler/GHC/StgToCmm.hs4
-rw-r--r--compiler/GHC/StgToCmm/Bind.hs2
-rw-r--r--compiler/GHC/StgToCmm/Closure.hs13
5 files changed, 11 insertions, 28 deletions
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index dd7e1f14f5..933151a679 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -33,9 +33,6 @@ module GHC.Cmm.CLabel (
mkBytesLabel,
mkLocalBlockLabel,
- mkLocalClosureLabel,
- mkLocalInfoTableLabel,
- mkLocalClosureTableLabel,
mkBlockInfoTableLabel,
@@ -587,14 +584,6 @@ mkRednCountsLabel name = IdLabel name NoCafRefs (IdTickyInfo TickyRednCounts)
mkTagHitLabel :: Name -> Unique -> CLabel
mkTagHitLabel name !uniq = IdLabel name NoCafRefs (IdTickyInfo (TickyInferedTag uniq))
--- These have local & (possibly) external variants:
-mkLocalClosureLabel :: Name -> CafInfo -> CLabel
-mkLocalInfoTableLabel :: Name -> CafInfo -> CLabel
-mkLocalClosureTableLabel :: Name -> CafInfo -> CLabel
-mkLocalClosureLabel !name !c = IdLabel name c Closure
-mkLocalInfoTableLabel name c = IdLabel name c LocalInfoTable
-mkLocalClosureTableLabel name c = IdLabel name c ClosureTable
-
mkClosureLabel :: Name -> CafInfo -> CLabel
mkInfoTableLabel :: Name -> CafInfo -> CLabel
mkEntryLabel :: Name -> CafInfo -> CLabel
@@ -602,7 +591,10 @@ mkClosureTableLabel :: Name -> CafInfo -> CLabel
mkConInfoTableLabel :: Name -> ConInfoTableLocation -> CLabel
mkBytesLabel :: Name -> CLabel
mkClosureLabel name c = IdLabel name c Closure
-mkInfoTableLabel name c = IdLabel name c InfoTable
+-- | Decicdes between external and local labels based on the names externality.
+mkInfoTableLabel name c
+ | isExternalName name = IdLabel name c InfoTable
+ | otherwise = IdLabel name c LocalInfoTable
mkEntryLabel name c = IdLabel name c Entry
mkClosureTableLabel name c = IdLabel name c ClosureTable
-- Special case for the normal 'DefinitionSite' case so that the 'ConInfoTable' application can be floated to a CAF.
diff --git a/compiler/GHC/Cmm/Info/Build.hs b/compiler/GHC/Cmm/Info/Build.hs
index 571a1faae7..4087225146 100644
--- a/compiler/GHC/Cmm/Info/Build.hs
+++ b/compiler/GHC/Cmm/Info/Build.hs
@@ -757,7 +757,7 @@ getStaticFuns decls =
, Just (id, _) <- [cit_clo info]
, let rep = cit_rep info
, isStaticRep rep && isFunRep rep
- , let !lbl = mkLocalClosureLabel (idName id) (idCafInfo id)
+ , let !lbl = mkClosureLabel (idName id) (idCafInfo id)
]
@@ -1219,7 +1219,7 @@ updInfoSRTs profile srt_env funSRTEnv caffy (CmmProc top_info top_l live g)
HeapRep sta ptrs nptrs ty ->
HeapRep sta (ptrs + length srtEntries) nptrs ty
_other -> panic "maybeStaticFun"
- lbl = mkLocalClosureLabel (idName id) caf_info
+ lbl = mkClosureLabel (idName id) caf_info
in
Just (newInfo, mkDataLits (Section Data lbl) lbl fields)
| otherwise = Nothing
diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs
index eea77198aa..3075182af6 100644
--- a/compiler/GHC/StgToCmm.hs
+++ b/compiler/GHC/StgToCmm.hs
@@ -235,8 +235,8 @@ mkModuleInit cost_centre_info this_mod hpc_info
cgEnumerationTyCon :: TyCon -> FCode ()
cgEnumerationTyCon tycon
= do platform <- getPlatform
- emitRODataLits (mkLocalClosureTableLabel (tyConName tycon) NoCafRefs)
- [ CmmLabelOff (mkLocalClosureLabel (dataConName con) NoCafRefs)
+ emitRODataLits (mkClosureTableLabel (tyConName tycon) NoCafRefs)
+ [ CmmLabelOff (mkClosureLabel (dataConName con) NoCafRefs)
(tagForCon platform con)
| con <- tyConDataCons tycon]
diff --git a/compiler/GHC/StgToCmm/Bind.hs b/compiler/GHC/StgToCmm/Bind.hs
index 25d04b323c..17d8556b15 100644
--- a/compiler/GHC/StgToCmm/Bind.hs
+++ b/compiler/GHC/StgToCmm/Bind.hs
@@ -81,7 +81,7 @@ cgTopRhsClosure :: Platform
-> (CgIdInfo, FCode ())
cgTopRhsClosure platform rec id ccs upd_flag args body =
- let closure_label = mkLocalClosureLabel (idName id) (idCafInfo id)
+ let closure_label = mkClosureLabel (idName id) (idCafInfo id)
cg_id_info = litIdInfo platform id lf_info (CmmLabel closure_label)
lf_info = mkClosureLFInfo platform id TopLevel [] upd_flag args
in (cg_id_info, gen_code lf_info closure_label)
diff --git a/compiler/GHC/StgToCmm/Closure.hs b/compiler/GHC/StgToCmm/Closure.hs
index 0d048a6be8..2609606292 100644
--- a/compiler/GHC/StgToCmm/Closure.hs
+++ b/compiler/GHC/StgToCmm/Closure.hs
@@ -848,23 +848,14 @@ mkClosureInfoTableLabel platform id lf_info
LFThunk _ _ upd_flag (ApThunk arity) _
-> mkApInfoTableLabel platform upd_flag arity
- LFThunk{} -> std_mk_lbl name cafs
- LFReEntrant{} -> std_mk_lbl name cafs
+ LFThunk{} -> mkInfoTableLabel name cafs
+ LFReEntrant{} -> mkInfoTableLabel name cafs
_other -> panic "closureInfoTableLabel"
where
name = idName id
- std_mk_lbl | is_local = mkLocalInfoTableLabel
- | otherwise = mkInfoTableLabel
-
cafs = idCafInfo id
- is_local = isDataConWorkId id
- -- Make the _info pointer for the implicit datacon worker
- -- binding local. The reason we can do this is that importing
- -- code always either uses the _closure or _con_info. By the
- -- invariants in "GHC.CoreToStg.Prep" anything else gets eta expanded.
-
-- | thunkEntryLabel is a local help function, not exported. It's used from
-- getCallMethod.