+coreToStgExpr (Note other_note expr)
+ = coreToStgExpr expr
+
+-- Cases require a little more real work.
+
+coreToStgExpr (Case scrut bndr alts)
+ = extendVarEnvLne [(bndr, LambdaBound)] (
+ mapAndUnzip3Lne vars_alt alts `thenLne` \ (alts2, fvs_s, escs_s) ->
+ returnLne ( alts2,
+ unionFVInfos fvs_s,
+ unionVarSets escs_s )
+ ) `thenLne` \ (alts2, alts_fvs, alts_escs) ->
+ let
+ -- Determine whether the default binder is dead or not
+ -- This helps the code generator to avoid generating an assignment
+ -- for the case binder (is extremely rare cases) ToDo: remove.
+ bndr' | bndr `elementOfFVInfo` alts_fvs = bndr
+ | otherwise = bndr `setIdOccInfo` IAmDead
+
+ -- Don't consider the default binder as being 'live in alts',
+ -- since this is from the point of view of the case expr, where
+ -- the default binder is not free.
+ alts_fvs_wo_bndr = bndr `minusFVBinder` alts_fvs
+ alts_escs_wo_bndr = alts_escs `delVarSet` bndr
+ in
+
+ freeVarsToLiveVars alts_fvs_wo_bndr `thenLne` \ alts_lv_info ->
+
+ -- We tell the scrutinee that everything
+ -- live in the alts is live in it, too.
+ setVarsLiveInCont alts_lv_info (
+ coreToStgExpr scrut `thenLne` \ (scrut2, scrut_fvs, scrut_escs) ->
+ freeVarsToLiveVars scrut_fvs `thenLne` \ scrut_lv_info ->
+ returnLne (scrut2, scrut_fvs, scrut_escs, scrut_lv_info)
+ )
+ `thenLne` \ (scrut2, scrut_fvs, scrut_escs, scrut_lv_info) ->
+
+ returnLne (
+ StgCase scrut2 (getLiveVars scrut_lv_info)
+ (getLiveVars alts_lv_info)
+ bndr'
+ (mkSRT alts_lv_info)
+ (mkStgAltType (idType bndr))
+ alts2,
+ scrut_fvs `unionFVInfo` alts_fvs_wo_bndr,
+ alts_escs_wo_bndr `unionVarSet` getFVSet scrut_fvs
+ -- You might think we should have scrut_escs, not
+ -- (getFVSet scrut_fvs), but actually we can't call, and
+ -- then return from, a let-no-escape thing.
+ )
+ where
+ vars_alt (con, binders, rhs)
+ = let -- Remove type variables
+ binders' = filterStgBinders binders
+ in
+ extendVarEnvLne [(b, LambdaBound) | b <- binders'] $
+ coreToStgExpr rhs `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
+ let
+ -- Records whether each param is used in the RHS
+ good_use_mask = [ b `elementOfFVInfo` rhs_fvs | b <- binders' ]
+ in
+ returnLne ( (con, binders', good_use_mask, rhs2),
+ binders' `minusFVBinders` rhs_fvs,
+ rhs_escs `delVarSetList` binders' )
+ -- ToDo: remove the delVarSet;
+ -- since escs won't include any of these binders