Use mutable update to defer out-of-scope errorswip/T17812

Previously, we let-bound an identifier to use to carry
the erroring evidence for an out-of-scope variable. But
this failed for levity-polymorphic out-of-scope variables,
leading to a panic (#17812). The new plan is to use
a mutable update to just write the erroring expression directly
where it needs to go.

Close #17812.

Test case: typecheck/should_compile/T17812

2 files changed, 23 insertions, 12 deletions

diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs
index 075c14a987..8d14d9201d 100644
--- a/compiler/GHC/Tc/Utils/TcMType.hs
+++ b/compiler/GHC/Tc/Utils/TcMType.hs
@@ -275,16 +275,21 @@ emitWantedEvVars :: CtOrigin -> [TcPredType] -> TcM [EvVar]
 emitWantedEvVars orig = mapM (emitWantedEvVar orig)
 
 -- | Emit a new wanted expression hole
-emitNewExprHole :: OccName   -- of the hole
-                -> Id        -- of the evidence
-                -> Type -> TcM ()
-emitNewExprHole occ ev_id ty
-  = do { loc <- getCtLocM (ExprHoleOrigin occ) (Just TypeLevel)
-       ; let hole = Hole { hole_sort = ExprHole ev_id
-                         , hole_occ  = getOccName ev_id
+emitNewExprHole :: OccName         -- of the hole
+                -> Type -> TcM HoleExprRef
+emitNewExprHole occ ty
+  = do { u <- newUnique
+       ; ref <- newTcRef (pprPanic "unfilled unbound-variable evidence" (ppr u))
+       ; let her = HER ref ty u
+
+       ; loc <- getCtLocM (ExprHoleOrigin occ) (Just TypeLevel)
+
+       ; let hole = Hole { hole_sort = ExprHole her
+                         , hole_occ  = occ
                          , hole_ty   = ty
                          , hole_loc  = loc }
-       ; emitHole hole }
+       ; emitHole hole
+       ; return her }
 
 newDict :: Class -> [TcType] -> TcM DictId
 newDict cls tys
@@ -2139,8 +2144,6 @@ zonkHole :: Hole -> TcM Hole
 zonkHole hole@(Hole { hole_ty = ty })
   = do { ty' <- zonkTcType ty
        ; return (hole { hole_ty = ty' }) }
-  -- No need to zonk the Id in any ExprHole because we never look at it
-  -- until after the final zonk and desugaring
 
 {- Note [zonkCt behaviour]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index a1ca04b487..e233673b79 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP              #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeFamilies     #-}
+{-# LANGUAGE TypeApplications #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 
@@ -731,8 +732,15 @@ zonkExpr env (HsVar x (L l id))
   = ASSERT2( isNothing (isDataConId_maybe id), ppr id )
     return (HsVar x (L l (zonkIdOcc env id)))
 
-zonkExpr env (HsUnboundVar v occ)
-  = return (HsUnboundVar (zonkIdOcc env v) occ)
+zonkExpr env (HsUnboundVar her occ)
+  = do her' <- zonk_her her
+       return (HsUnboundVar her' occ)
+  where
+    zonk_her :: HoleExprRef -> TcM HoleExprRef
+    zonk_her (HER ref ty u)
+      = do updMutVarM ref (zonkEvTerm env)
+           ty'  <- zonkTcTypeToTypeX env ty
+           return (HER ref ty' u)
 
 zonkExpr env (HsRecFld _ (Ambiguous v occ))
   = return (HsRecFld noExtField (Ambiguous (zonkIdOcc env v) occ))