- mk_rhs_env env case_bndr_unf
- = modifyInScope env case_bndr' (case_bndr' `setIdUnfolding` case_bndr_unf)
-
- simpl_alt (DEFAULT, _, rhs)
- = let unf = mkOtherCon handled_cons in
- -- Record the constructors that the case-binder *can't* be.
- simplExprC (mk_rhs_env env unf) rhs cont' `thenSmpl` \ rhs' ->
- returnSmpl (DEFAULT, [], rhs')
-
- simpl_alt (LitAlt lit, _, rhs)
- = let unf = mkUnfolding False (Lit lit) in
- simplExprC (mk_rhs_env env unf) rhs cont' `thenSmpl` \ rhs' ->
- returnSmpl (LitAlt lit, [], rhs')
-
- simpl_alt (DataAlt con, vs, rhs)
- | isVanillaDataCon con
- = -- Deal with the pattern-bound variables
- -- Mark the ones that are in ! positions in the data constructor
- -- as certainly-evaluated.
- -- NB: it happens that simplBinders does *not* erase the OtherCon
- -- form of unfolding, so it's ok to add this info before
- -- doing simplBinders
- simplBinders env (add_evals con vs) `thenSmpl` \ (env, vs') ->
+ simpl_alt alt = simplAlt env handled_cons case_bndr' alt cont' `thenSmpl` \ (_, alt') ->
+ returnSmpl alt'
+
+simplAlt :: SimplEnv -> [AltCon] -> OutId -> InAlt -> SimplCont
+ -> SimplM (Maybe TvSubstEnv, OutAlt)
+-- Simplify an alternative, returning the type refinement for the
+-- alternative, if the alternative does any refinement at all
+
+simplAlt env handled_cons case_bndr' (DEFAULT, bndrs, rhs) cont'
+ = ASSERT( null bndrs )
+ simplExprC env' rhs cont' `thenSmpl` \ rhs' ->
+ returnSmpl (Nothing, (DEFAULT, [], rhs'))
+ where
+ env' = mk_rhs_env env case_bndr' (mkOtherCon handled_cons)
+ -- Record the constructors that the case-binder *can't* be.
+
+simplAlt env handled_cons case_bndr' (LitAlt lit, bndrs, rhs) cont'
+ = ASSERT( null bndrs )
+ simplExprC env' rhs cont' `thenSmpl` \ rhs' ->
+ returnSmpl (Nothing, (LitAlt lit, [], rhs'))
+ where
+ env' = mk_rhs_env env case_bndr' (mkUnfolding False (Lit lit))
+
+simplAlt env handled_cons case_bndr' (DataAlt con, vs, rhs) cont'
+ | isVanillaDataCon con
+ = -- Deal with the pattern-bound variables
+ -- Mark the ones that are in ! positions in the data constructor
+ -- as certainly-evaluated.
+ -- NB: it happens that simplBinders does *not* erase the OtherCon
+ -- form of unfolding, so it's ok to add this info before
+ -- doing simplBinders
+ simplBinders env (add_evals con vs) `thenSmpl` \ (env, vs') ->