- let is_alg = maybeToBool maybe_tycon
- Just spec_tycon = maybe_tycon
- in
-
- -- Deal with the unboxed tuple case
- if is_alg && isUnboxedTupleTyCon spec_tycon then
- -- By now, the simplifier should have have turned it
- -- into case e of (# a,b #) -> e
- -- There shouldn't be a
- -- case e of DEFAULT -> e
- ASSERT2( case (alts, deflt) of { ([_],StgNoDefault) -> True; other -> False },
- text "cgEvalAlts: dodgy case of unboxed tuple type" )
- let
- alt = head alts
- lbl = mkReturnInfoLabel uniq
- in
- cgUnboxedTupleAlt uniq cc_slot True alt `thenFC` \ abs_c ->
- getSRTInfo name srt `thenFC` \ srt_info ->
- absC (CRetDirect uniq abs_c srt_info liveness) `thenC`
- returnFC (CaseAlts (CLbl lbl RetRep) Nothing False)
-
- -- normal algebraic (or polymorphic) case alternatives
- else let
- ret_conv | is_alg = ctrlReturnConvAlg spec_tycon
- | otherwise = UnvectoredReturn 0
-
- use_labelled_alts = case ret_conv of
- VectoredReturn _ -> True
- _ -> False
-
- semi_tagged_stuff
- = if use_labelled_alts then
- cgSemiTaggedAlts bndr alts deflt -- Just <something>
- else
- Nothing -- no semi-tagging info
-
- in
- cgAlgAlts GCMayHappen (not is_alg) uniq cc_slot use_labelled_alts
- alts deflt True `thenFC` \ (tagged_alt_absCs, deflt_absC) ->
-
- mkReturnVector name tagged_alt_absCs deflt_absC srt liveness
- ret_conv `thenFC` \ return_vec ->
-
- returnFC (CaseAlts return_vec semi_tagged_stuff False)
-
- -- primitive alts...
- StgPrimAlts tycon alts deflt ->
-
- -- Restore the cost centre
- restoreCurrentCostCentre cc_slot `thenFC` \ cc_restore ->
-
- -- Generate the switch
- getAbsC (cgPrimEvalAlts bndr tycon alts deflt) `thenFC` \ abs_c ->
-
- -- Generate the labelled block, starting with restore-cost-centre
- getSRTInfo name srt `thenFC` \srt_info ->
- absC (CRetDirect uniq (cc_restore `mkAbsCStmts` abs_c)
- srt_info liveness) `thenC`
-
- -- Return an amode for the block
- returnFC (CaseAlts (CLbl (mkReturnInfoLabel uniq) RetRep) Nothing False)
+ let ret_conv = case alt_type of
+ AlgAlt tc -> ctrlReturnConvAlg tc
+ PolyAlt -> UnvectoredReturn 0
+
+ use_labelled_alts = case ret_conv of
+ VectoredReturn _ -> True
+ _ -> False
+
+ semi_tagged_stuff = cgSemiTaggedAlts use_labelled_alts bndr alts
+
+ in
+ cgAlgAlts GCMayHappen (getUnique bndr)
+ cc_slot use_labelled_alts
+ alt_type alts `thenFC` \ tagged_alt_absCs ->
+
+ mkRetVecTarget bndr tagged_alt_absCs
+ srt ret_conv `thenFC` \ return_vec ->
+
+ returnFC (CaseAlts return_vec semi_tagged_stuff False)