diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs
index 3ff646ca07d534c14186ced02cfcfff2a3dbd97e..ebdde2d31a757813fbf9085a082c39c440fddc44 100644
--- a/compiler/codeGen/CgHeapery.lhs
+++ b/compiler/codeGen/CgHeapery.lhs
@@ -185,7 +185,7 @@ mkStaticClosureFields cl_info ccs caf_refs payload
= mkStaticClosure info_lbl ccs payload padding_wds
static_link_field saved_info_field
where
- info_lbl = infoTableLabelFromCI cl_info $ clHasCafRefs cl_info
+ info_lbl = infoTableLabelFromCI cl_info
-- CAFs must have consistent layout, regardless of whether they
-- are actually updatable or not. The layout of a CAF is:
@@ -302,7 +302,7 @@ hpStkCheck cl_info is_fun reg_save_code code
-- Strictly speaking, we should tag node here. But if
-- node doesn't point to the closure, the code for the closure
-- cannot depend on the value of R1 anyway, so we're safe.
- closure_lbl = closureLabelFromCI cl_info (clHasCafRefs cl_info)
+ closure_lbl = closureLabelFromCI cl_info
full_save_code = node_asst `plusStmts` reg_save_code
@@ -570,8 +570,7 @@ allocDynClosure cl_info use_cc _blame_cc amodes_with_offsets
-- Remember, virtHp points to last allocated word,
-- ie 1 *before* the info-ptr word of new object.
- info_ptr = CmmLit (CmmLabel (infoTableLabelFromCI cl_info
- (clHasCafRefs cl_info)))
+ info_ptr = CmmLit (CmmLabel (infoTableLabelFromCI cl_info))
hdr_w_offsets = initDynHdr info_ptr use_cc `zip` [0..]
-- SAY WHAT WE ARE ABOUT TO DO
diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index 093b9ffaab9ce7528d471a50692595eef7e2bd00..76a433b48e6a479fa9fe2308ec17297029a506ab 100644
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -59,7 +59,7 @@ emitClosureCodeAndInfoTable cl_info args body
; info <- mkCmmInfo cl_info
; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks }
where
- info_lbl = infoTableLabelFromCI cl_info $ clHasCafRefs cl_info
+ info_lbl = infoTableLabelFromCI cl_info
-- We keep the *zero-indexed* tag in the srt_len field of the info
-- table of a data constructor.
@@ -105,7 +105,7 @@ mkCmmInfo cl_info = do
ThunkInfo (ptrs, nptrs) srt
_ -> panic "unexpected lambda form in mkCmmInfo"
where
- info_lbl = infoTableLabelFromCI cl_info has_caf_refs
+ info_lbl = infoTableLabelFromCI cl_info
has_caf_refs = clHasCafRefs cl_info
cl_type = smRepClosureTypeInt (closureSMRep cl_info)
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index effa7a42d63cd370368c1e8317dc215a33f8c2f8..1d2902188ca4710b727e580e5ea067b4e114de34 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -47,7 +47,7 @@ module CgUtils (
packHalfWordsCLit,
blankWord,
- getSRTInfo, clHasCafRefs
+ getSRTInfo
) where
#include "HsVersions.h"
@@ -995,12 +995,6 @@ getSRTInfo = do
srt_escape = (-1) :: StgHalfWord
-clHasCafRefs :: ClosureInfo -> CafInfo
-clHasCafRefs (ClosureInfo {closureSRT = srt}) =
- case srt of NoC_SRT -> NoCafRefs
- _ -> MayHaveCafRefs
-clHasCafRefs (ConInfo {}) = NoCafRefs
-
-- -----------------------------------------------------------------------------
--
-- STG/Cmm GlobalReg
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index daf476adfc5b569160b7dad45b8992382935c05d..ad2ea4fdddd64f346dfe86f72d49444134ba7244 100644
--- a/compiler/codeGen/ClosureInfo.lhs
+++ b/compiler/codeGen/ClosureInfo.lhs
@@ -35,7 +35,7 @@ module ClosureInfo (
closureNeedsUpdSpace, closureIsThunk,
closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
closureFunInfo, isStandardFormThunk, isKnownFun,
- funTag, funTagLFInfo, tagForArity,
+ funTag, funTagLFInfo, tagForArity, clHasCafRefs,
enterIdLabel, enterLocalIdLabel, enterReturnPtLabel,
@@ -59,7 +59,6 @@ module ClosureInfo (
#include "../includes/MachDeps.h"
#include "HsVersions.h"
---import CgUtils
import StgSyn
import SMRep
@@ -909,6 +908,12 @@ funTagLFInfo lf
tagForArity :: Int -> Maybe Int
tagForArity i | i <= mAX_PTR_TAG = Just i
| otherwise = Nothing
+
+clHasCafRefs :: ClosureInfo -> CafInfo
+clHasCafRefs (ClosureInfo {closureSRT = srt}) =
+ case srt of NoC_SRT -> NoCafRefs
+ _ -> MayHaveCafRefs
+clHasCafRefs (ConInfo {}) = NoCafRefs
\end{code}
\begin{code}
@@ -924,9 +929,9 @@ isToplevClosure _ = False
Label generation.
\begin{code}
-infoTableLabelFromCI :: ClosureInfo -> CafInfo -> CLabel
-infoTableLabelFromCI (ClosureInfo { closureName = name,
- closureLFInfo = lf_info }) caf
+infoTableLabelFromCI :: ClosureInfo -> CLabel
+infoTableLabelFromCI cl@(ClosureInfo { closureName = name,
+ closureLFInfo = lf_info })
= case lf_info of
LFBlackHole info -> info
@@ -936,23 +941,23 @@ infoTableLabelFromCI (ClosureInfo { closureName = name,
LFThunk _ _ upd_flag (ApThunk arity) _ ->
mkApInfoTableLabel upd_flag arity
- LFThunk{} -> mkInfoTableLabel name caf
+ LFThunk{} -> mkInfoTableLabel name $ clHasCafRefs cl
- LFReEntrant _ _ _ _ -> mkInfoTableLabel name caf
+ LFReEntrant _ _ _ _ -> mkInfoTableLabel name $ clHasCafRefs cl
_ -> panic "infoTableLabelFromCI"
-infoTableLabelFromCI (ConInfo { closureCon = con,
- closureSMRep = rep }) caf
- | isStaticRep rep = mkStaticInfoTableLabel name caf
- | otherwise = mkConInfoTableLabel name caf
+infoTableLabelFromCI cl@(ConInfo { closureCon = con,
+ closureSMRep = rep })
+ | isStaticRep rep = mkStaticInfoTableLabel name $ clHasCafRefs cl
+ | otherwise = mkConInfoTableLabel name $ clHasCafRefs cl
where
name = dataConName con
-- ClosureInfo for a closure (as opposed to a constructor) is always local
-closureLabelFromCI :: ClosureInfo -> CafInfo -> CLabel
-closureLabelFromCI (ClosureInfo { closureName = nm }) caf = mkLocalClosureLabel nm caf
-closureLabelFromCI _ _ = panic "closureLabelFromCI"
+closureLabelFromCI :: ClosureInfo -> CLabel
+closureLabelFromCI cl@(ClosureInfo { closureName = nm }) = mkLocalClosureLabel nm $ clHasCafRefs cl
+closureLabelFromCI _ = panic "closureLabelFromCI"
-- thunkEntryLabel is a local help function, not exported. It's used from both
-- entryLabelFromCI and getCallMethod.