- ; case coreRefineTys tvs subst pat_res_ty scrut_ty of {
- Nothing -> return () ; -- Alternative is dead code
- Just senv -> updateTvSubstEnv senv $
- do { tvs' <- mapM lintTy (mkTyVarTys tvs)
- ; con_type <- lintTyApps (dataConRepType con) tvs'
- ; mapM lintBinder ids -- Lint Ids in the refined world
- ; lintCoreArgs con_type (map Var ids)
- ; checkAltExpr rhs alt_ty
+ ; let in_scope = getTvInScope subst
+ subst_env = getTvSubstEnv subst
+ ; case coreRefineTys in_scope con tvs scrut_ty of {
+ Nothing -> return () ; -- Alternative is dead code
+ Just (refine, _) -> updateTvSubstEnv (composeTvSubst in_scope refine subst_env) $
+ do { addLoc (CasePat alt) $ do
+ { tvs' <- mapM lintTy (mkTyVarTys tvs)
+ ; con_type <- lintTyApps (dataConRepType con) tvs'
+ ; mapM lintBinder ids -- Lint Ids in the refined world
+ ; lintCoreArgs con_type (map Var ids)
+ }
+
+ ; let refined_alt_ty = substTy (mkTvSubst in_scope refine) alt_ty
+ -- alt_ty is already an OutType, so don't re-apply
+ -- the current substitution. But we must apply the
+ -- refinement so that the check in checkAltExpr is ok
+ ; checkAltExpr rhs refined_alt_ty