diff options
| -rw-r--r-- | compiler/GHC/Cmm/CLabel.hs | 16 | ||||
| -rw-r--r-- | compiler/GHC/Cmm/Info/Build.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/StgToCmm.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/StgToCmm/Bind.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/StgToCmm/Closure.hs | 13 |
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. |