- inst_tys' = tyConAppArgs (idType case_bndr')
-
- simpl_alt (DEFAULT, _, rhs)
- = let
- -- In the default case we record the constructors that the
- -- case-binder *can't* be.
- -- We take advantage of any OtherCon info in the case scrutinee
- case_bndr_w_unf = case_bndr' `setIdUnfolding` mkOtherCon handled_cons
- env_with_unf = modifyInScope env case_bndr' case_bndr_w_unf
- in
- simplExprC env_with_unf rhs cont' `thenSmpl` \ rhs' ->
- returnSmpl (DEFAULT, [], rhs')
-
- simpl_alt (con, vs, rhs)
- = -- 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'
+
+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
+-- Nothing => the alternative is inaccessible
+
+simplAlt env handled_cons case_bndr' (DEFAULT, bndrs, rhs) cont'
+ = ASSERT( null bndrs )
+ simplExprC env' rhs cont' `thenSmpl` \ rhs' ->
+ returnSmpl (Just (emptyVarEnv, (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 (Just (emptyVarEnv, (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') ->