diff options
| author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2021-02-19 19:43:30 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-02-27 19:05:54 -0500 |
| commit | b8d40af138fe0f7fad9b6afafe2152d8213a3e25 (patch) | |
| tree | e56767989a08f32b13267d789b90349759d5c649 /compiler/GHC | |
| parent | 382cd3b0c0a69d8e85e1588dc69b743c4a721818 (diff) | |
| download | haskell-b8d40af138fe0f7fad9b6afafe2152d8213a3e25.tar.gz | |
Fix assertion error with linear types, #19400
The previous code using TyCoMapper could promote the same metavar twice.
Use a set instead.
Diffstat (limited to 'compiler/GHC')
| -rw-r--r-- | compiler/GHC/Tc/Utils/Env.hs | 21 |
1 files changed, 8 insertions, 13 deletions
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs index 8dcb0b47f7..526bb489ac 100644 --- a/compiler/GHC/Tc/Utils/Env.hs +++ b/compiler/GHC/Tc/Utils/Env.hs @@ -102,7 +102,6 @@ import GHC.Core.ConLike import GHC.Core.TyCon import GHC.Core.Type import GHC.Core.Coercion.Axiom -import GHC.Core.Coercion import GHC.Core.Class import GHC.Unit.Module @@ -663,8 +662,7 @@ tcCheckUsage name id_mult thing_inside ; wrapper <- case actual_u of Bottom -> return idHsWrapper Zero -> tcSubMult (UsageEnvironmentOf name) Many id_mult - MUsage m -> do { m <- zonkTcType m - ; m <- promote_mult m + MUsage m -> do { m <- promote_mult m ; tcSubMult (UsageEnvironmentOf name) m id_mult } ; tcEmitBindingUsage (deleteUE uenv name) ; return wrapper } @@ -690,16 +688,13 @@ tcCheckUsage name id_mult thing_inside -- so we can't use it here. Thus, this dirtiness. -- -- It works nicely in practice. - (promote_mult, _, _, _) = mapTyCo mapper - mapper = TyCoMapper { tcm_tyvar = \ () tv -> if isMetaTyVar tv - then do { tclvl <- getTcLevel - ; _ <- promoteMetaTyVarTo tclvl tv - ; zonkTcTyVar tv } - else return (mkTyVarTy tv) - , tcm_covar = \ () cv -> return (mkCoVarCo cv) - , tcm_hole = \ () h -> return (mkHoleCo h) - , tcm_tycobinder = \ () tcv _flag -> return ((), tcv) - , tcm_tycon = return } + -- + -- We use a set to avoid calling promoteMetaTyVarTo twice on the same + -- metavariable. This happened in #19400. + promote_mult m = do { fvs <- zonkTyCoVarsAndFV (tyCoVarsOfType m) + ; any_promoted <- promoteTyVarSet fvs + ; if any_promoted then zonkTcType m else return m + } {- ********************************************************************* * * |