- vanilla_args = map Type (tyConAppArgs (idType case_bndr)) ++
- map varToCoreExpr alt_bndrs
-
- gadt_args = map (substExpr subst . varToCoreExpr) alt_bndrs
- -- This call generates some bogus warnings from substExpr,
- -- because it's inconvenient to put all the Ids in scope
- -- Will be fixed when we move to FC
-
- (alt_tvs, _) = span isTyVar alt_bndrs
- Just (tv_subst, is_local) = coreRefineTys data_con alt_tvs (idType case_bndr)
- subst = mkSubst in_scope tv_subst emptyVarEnv -- No Id substitition
- in_scope = mkInScopeSet (tyVarsOfTypes (varEnvElts tv_subst))
-
- env1 | is_local = env
- | otherwise = env { cons = refineConstrEnv subst (cons env) }
+ cur_scope = scope env
+ env1 = env { scope = extendVarEnvList cur_scope
+ [(b,how_bound) | b <- case_bndr:alt_bndrs] }
+
+ -- Record RecArg for the components iff the scrutinee is RecArg
+ -- [This comment looks plain wrong to me, so I'm ignoring it
+ -- "Also forget if the scrutinee is a RecArg, because we're
+ -- now in the branch of a case, and we don't want to
+ -- record a non-scrutinee use of v if we have
+ -- case v of { (a,b) -> ...(f v)... }" ]
+ how_bound = case scrut of
+ Var v -> lookupVarEnv cur_scope v `orElse` Other
+ other -> Other
+
+ extend_data_con data_con
+ | isVanillaDataCon data_con = extendCons env1 scrut case_bndr (CV con vanilla_args)
+ | otherwise = extendCons env2 scrut case_bndr (CV con gadt_args)
+ -- Note env2 for GADTs
+ where
+
+ vanilla_args = map Type (tyConAppArgs (idType case_bndr)) ++
+ map varToCoreExpr alt_bndrs
+
+ gadt_args = map (substExpr subst . varToCoreExpr) alt_bndrs
+ -- This call generates some bogus warnings from substExpr,
+ -- because it's inconvenient to put all the Ids in scope
+ -- Will be fixed when we move to FC
+
+ (alt_tvs, _) = span isTyVar alt_bndrs
+ Just (tv_subst, is_local) = coreRefineTys data_con alt_tvs (idType case_bndr)
+ subst = mkSubst in_scope tv_subst emptyVarEnv -- No Id substitition
+ in_scope = mkInScopeSet (tyVarsOfTypes (varEnvElts tv_subst))
+
+ env2 | is_local = env1
+ | otherwise = env1 { cons = refineConstrEnv subst (cons env) }