[Git][ghc/ghc][master] Store RdrName rather than OccName in Holes

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Sat Dec 24 05:43:18 UTC 2022



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
6d62f6bf by Matthew Pickering at 2022-12-24T00:42:51-05:00
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

- - - - -


19 changed files:

- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- testsuite/tests/perf/compiler/hard_hole_fits.stderr
- testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs
- + testsuite/tests/quotes/T20472_quotes.hs
- testsuite/tests/quotes/all.T
- testsuite/tests/rename/should_compile/T20472.stderr


Changes:

=====================================
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 = ...


=====================================
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))


=====================================
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


=====================================
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.
+
 -}
 
 {-


=====================================
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
 
 


=====================================
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
 
 {- **************************************************************


=====================================
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
 


=====================================
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)
 
 {- *********************************************************************
 *                                                                      *


=====================================
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})


=====================================
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


=====================================
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 }


=====================================
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


=====================================
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


=====================================
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


=====================================
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)


=====================================
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
 
 


=====================================
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 |]


=====================================
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, [''])


=====================================
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.



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d62f6bfbb5a86131e7cbc30993f3fa510d8b3ab

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d62f6bfbb5a86131e7cbc30993f3fa510d8b3ab
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221224/22386e74/attachment-0001.html>


More information about the ghc-commits mailing list