- scrut_ty = idType bndr
- prim_case = isUnLiftedType scrut_ty && not (isUnboxedTupleType scrut_ty)
-
- vars_alts (alts,deflt)
- | prim_case
- = mapAndUnzip3Lne vars_prim_alt alts
- `thenLne` \ (alts2, alts_fvs_list, alts_escs_list) ->
- let
- alts_fvs = unionFVInfos alts_fvs_list
- alts_escs = unionVarSets alts_escs_list
- in
- vars_deflt deflt `thenLne` \ (deflt2, deflt_fvs, deflt_escs) ->
- returnLne (
- mkStgPrimAlts scrut_ty alts2 deflt2,
- alts_fvs `unionFVInfo` deflt_fvs,
- alts_escs `unionVarSet` deflt_escs
- )
-
- | otherwise
- = mapAndUnzip3Lne vars_alg_alt alts
- `thenLne` \ (alts2, alts_fvs_list, alts_escs_list) ->
- let
- alts_fvs = unionFVInfos alts_fvs_list
- alts_escs = unionVarSets alts_escs_list
- in
- vars_deflt deflt `thenLne` \ (deflt2, deflt_fvs, deflt_escs) ->
- returnLne (
- mkStgAlgAlts scrut_ty alts2 deflt2,
- alts_fvs `unionFVInfo` deflt_fvs,
- alts_escs `unionVarSet` deflt_escs
- )
-
- where
- vars_prim_alt (LitAlt lit, _, rhs)
- = coreToStgExpr rhs `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
- returnLne ((lit, rhs2), rhs_fvs, rhs_escs)
-
- vars_alg_alt (DataAlt con, binders, rhs)
- = let
- -- remove type variables
- binders' = filterStgBinders binders
- in
- extendVarEnvLne [(b, CaseBound) | b <- binders'] $
- coreToStgExpr rhs `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
- let
- good_use_mask = [ b `elementOfFVInfo` rhs_fvs | b <- binders' ]
- -- records whether each param is used in the RHS
- in
- returnLne (
- (con, binders', good_use_mask, rhs2),
- binders' `minusFVBinders` rhs_fvs,
- rhs_escs `minusVarSet` mkVarSet binders'
- -- ToDo: remove the minusVarSet;
- -- since escs won't include any of these binders
- )
- vars_alg_alt other = pprPanic "vars_alg_alt" (ppr other)
-
- vars_deflt Nothing
- = returnLne (StgNoDefault, emptyFVInfo, emptyVarSet)
-
- vars_deflt (Just rhs)
- = coreToStgExpr rhs `thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
- returnLne (StgBindDefault rhs2, rhs_fvs, rhs_escs)
+ 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