-cgReturnDataCon :: DataCon -> [CAddrMode] -> Bool -> Code
-
-cgReturnDataCon con amodes all_zero_size_args
- = getEndOfBlockInfo `thenFC` \ (EndOfBlockInfo args_sp sequel) ->
-
- case sequel of
-
- CaseAlts _ (Just (alts, Just (maybe_deflt, (_,deflt_lbl))))
- | not (dataConTag con `is_elem` map fst alts)
- ->
- -- Special case! We're returning a constructor to the default case
- -- of an enclosing case. For example:
- --
- -- case (case e of (a,b) -> C a b) of
- -- D x -> ...
- -- y -> ...<returning here!>...
- --
- -- In this case,
- -- if the default is a non-bind-default (ie does not use y),
- -- then we should simply jump to the default join point;
-
- case maybe_deflt of
- Nothing -> performReturn AbsCNop {- No reg assts -} jump_to_join_point
- Just _ -> build_it_then jump_to_join_point
- where
- is_elem = isIn "cgReturnDataCon"
- jump_to_join_point sequel = absC (CJump (CLbl deflt_lbl CodePtrRep))
- -- Ignore the sequel: we've already looked at it above
-
- -- If the sequel is an update frame, we might be able to
- -- do update in place...
- UpdateCode
- | not all_zero_size_args -- no nullary constructors, please
- && not (maybeCharLikeCon con) -- no chars please (these are all static)
- && not (any isFollowableRep (map getAmodeRep amodes))
- -- no ptrs please (generational gc...)
- && closureSize closure_info <= mIN_UPD_SIZE
- -- don't know the real size of the
- -- thunk, so assume mIN_UPD_SIZE
-
- -> -- get a new temporary and make it point to the updatee
- let
- uniq = getUnique con
- temp = CTemp uniq PtrRep
- in
- getSpRelOffset args_sp `thenFC` \ sp_rel ->
- absC (CAssign temp
- (CMacroExpr PtrRep UPD_FRAME_UPDATEE [CAddr sp_rel]))
- `thenC`
-
- -- stomp all over it with the new constructor
- inPlaceAllocDynClosure closure_info temp (CReg CurCostCentre) stuff
- `thenC`
-
- -- don't forget to update Su from the update frame
- absC (CMacroStmt UPDATE_SU_FROM_UPD_FRAME [CAddr sp_rel]) `thenC`
-
- -- set Node to point to the closure being returned
- -- (can't be done earlier: node might conflict with amodes)
- absC (CAssign (CReg node) temp) `thenC`
-
- -- pop the update frame off the stack, and do the proper
- -- return.
- let new_sp = args_sp - updateFrameSize in
- setEndOfBlockInfo (EndOfBlockInfo new_sp (OnStack new_sp)) $
- performReturn (AbsCNop) (mkStaticAlgReturnCode con)
-
- where (closure_info, stuff)
- = layOutDynClosure (dataConName con)
- getAmodeRep amodes lf_info
-
- lf_info = mkConLFInfo con
-
- other_sequel -- The usual case
-
- | isUnboxedTupleCon con ->
- -- Return unboxed tuple in registers
- let (ret_regs, leftovers) =
- assignRegs [] (map getAmodeRep amodes)
- in
- profCtrC SLIT("TICK_RET_UNBOXED_TUP")
- [mkIntCLit (length amodes)] `thenC`
-
- doTailCall amodes ret_regs
- mkUnboxedTupleReturnCode
- (length leftovers) {- fast args arity -}
- AbsCNop {-no pending assigments-}
- Nothing {-not a let-no-escape-}
- False {-node doesn't point-}
-
- | otherwise ->
- build_it_then (mkStaticAlgReturnCode con)
-
+cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
+
+cgReturnDataCon con amodes
+ = ASSERT( amodes `lengthIs` dataConRepArity con )
+ do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
+ ; case sequel of
+ CaseAlts _ (Just (alts, deflt_lbl)) bndr _
+ -> -- Ho! We know the constructor so we can
+ -- go straight to the right alternative
+ case assocMaybe alts (dataConTagZ con) of {
+ Just join_lbl -> build_it_then (jump_to join_lbl);
+ Nothing
+ -- Special case! We're returning a constructor to the default case
+ -- of an enclosing case. For example:
+ --
+ -- case (case e of (a,b) -> C a b) of
+ -- D x -> ...
+ -- y -> ...<returning here!>...
+ --
+ -- In this case,
+ -- if the default is a non-bind-default (ie does not use y),
+ -- then we should simply jump to the default join point;
+
+ | isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
+ | otherwise -> build_it_then (jump_to deflt_lbl) }
+
+ other_sequel -- The usual case
+ | isUnboxedTupleCon con -> returnUnboxedTuple amodes
+ | otherwise -> build_it_then (emitKnownConReturnCode con)
+ }