- -> Unique
- -> Maybe VirtualSpOffset
- -> Bool -- True <=> branches must be labelled
- -> Bool -- True <=> polymorphic case
- -> [(DataCon, [Id], [Bool], StgExpr)] -- The alternatives
- -> StgCaseDefault -- The default
- -> Bool -- Context switch at alts?
- -> FCode ([(ConTag, AbstractC)], -- The branches
- AbstractC -- The default case
- )
-
-cgAlgAlts gc_flag uniq restore_cc must_label_branches is_fun alts deflt
- emit_yield{-should a yield macro be emitted?-}
-
- = forkAlts (map (cgAlgAlt gc_flag uniq restore_cc must_label_branches emit_yield) alts)
- (cgAlgDefault gc_flag is_fun uniq restore_cc must_label_branches deflt emit_yield)
-\end{code}
-
-\begin{code}
-cgAlgDefault :: GCFlag
- -> Bool -- could be a function-typed result?
- -> Unique -> Maybe VirtualSpOffset -> Bool -- turgid state...
- -> StgCaseDefault -- input
- -> Bool
- -> FCode AbstractC -- output
-
-cgAlgDefault gc_flag is_fun uniq cc_slot must_label_branch StgNoDefault _
- = returnFC AbsCNop
-
-cgAlgDefault gc_flag is_fun uniq cc_slot must_label_branch
- (StgBindDefault rhs)
- emit_yield{-should a yield macro be emitted?-}
-
- = -- We have arranged that Node points to the thing
- restoreCurrentCostCentre cc_slot `thenFC` \restore_cc ->
- getAbsC (absC restore_cc `thenC`
- -- HWL: maybe need yield here
- --(if emit_yield
- -- then yield [node] True
- -- else absC AbsCNop) `thenC`
- possibleHeapCheck gc_flag is_fun [node] [] Nothing (cgExpr rhs)
- -- Node is live, but doesn't need to point at the thing itself;
- -- it's ok for Node to point to an indirection or FETCH_ME
- -- Hence no need to re-enter Node.
- ) `thenFC` \ abs_c ->
-
- let
- final_abs_c | must_label_branch = CCodeBlock lbl abs_c
- | otherwise = abs_c
- in
- returnFC final_abs_c
- where
- lbl = mkDefaultLabel uniq
-
--- HWL comment on GrAnSim: GRAN_YIELDs needed; emitted in cgAlgAltRhs
+ -> Unique
+ -> Maybe VirtualSpOffset
+ -> Bool -- True <=> branches must be labelled
+ -- (used for semi-tagging)
+ -> AltType -- ** AlgAlt or PolyAlt only **
+ -> [StgAlt] -- The alternatives
+ -> FCode [(AltCon, AbstractC)] -- The branches
+
+cgAlgAlts gc_flag uniq restore_cc must_label_branches alt_type alts
+ = forkAlts [ cgAlgAlt gc_flag uniq restore_cc must_label_branches alt_type alt
+ | alt <- alts]