summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2022-12-22 10:59:16 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-12-24 00:42:51 -0500
commit6d62f6bfbb5a86131e7cbc30993f3fa510d8b3ab (patch)
treee888f791533511ce762e8768ba4790772c3b7ce7
parentf42ba88fd32f1def7dcf02f0a2227b453bf5971c (diff)
downloadhaskell-6d62f6bfbb5a86131e7cbc30993f3fa510d8b3ab.tar.gz
Store RdrName rather than OccName in Holes
In #20472 it was pointed out that you couldn't defer out of scope but the implementation collapsed a RdrName into an OccName to stuff it into a Hole. This leads to the error message for a deferred qualified name dropping the qualification which affects the quality of the error message. This commit adds a bit more structure to a hole, so a hole can replace a RdrName without losing information about what that RdrName was. This is important when printing error messages. I also added a test which checks the Template Haskell deferral of out of scope qualified names works properly. Fixes #22130
-rw-r--r--compiler/GHC/Builtin/Names/TH.hs8
-rw-r--r--compiler/GHC/HsToCore/Quote.hs74
-rw-r--r--compiler/GHC/Parser/PostProcess.hs2
-rw-r--r--compiler/GHC/Rename/Expr.hs25
-rw-r--r--compiler/GHC/Rename/HsType.hs4
-rw-r--r--compiler/GHC/Rename/Module.hs3
-rw-r--r--compiler/GHC/Tc/Errors.hs2
-rw-r--r--compiler/GHC/Tc/Errors/Ppr.hs16
-rw-r--r--compiler/GHC/Tc/Types/Constraint.hs5
-rw-r--r--compiler/GHC/Tc/Types/Origin.hs2
-rw-r--r--compiler/GHC/Tc/Utils/Monad.hs4
-rw-r--r--compiler/GHC/Tc/Utils/TcMType.hs3
-rw-r--r--compiler/Language/Haskell/Syntax/Expr.hs4
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Syntax.hs4
-rw-r--r--testsuite/tests/perf/compiler/hard_hole_fits.stderr2
-rw-r--r--testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs2
-rw-r--r--testsuite/tests/quotes/T20472_quotes.hs6
-rw-r--r--testsuite/tests/quotes/all.T1
-rw-r--r--testsuite/tests/rename/should_compile/T20472.stderr6
19 files changed, 117 insertions, 56 deletions
diff --git a/compiler/GHC/Builtin/Names/TH.hs b/compiler/GHC/Builtin/Names/TH.hs
index 86814fb263..bea3b9715f 100644
--- a/compiler/GHC/Builtin/Names/TH.hs
+++ b/compiler/GHC/Builtin/Names/TH.hs
@@ -32,7 +32,7 @@ templateHaskellNames :: [Name]
templateHaskellNames = [
returnQName, bindQName, sequenceQName, newNameName, liftName, liftTypedName,
mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
- mkNameSName,
+ mkNameSName, mkNameQName,
mkModNameName,
liftStringName,
unTypeName, unTypeCodeName,
@@ -216,7 +216,7 @@ modNameTyConName = thTc (fsLit "ModName") modNameTyConKey
returnQName, bindQName, sequenceQName, newNameName, liftName,
mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
mkNameLName, mkNameSName, liftStringName, unTypeName, unTypeCodeName,
- unsafeCodeCoerceName, liftTypedName, mkModNameName :: Name
+ unsafeCodeCoerceName, liftTypedName, mkModNameName, mkNameQName :: Name
returnQName = thFun (fsLit "returnQ") returnQIdKey
bindQName = thFun (fsLit "bindQ") bindQIdKey
sequenceQName = thFun (fsLit "sequenceQ") sequenceQIdKey
@@ -228,6 +228,7 @@ mkNameG_vName = thFun (fsLit "mkNameG_v") mkNameG_vIdKey
mkNameG_dName = thFun (fsLit "mkNameG_d") mkNameG_dIdKey
mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey
mkNameLName = thFun (fsLit "mkNameL") mkNameLIdKey
+mkNameQName = thFun (fsLit "mkNameQ") mkNameQIdKey
mkNameSName = thFun (fsLit "mkNameS") mkNameSIdKey
mkModNameName = thFun (fsLit "mkModName") mkModNameIdKey
unTypeName = thFun (fsLit "unType") unTypeIdKey
@@ -742,7 +743,7 @@ incoherentDataConKey = mkPreludeDataConUnique 212
returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,
mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,
mkNameLIdKey, mkNameSIdKey, unTypeIdKey, unTypeCodeIdKey,
- unsafeCodeCoerceIdKey, liftTypedIdKey, mkModNameIdKey :: Unique
+ unsafeCodeCoerceIdKey, liftTypedIdKey, mkModNameIdKey, mkNameQIdKey :: Unique
returnQIdKey = mkPreludeMiscIdUnique 200
bindQIdKey = mkPreludeMiscIdUnique 201
sequenceQIdKey = mkPreludeMiscIdUnique 202
@@ -759,6 +760,7 @@ unTypeCodeIdKey = mkPreludeMiscIdUnique 212
liftTypedIdKey = mkPreludeMiscIdUnique 214
mkModNameIdKey = mkPreludeMiscIdUnique 215
unsafeCodeCoerceIdKey = mkPreludeMiscIdUnique 216
+mkNameQIdKey = mkPreludeMiscIdUnique 217
-- data Lit = ...
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index e4e8473d71..045de30ed6 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -99,6 +99,7 @@ import Data.Function
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class
import Data.Foldable ( toList )
+import GHC.Types.Name.Reader (RdrName(..))
data MetaWrappers = MetaWrappers {
-- Applies its argument to a type argument `m` and dictionary `Quote m`
@@ -1647,9 +1648,8 @@ repE (HsUntypedSplice (HsUntypedSpliceNested n) _) = rep_splice n
repE e@(HsUntypedSplice (HsUntypedSpliceTop _ _) _) = pprPanic "repE: top level splice" (ppr e)
repE (HsStatic _ e) = repLE e >>= rep2 staticEName . (:[]) . unC
repE (HsUnboundVar _ uv) = do
- occ <- occNameLit uv
- sname <- repNameS occ
- repUnboundVar sname
+ name <- repRdrName uv
+ repUnboundVar name
repE (HsGetField _ e (L _ (DotFieldOcc _ (L _ (FieldLabelString f))))) = do
e1 <- repLE e
repGetField e1 f
@@ -2191,31 +2191,40 @@ lookupOccDsM n
Just (DsSplice _) -> pprPanic "repE:lookupOcc" (ppr n)
}
-globalVar :: Name -> DsM (Core TH.Name)
+
-- Not bound by the meta-env
-- Could be top-level; or could be local
-- f x = $(g [| x |])
-- Here the x will be local
-globalVar name
- | isExternalName name
- = do { MkC mod <- coreStringLit name_mod
- ; MkC pkg <- coreStringLit name_pkg
- ; MkC occ <- nameLit name
- ; rep2_nwDsM mk_varg [pkg,mod,occ] }
- | otherwise
- = do { MkC occ <- nameLit name
+globalVar :: Name -> DsM (Core TH.Name)
+globalVar n =
+ case nameModule_maybe n of
+ Just m -> globalVarExternal m (getOccName n)
+ Nothing -> globalVarLocal (getUnique n) (getOccName n)
+
+globalVarLocal :: Unique -> OccName -> DsM (Core TH.Name)
+globalVarLocal unique name
+ = do { MkC occ <- occNameLit name
; platform <- targetPlatform <$> getDynFlags
- ; let uni = mkIntegerExpr platform (toInteger $ getKey (getUnique name))
+ ; let uni = mkIntegerExpr platform (toInteger $ getKey unique)
; rep2_nwDsM mkNameLName [occ,uni] }
+
+globalVarExternal :: Module -> OccName -> DsM (Core TH.Name)
+globalVarExternal mod name_occ
+ = do {
+
+ ; MkC mod <- coreStringLit name_mod
+ ; MkC pkg <- coreStringLit name_pkg
+ ; MkC occ <- occNameLit name_occ
+ ; rep2_nwDsM mk_varg [pkg,mod,occ] }
where
- mod = assert (isExternalName name) nameModule name
- name_mod = moduleNameFS (moduleName mod)
- name_pkg = unitFS (moduleUnit mod)
- name_occ = nameOccName name
- mk_varg | isDataOcc name_occ = mkNameG_dName
- | isVarOcc name_occ = mkNameG_vName
- | isTcOcc name_occ = mkNameG_tcName
- | otherwise = pprPanic "GHC.HsToCore.Quote.globalVar" (ppr name)
+ name_mod = moduleNameFS (moduleName mod)
+ name_pkg = unitFS (moduleUnit mod)
+ mk_varg | isDataOcc name_occ = mkNameG_dName
+ | isVarOcc name_occ = mkNameG_vName
+ | isTcOcc name_occ = mkNameG_tcName
+ | otherwise = pprPanic "GHC.HsToCore.Quote.globalVar" (ppr name_occ)
+
lookupType :: Name -- Name of type constructor (e.g. (M TH.Exp))
-> MetaM Type -- The type
@@ -2243,15 +2252,12 @@ wrapGenSyms binds body@(MkC b)
go _ [] = return body
go var_ty ((name,id) : binds)
= do { MkC body' <- go var_ty binds
- ; lit_str <- lift $ nameLit name
+ ; lit_str <- occNameLit (occName name)
; gensym_app <- repGensym lit_str
; repBindM var_ty elt_ty
gensym_app (MkC (Lam id body')) }
-nameLit :: Name -> DsM (Core String)
-nameLit n = coreStringLit (occNameFS (nameOccName n))
-
-occNameLit :: OccName -> MetaM (Core String)
+occNameLit :: MonadThings m => OccName -> m (Core String)
occNameLit name = coreStringLit (occNameFS name)
@@ -2945,9 +2951,25 @@ mk_lit (HsIntegral i) = mk_integer (il_value i)
mk_lit (HsFractional f) = mk_rational f
mk_lit (HsIsString _ s) = mk_string s
+repRdrName :: RdrName -> MetaM (Core TH.Name)
+repRdrName rdr_name = do
+ case rdr_name of
+ Unqual occ ->
+ repNameS =<< occNameLit occ
+ Qual mn occ -> do
+ let name_mod = moduleNameFS mn
+ mod <- coreStringLit name_mod
+ occ <- occNameLit occ
+ repNameQ mod occ
+ Orig m n -> lift $ globalVarExternal m n
+ Exact n -> lift $ globalVar n
+
repNameS :: Core String -> MetaM (Core TH.Name)
repNameS (MkC name) = rep2_nw mkNameSName [name]
+repNameQ :: Core String -> Core String -> MetaM (Core TH.Name)
+repNameQ (MkC mn) (MkC name) = rep2_nw mkNameQName [mn, name]
+
--------------- Miscellaneous -------------------
repGensym :: Core String -> MetaM (Core (M TH.Name))
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index c42501278f..309fe2b8a7 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -1815,7 +1815,7 @@ instance DisambECP (HsExpr GhcPs) where
rejectPragmaPV _ = return ()
hsHoleExpr :: EpAnn EpAnnUnboundVar -> HsExpr GhcPs
-hsHoleExpr anns = HsUnboundVar anns (mkVarOccFS (fsLit "_"))
+hsHoleExpr anns = HsUnboundVar anns (mkRdrUnqual (mkVarOccFS (fsLit "_")))
type instance Anno (GRHS GhcPs (LocatedA (PatBuilder GhcPs))) = SrcAnn NoEpAnns
type instance Anno [LocatedA (Match GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnL
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 49af58bd1c..4ee8870318 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -248,8 +248,9 @@ finishHsVar (L l name)
rnUnboundVar :: RdrName -> RnM (HsExpr GhcRn, FreeVars)
rnUnboundVar v = do
deferOutofScopeVariables <- goptM Opt_DeferOutOfScopeVariables
+ -- See Note [Reporting unbound names] for difference between qualified and unqualified names.
unless (isUnqual v || deferOutofScopeVariables) (reportUnboundName v >> return ())
- return (HsUnboundVar noExtField (rdrNameOcc v), emptyFVs)
+ return (HsUnboundVar noExtField v, emptyFVs)
rnExpr (HsVar _ (L l v))
= do { dflags <- getDynFlags
@@ -751,6 +752,28 @@ bindNonRec will automatically do the right thing, giving us:
case expr of y -> (\x -> op y x)
See #18151.
+
+Note [Reporting unbound names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Faced with an out-of-scope `RdrName` there are two courses of action
+A. Report an error immediately (and return a HsUnboundVar). This will halt GHC after the renamer is complete
+B. Return a HsUnboundVar without reporting an error. That will allow the typechecker to run, which in turn
+ can give a better error message, notably giving the type of the variable via the "typed holes" mechanism.
+
+When `-fdefer-out-of-scope-variables` is on we follow plan B.
+
+When it is not, we follow plan B for unqualified names, and plan A for qualified names.
+
+If a name is qualified, and out of scope, then by default an error will be raised
+because the user was already more precise. They specified a specific qualification
+and either
+ * The qualification didn't exist, so that precision was wrong.
+ * Or the qualification existed and the thing we were looking for wasn't where
+ the qualification said it would be.
+
+However we can still defer this error completely, and we do defer it if
+`-fdefer-out-of-scope-variables` is enabled.
+
-}
{-
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index bca65c7cad..aaaa249ba2 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -1425,7 +1425,7 @@ data NegationHandling = ReassociateNegation | KeepNegationIntact
-- | Name of an operator in an operator application or section
data OpName = NormalOp Name -- ^ A normal identifier
| NegateOp -- ^ Prefix negation
- | UnboundOp OccName -- ^ An unbound identifier
+ | UnboundOp RdrName -- ^ An unbound identifier
| RecFldOp (FieldOcc GhcRn) -- ^ A record field occurrence
instance Outputable OpName where
@@ -1607,7 +1607,7 @@ checkSectionPrec direction section op arg
lookupFixityOp :: OpName -> RnM Fixity
lookupFixityOp (NormalOp n) = lookupFixityRn n
lookupFixityOp NegateOp = lookupFixityRn negateName
-lookupFixityOp (UnboundOp u) = lookupFixityRn (mkUnboundName u)
+lookupFixityOp (UnboundOp u) = lookupFixityRn (mkUnboundName (occName u))
lookupFixityOp (RecFldOp f) = lookupFieldFixityRn f
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 537e161e42..97726a279c 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -1370,8 +1370,7 @@ badRuleLhsErr name lhs bad_e
err =
case bad_e of
HsUnboundVar _ uv ->
- let rdr = mkRdrUnqual uv
- in pprScopeError rdr $ notInScopeErr WL_Global (mkRdrUnqual uv)
+ pprScopeError uv $ notInScopeErr WL_Global uv
_ -> text "Illegal expression:" <+> ppr bad_e
{- **************************************************************
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index 77e7b96f9c..61caa2e456 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -1347,7 +1347,7 @@ mkHoleError _ _tidy_simples ctxt hole@(Hole { hole_occ = occ, hole_loc = ct_loc
; let (imp_errs, hints)
= unknownNameSuggestions WL_Anything
dflags hpt curr_mod rdr_env
- (tcl_rdr lcl_env) imp_info (mkRdrUnqual occ)
+ (tcl_rdr lcl_env) imp_info occ
err = SolverReportWithCtxt ctxt (ReportHoleError hole $ OutOfScopeHole imp_errs)
report = SolverReport err [] hints
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 33b75e3eb1..d13aa6b21d 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -3360,14 +3360,14 @@ pprSameOccInfo (SameOcc same_pkg n1 n2) =
**********************************************************************-}
pprHoleError :: SolverReportErrCtxt -> Hole -> HoleError -> SDoc
-pprHoleError _ (Hole { hole_ty, hole_occ = occ }) (OutOfScopeHole imp_errs)
+pprHoleError _ (Hole { hole_ty, hole_occ = rdr }) (OutOfScopeHole imp_errs)
= out_of_scope_msg $$ vcat (map ppr imp_errs)
where
- herald | isDataOcc occ = text "Data constructor not in scope:"
+ herald | isDataOcc (rdrNameOcc rdr) = text "Data constructor not in scope:"
| otherwise = text "Variable not in scope:"
out_of_scope_msg -- Print v :: ty only if the type has structure
- | boring_type = hang herald 2 (ppr occ)
- | otherwise = hang herald 2 (pp_occ_with_type occ hole_ty)
+ | boring_type = hang herald 2 (ppr rdr)
+ | otherwise = hang herald 2 (pp_rdr_with_type rdr hole_ty)
boring_type = isTyVarTy hole_ty
pprHoleError ctxt (Hole { hole_ty, hole_occ}) (HoleError sort other_tvs hole_skol_info) =
vcat [ hole_msg
@@ -3379,7 +3379,7 @@ pprHoleError ctxt (Hole { hole_ty, hole_occ}) (HoleError sort other_tvs hole_sko
hole_msg = case sort of
ExprHole {} ->
hang (text "Found hole:")
- 2 (pp_occ_with_type hole_occ hole_ty)
+ 2 (pp_rdr_with_type hole_occ hole_ty)
TypeHole ->
hang (text "Found type wildcard" <+> quotes (ppr hole_occ))
2 (text "standing for" <+> quotes pp_hole_type_with_kind)
@@ -3404,7 +3404,7 @@ pprHoleError ctxt (Hole { hole_ty, hole_occ}) (HoleError sort other_tvs hole_sko
-- Coercion variables can be free in the
-- hole, via kind casts
expr_hole_hint -- Give hint for, say, f x = _x
- | lengthFS (occNameFS hole_occ) > 1 -- Don't give this hint for plain "_"
+ | lengthFS (occNameFS (rdrNameOcc hole_occ)) > 1 -- Don't give this hint for plain "_"
= text "Or perhaps" <+> quotes (ppr hole_occ)
<+> text "is mis-spelled, or not in scope"
| otherwise
@@ -3425,8 +3425,8 @@ pprHoleError ctxt (Hole { hole_ty, hole_occ}) (HoleError sort other_tvs hole_sko
= ppWhenOption sdocPrintExplicitCoercions $
quotes (ppr tv) <+> text "is a coercion variable"
-pp_occ_with_type :: OccName -> Type -> SDoc
-pp_occ_with_type occ hole_ty = hang (pprPrefixOcc occ) 2 (dcolon <+> pprType hole_ty)
+pp_rdr_with_type :: RdrName -> Type -> SDoc
+pp_rdr_with_type occ hole_ty = hang (pprPrefixOcc occ) 2 (dcolon <+> pprType hole_ty)
{- *********************************************************************
* *
diff --git a/compiler/GHC/Tc/Types/Constraint.hs b/compiler/GHC/Tc/Types/Constraint.hs
index 62412cdb65..2fea177885 100644
--- a/compiler/GHC/Tc/Types/Constraint.hs
+++ b/compiler/GHC/Tc/Types/Constraint.hs
@@ -124,6 +124,7 @@ import GHC.Data.Bag
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Constants (debugIsOn)
+import GHC.Types.Name.Reader
import Data.Coerce
import Data.Monoid ( Endo(..) )
@@ -307,7 +308,7 @@ instance Outputable DelayedError where
-- signatures). See Note [Holes].
data Hole
= Hole { hole_sort :: HoleSort -- ^ What flavour of hole is this?
- , hole_occ :: OccName -- ^ The name of this hole
+ , hole_occ :: RdrName -- ^ The name of this hole
, hole_ty :: TcType -- ^ Type to be printed to the user
-- For expression holes: type of expr
-- For type holes: the missing type
@@ -1233,7 +1234,7 @@ insolubleCt ct
-- | Does this hole represent an "out of scope" error?
-- See Note [Insoluble holes]
isOutOfScopeHole :: Hole -> Bool
-isOutOfScopeHole (Hole { hole_occ = occ }) = not (startsWithUnderscore occ)
+isOutOfScopeHole (Hole { hole_occ = occ }) = not (startsWithUnderscore (occName occ))
instance Outputable WantedConstraints where
ppr (WC {wc_simple = s, wc_impl = i, wc_errors = e})
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index 6c7759db31..72ed58b041 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -580,7 +580,7 @@ data CtOrigin
PredType CtOrigin RealSrcSpan -- This constraint arising from ...
PredType CtOrigin RealSrcSpan -- and this constraint arising from ...
- | ExprHoleOrigin (Maybe OccName) -- from an expression hole
+ | ExprHoleOrigin (Maybe RdrName) -- from an expression hole
| TypeHoleOrigin OccName -- from a type hole (partial type signature)
| PatCheckOrigin -- normalisation of a type during pattern-match checking
| ListOrigin -- An overloaded list
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 04fd3b0656..afc7633ff2 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -1916,7 +1916,7 @@ emitAnonTypeHole :: IsExtraConstraint
emitAnonTypeHole extra_constraints tv
= do { ct_loc <- getCtLocM (TypeHoleOrigin occ) Nothing
; let hole = Hole { hole_sort = sort
- , hole_occ = occ
+ , hole_occ = mkRdrUnqual occ
, hole_ty = mkTyVarTy tv
, hole_loc = ct_loc }
; emitHole hole }
@@ -1930,7 +1930,7 @@ emitNamedTypeHole (name, tv)
= do { ct_loc <- setSrcSpan (nameSrcSpan name) $
getCtLocM (TypeHoleOrigin occ) Nothing
; let hole = Hole { hole_sort = TypeHole
- , hole_occ = occ
+ , hole_occ = nameRdrName name
, hole_ty = mkTyVarTy tv
, hole_loc = ct_loc }
; emitHole hole }
diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs
index a6bbf921a5..5824c3e7f6 100644
--- a/compiler/GHC/Tc/Utils/TcMType.hs
+++ b/compiler/GHC/Tc/Utils/TcMType.hs
@@ -153,6 +153,7 @@ import GHC.Utils.Constants (debugIsOn)
import Control.Monad
import GHC.Data.Maybe
import qualified Data.Semigroup as Semi
+import GHC.Types.Name.Reader
{-
************************************************************************
@@ -300,7 +301,7 @@ emitWantedEvVars :: CtOrigin -> [TcPredType] -> TcM [EvVar]
emitWantedEvVars orig = mapM (emitWantedEvVar orig)
-- | Emit a new wanted expression hole
-emitNewExprHole :: OccName -- of the hole
+emitNewExprHole :: RdrName -- of the hole
-> Type -> TcM HoleExprRef
emitNewExprHole occ ty
= do { u <- newUnique
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index ba818e82c5..44c731735c 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -30,7 +30,6 @@ import Language.Haskell.Syntax.Type
import Language.Haskell.Syntax.Binds
-- others:
-import GHC.Types.Name (OccName)
import GHC.Types.Fixity (LexicalFixity(Infix), Fixity)
import GHC.Types.SourceText (StringLiteral)
@@ -44,6 +43,7 @@ import Data.Either
import Data.Eq
import Data.Maybe
import Data.List.NonEmpty ( NonEmpty )
+import GHC.Types.Name.Reader
{- Note [RecordDotSyntax field updates]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -255,7 +255,7 @@ data HsExpr p
-- See Note [Located RdrNames]
| HsUnboundVar (XUnboundVar p)
- OccName -- ^ Unbound variable; also used for "holes"
+ RdrName -- ^ Unbound variable; also used for "holes"
-- (_ or _x).
-- Turned from HsVar to HsUnboundVar by the
-- renamer, when it finds an out-of-scope
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 30958c5cbe..0304eb130b 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -1807,6 +1807,10 @@ mkNameU s u = Name (mkOccName s) (NameU u)
mkNameL :: String -> Uniq -> Name
mkNameL s u = Name (mkOccName s) (NameL u)
+-- | Only used internally
+mkNameQ :: String -> String -> Name
+mkNameQ mn occ = Name (mkOccName occ) (NameQ (mkModName mn))
+
-- | Used for 'x etc, but not available to the programmer
mkNameG :: NameSpace -> String -> String -> String -> Name
mkNameG ns pkg modu occ
diff --git a/testsuite/tests/perf/compiler/hard_hole_fits.stderr b/testsuite/tests/perf/compiler/hard_hole_fits.stderr
index fcdde2ee2d..9d4e926892 100644
--- a/testsuite/tests/perf/compiler/hard_hole_fits.stderr
+++ b/testsuite/tests/perf/compiler/hard_hole_fits.stderr
@@ -22,7 +22,7 @@ hard_hole_fits.hs:15:32: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: Int
• In an equation for ‘testMe’: testMe (HsUnboundVar xuv uv) = _
• Relevant bindings include
- uv :: GHC.Types.Name.Occurrence.OccName
+ uv :: GHC.Types.Name.Reader.RdrName
(bound at hard_hole_fits.hs:15:26)
xuv :: Language.Haskell.Syntax.Extension.XUnboundVar GhcPs
(bound at hard_hole_fits.hs:15:22)
diff --git a/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs b/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs
index e9f504d92d..3e8cd06a52 100644
--- a/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs
+++ b/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs
@@ -34,7 +34,7 @@ fromModule _ = []
toHoleFitCommand :: TypedHole -> String -> Maybe String
toHoleFitCommand (TypedHole {th_hole = Just (Hole { hole_occ = h })}) str
- = stripPrefix ("_" <> str) $ occNameString h
+ = stripPrefix ("_" <> str) $ occNameString (occName h)
toHoleFitCommand _ _ = Nothing
diff --git a/testsuite/tests/quotes/T20472_quotes.hs b/testsuite/tests/quotes/T20472_quotes.hs
new file mode 100644
index 0000000000..faebf59a21
--- /dev/null
+++ b/testsuite/tests/quotes/T20472_quotes.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskellQuotes #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# OPTIONS_GHC -fdefer-out-of-scope-variables #-}
+module T20472_quotes where
+
+foo = [| Prelude.a |]
diff --git a/testsuite/tests/quotes/all.T b/testsuite/tests/quotes/all.T
index ba580ccaf4..4fa5d13d55 100644
--- a/testsuite/tests/quotes/all.T
+++ b/testsuite/tests/quotes/all.T
@@ -41,3 +41,4 @@ test('TH_double_splice', normal, compile_fail, [''])
test('T20688', normal, compile, ['-Wimplicit-lift -Werror'])
test('T20893', normal, compile_and_run, [''])
test('T21619', normal, compile, [''])
+test('T20472_quotes', normal, compile, [''])
diff --git a/testsuite/tests/rename/should_compile/T20472.stderr b/testsuite/tests/rename/should_compile/T20472.stderr
index c1b18c4951..11e4e830d9 100644
--- a/testsuite/tests/rename/should_compile/T20472.stderr
+++ b/testsuite/tests/rename/should_compile/T20472.stderr
@@ -3,7 +3,9 @@ T20472.hs:5:5: warning: [GHC-88464] [-Wdeferred-out-of-scope-variables (in -Wdef
Variable not in scope: nonexistent
T20472.hs:6:5: warning: [GHC-88464] [-Wdeferred-out-of-scope-variables (in -Wdefault)]
- Variable not in scope: nonexistent
+ Variable not in scope: Prelude.nonexistent
+ NB: the module ‘Prelude’ does not export ‘nonexistent’.
T20472.hs:8:5: warning: [GHC-88464] [-Wdeferred-out-of-scope-variables (in -Wdefault)]
- Variable not in scope: x
+ Variable not in scope: Nonexistent.x
+ NB: no module named ‘Nonexistent’ is imported.