diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2021-08-25 06:45:27 -0400 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-08-25 19:35:12 -0400 |
| commit | 0759c069e7cf328c8e397623bb2e5403de52e869 (patch) | |
| tree | 311e9631600d3dd221e44897616f60c4497edd36 /compiler/GHC/HsToCore | |
| parent | 71e8094d3855d7c3a105ba5655f7995f94b84832 (diff) | |
| download | haskell-0759c069e7cf328c8e397623bb2e5403de52e869.tar.gz | |
Desugarer: Bring existentials in scope when substituting into record GADTs
This fixes an outright bug in which the desugarer did not bring the
existentially quantified type variables of a record GADT into `in_subst`'s
in-scope set, leading to #20278. It also addresses a minor inefficiency in
which `out_subst` was made into a substitution when a simpler `TvSubstEnv`
would suffice.
Fixes #20278.
Diffstat (limited to 'compiler/GHC/HsToCore')
| -rw-r--r-- | compiler/GHC/HsToCore/Expr.hs | 14 |
1 files changed, 11 insertions, 3 deletions
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs index 1f0a0ddde5..0241f611ed 100644 --- a/compiler/GHC/HsToCore/Expr.hs +++ b/compiler/GHC/HsToCore/Expr.hs @@ -652,8 +652,16 @@ dsExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = Left fields -- Record updates consume the source record with multiplicity -- Many. Therefore all the fields need to be scaled thus. user_tvs = binderVars $ conLikeUserTyVarBinders con - in_subst = zipTvSubst univ_tvs in_inst_tys - out_subst = zipTvSubst univ_tvs out_inst_tys + + in_subst :: TCvSubst + in_subst = extendTCvInScopeList (zipTvSubst univ_tvs in_inst_tys) ex_tvs + -- The in_subst clones the universally quantified type + -- variables. It will be used to substitute into types that + -- contain existentials, however, so make sure to extend the + -- in-scope set with ex_tvs (#20278). + + out_tv_env :: TvSubstEnv + out_tv_env = zipTyEnv univ_tvs out_inst_tys -- I'm not bothering to clone the ex_tvs ; eqs_vars <- mapM newPredVarDs (substTheta in_subst (eqSpecPreds eq_spec)) @@ -669,7 +677,7 @@ dsExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = Left fields -- Reconstruct with the WrapId so that unpacking happens wrap = mkWpEvVarApps theta_vars <.> dict_req_wrap <.> - mkWpTyApps [ lookupTyVar out_subst tv + mkWpTyApps [ lookupVarEnv out_tv_env tv `orElse` mkTyVarTy tv | tv <- user_tvs ] -- Be sure to use user_tvs (which may be ordered |