diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2022-12-22 10:59:16 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-12-24 00:42:51 -0500 |
commit | 6d62f6bfbb5a86131e7cbc30993f3fa510d8b3ab (patch) | |
tree | e888f791533511ce762e8768ba4790772c3b7ce7 | |
parent | f42ba88fd32f1def7dcf02f0a2227b453bf5971c (diff) | |
download | haskell-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.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Quote.hs | 74 | ||||
-rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Rename/Expr.hs | 25 | ||||
-rw-r--r-- | compiler/GHC/Rename/HsType.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Rename/Module.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Tc/Errors.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Tc/Errors/Ppr.hs | 16 | ||||
-rw-r--r-- | compiler/GHC/Tc/Types/Constraint.hs | 5 | ||||
-rw-r--r-- | compiler/GHC/Tc/Types/Origin.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Tc/Utils/Monad.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Tc/Utils/TcMType.hs | 3 | ||||
-rw-r--r-- | compiler/Language/Haskell/Syntax/Expr.hs | 4 | ||||
-rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 4 | ||||
-rw-r--r-- | testsuite/tests/perf/compiler/hard_hole_fits.stderr | 2 | ||||
-rw-r--r-- | testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/quotes/T20472_quotes.hs | 6 | ||||
-rw-r--r-- | testsuite/tests/quotes/all.T | 1 | ||||
-rw-r--r-- | testsuite/tests/rename/should_compile/T20472.stderr | 6 |
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. |