+ | otherwise -- GADT case
+ = let
+ (tvs,ids) = span isTyVar vs
+ in
+ simplBinders env tvs `thenSmpl` \ (env1, tvs') ->
+ case coreRefineTys (getInScope env1) con tvs' (idType case_bndr') of {
+ Nothing -- Inaccessible
+ | opt_PprStyle_Debug -- Hack: if debugging is on, generate an error case
+ -- so we can see it
+ -> let rhs' = mkApps (Var eRROR_ID)
+ [Type (substTy env (exprType rhs)),
+ Lit (mkStringLit "Impossible alternative (GADT)")]
+ in
+ simplBinders env1 ids `thenSmpl` \ (env2, ids') ->
+ returnSmpl (Just (emptyVarEnv, (DataAlt con, tvs' ++ ids', rhs')))
+
+ | otherwise -- Filter out the inaccessible branch
+ -> return Nothing ;
+
+ Just refine@(tv_subst_env, _) -> -- The normal case
+
+ let
+ env2 = refineSimplEnv env1 refine
+ -- Simplify the Ids in the refined environment, so their types
+ -- reflect the refinement. Usually this doesn't matter, but it helps
+ -- in mkDupableAlt, when we want to float a lambda that uses these binders
+ -- Furthermore, it means the binders contain maximal type information
+ in
+ simplBinders env2 (add_evals con ids) `thenSmpl` \ (env3, ids') ->
+ let unf = mkUnfolding False con_app
+ con_app = mkConApp con con_args
+ con_args = map varToCoreExpr vs' -- NB: no inst_tys'
+ env_w_unf = mk_rhs_env env3 case_bndr' unf
+ vs' = tvs' ++ ids'
+ in
+ simplExprC env_w_unf rhs cont' `thenSmpl` \ rhs' ->
+ returnSmpl (Just (tv_subst_env, (DataAlt con, vs', rhs'))) }