import CLabel ( mkClosureLabel )
import ClosureInfo ( mkConLFInfo, mkLFArgument, closureLFInfo,
layOutDynConstr, layOutDynClosure,
- layOutStaticConstr, closureSize
+ layOutStaticConstr, closureSize, mkStaticClosure
)
import CostCentre ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
currentCCS )
import DataCon ( DataCon, dataConName, dataConTag,
- isUnboxedTupleCon, isNullaryDataCon, dataConId,
+ isUnboxedTupleCon, isNullaryDataCon, dataConWorkId,
dataConWrapId, dataConRepArity
)
import Id ( Id, idName, idPrimRep )
cgTopRhsCon :: Id -- Name of thing bound to this RHS
-> DataCon -- Id
-> [StgArg] -- Args
+ -> SRT
-> FCode (Id, CgIdInfo)
-cgTopRhsCon id con args
- = ASSERT(not (isDllConApp con args)) -- checks for litlit args too
- ASSERT(length args == dataConRepArity con)
+cgTopRhsCon id con args srt
+ = ASSERT( not (isDllConApp con args) ) -- checks for litlit args too
+ ASSERT( args `lengthIs` dataConRepArity con )
-- LAY IT OUT
getArgAmodes args `thenFC` \ amodes ->
let
name = idName id
- closure_label = mkClosureLabel name
lf_info = closureLFInfo closure_info
- (closure_info, amodes_w_offsets) = layOutStaticConstr name con getAmodeRep amodes
+ closure_label = mkClosureLabel name
+ (closure_info, amodes_w_offsets)
+ = layOutStaticConstr name con getAmodeRep amodes
in
-- BUILD THE OBJECT
- absC (CStaticClosure
- closure_label -- Labelled with the name on lhs of defn
- closure_info -- Closure is static
- (mkCCostCentreStack dontCareCCS) -- because it's static data
- (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
-
- `thenC`
+ absC (mkStaticClosure
+ closure_info
+ dontCareCCS -- because it's static data
+ (map fst amodes_w_offsets) -- Sorted into ptrs first, then nonptrs
+ (nonEmptySRT srt) -- has CAF refs
+ ) `thenC`
+ -- NOTE: can't use idCafInfo instead of nonEmptySRT above,
+ -- because top-level constructors that were floated by
+ -- CorePrep don't have CafInfo attached. The SRT is more
+ -- reliable.
-- RETURN
returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
bindUnboxedTupleComponents args
= -- Assign as many components as possible to registers
let (arg_regs, _leftovers) = assignRegs [] (map idPrimRep args)
- (reg_args, stk_args) = splitAt (length arg_regs) args
+ (reg_args, stk_args) = splitAtList arg_regs args
in
-- Allocate the rest on the stack (ToDo: separate out pointers)
bindArgsToRegs reg_args arg_regs `thenC`
mapCs bindNewToStack stk_offsets `thenC`
- returnFC (arg_regs,tags, not (null stk_offsets))
+ returnFC (arg_regs,tags, notNull stk_offsets)
\end{code}
%************************************************************************
cgReturnDataCon :: DataCon -> [CAddrMode] -> Code
cgReturnDataCon con amodes
- = ASSERT(length amodes == dataConRepArity con)
+ = ASSERT( amodes `lengthIs` dataConRepArity con )
getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
case sequel of
-- temporary variable, if the closure is a CHARLIKE.
-- funnily enough, this makes the unique always come
-- out as '54' :-)
- buildDynCon (dataConId con) currentCCS con amodes `thenFC` \ idinfo ->
+ buildDynCon (dataConWorkId con) currentCCS con amodes `thenFC` \ idinfo ->
idInfoToAmode PtrRep idinfo `thenFC` \ amode ->