-getClosureType :: Int -> Int -> Int -> LambdaFormInfo -> ClosureType
-getClosureType tot_wds ptrs nptrs lf_info =
- case lf_info of
- LFCon con True -> CONSTR_NOCAF
-
- LFCon con False
- | tot_wds > 0 && tot_wds <= mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n ptrs nptrs
- | otherwise -> CONSTR
-
- LFReEntrant _ _ _ _ _ _
- | tot_wds > 0 && tot_wds <= mAX_SPEC_FUN_SIZE -> FUN_p_n ptrs nptrs
- | otherwise -> FUN
-
- LFTuple _ _
- | tot_wds > 0 && tot_wds <= mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n ptrs nptrs
- | otherwise -> CONSTR
-
- LFThunk _ _ _ _ (SelectorThunk _) _ _ -> THUNK_SELECTOR
-
- LFThunk _ _ _ _ _ _ _
- | tot_wds > 0 && tot_wds <= mAX_SPEC_THUNK_SIZE -> THUNK_p_n ptrs nptrs
- | otherwise -> THUNK
-
- _ -> panic "getClosureType"
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
-%* *
-%************************************************************************
-
-@mkVirtHeapOffsets@ (the heap version) always returns boxed things with
-smaller offsets than the unboxed things, and furthermore, the offsets in
-the result list
-
-\begin{code}
-mkVirtHeapOffsets :: SMRep -- Representation to be used by storage manager
- -> (a -> PrimRep) -- To be able to grab kinds;
- -- w/ a kind, we can find boxedness
- -> [a] -- Things to make offsets for
- -> (Int, -- *Total* number of words allocated
- Int, -- Number of words allocated for *pointers*
- [(a, VirtualHeapOffset)])
- -- Things with their offsets from start of
- -- object in order of increasing offset
-
--- First in list gets lowest offset, which is initial offset + 1.
-
-mkVirtHeapOffsets sm_rep kind_fun things
- = let (ptrs, non_ptrs) = separateByPtrFollowness kind_fun things
- (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
- (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
- in
- (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
- where
- computeOffset wds_so_far thing
- = (wds_so_far + (getPrimRepSize . kind_fun) thing,
- (thing, fixedHdrSize + wds_so_far)
- )
+getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType
+getClosureType is_static ptr_wds lf_info
+ = case lf_info of
+ LFCon con | is_static && ptr_wds == 0 -> ConstrNoCaf
+ | otherwise -> Constr
+ LFReEntrant _ _ _ _ -> Fun
+ LFThunk _ _ _ (SelectorThunk _) _ -> ThunkSelector
+ LFThunk _ _ _ _ _ -> Thunk
+ _ -> panic "getClosureType"