Improve errors for non-existent labels

This patch fixes #17469, by improving matters when you use
non-existent field names in a record construction:
   data T = MkT { x :: Int }
   f v = MkT { y = 3 }

The check is now made in the renamer, in GHC.Rename.Env.lookupRecFieldOcc.

That in turn led to a spurious error in T9975a, which is fixed by
making GHC.Rename.Names.extendGlobalRdrEnvRn fail fast if it finds
duplicate bindings.  See Note [Fail fast on duplicate definitions]
in that module for more details.

This patch was originated and worked on by Alex D (@nineonine)

3 files changed, 33 insertions, 30 deletions

diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index e19697bb40..cd40ab100a 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -495,7 +495,8 @@ lookupRecFieldOcc mb_con rdr_name
   , isUnboundName con  -- Avoid error cascade
   = return (mkUnboundNameRdr rdr_name)
   | Just con <- mb_con
-  = do { flds <- lookupConstructorFields con
+  = lookupExactOrOrig rdr_name id $  -- See Note [Record field names and Template Haskell]
+    do { flds <- lookupConstructorFields con
        ; env <- getGlobalRdrEnv
        ; let lbl      = occNameFS (rdrNameOcc rdr_name)
              mb_field = do fl <- find ((== lbl) . flLabel) flds
@@ -511,12 +512,13 @@ lookupRecFieldOcc mb_con rdr_name
        ; case mb_field of
            Just (fl, gre) -> do { addUsedGRE True gre
                                 ; return (flSelector fl) }
-           Nothing        -> lookupGlobalOccRn' WantBoth rdr_name }
-             -- See Note [Fall back on lookupGlobalOccRn in lookupRecFieldOcc]
-  | otherwise
-  -- This use of Global is right as we are looking up a selector which
-  -- can only be defined at the top level.
+           Nothing        -> do { addErr (badFieldConErr con lbl)
+                                ; return (mkUnboundNameRdr rdr_name) } }
+
+  | otherwise  -- Can't use the data constructor to disambiguate
   = lookupGlobalOccRn' WantBoth rdr_name
+    -- This use of Global is right as we are looking up a selector,
+    -- which can only be defined at the top level.
 
 -- | Look up an occurrence of a field in a record update, returning the selector
 -- name.
@@ -632,25 +634,8 @@ Unlike with constructors or pattern-matching, we do not allow the module
 qualifier to be omitted, because we do not have a data constructor from which to
 determine it.
 
-
-Note [Fall back on lookupGlobalOccRn in lookupRecFieldOcc]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Whenever we fail to find the field or it is not in scope, mb_field
-will be False, and we fall back on looking it up normally using
-lookupGlobalOccRn.  We don't report an error immediately because the
-actual problem might be located elsewhere.  For example (#9975):
-
-   data Test = Test { x :: Int }
-   pattern Test wat = Test { x = wat }
-
-Here there are multiple declarations of Test (as a data constructor
-and as a pattern synonym), which will be reported as an error.  We
-shouldn't also report an error about the occurrence of `x` in the
-pattern synonym RHS.  However, if the pattern synonym gets added to
-the environment first, we will try and fail to find `x` amongst the
-(nonexistent) fields of the pattern synonym.
-
-Alternatively, the scope check can fail due to Template Haskell.
+Note [Record field names and Template Haskell]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider (#12130):
 
    module Foo where
@@ -669,7 +654,6 @@ lookupGlobalOccRn will find it.
 -}
 
 
-
 -- | Used in export lists to lookup the children.
 lookupSubBndrOcc_helper :: Bool -> Bool -> Name -> RdrName
                         -> RnM ChildLookupResult
@@ -834,7 +818,7 @@ lookupSubBndrOcc :: Bool
                  -> RdrName
                  -> RnM (Either NotInScopeError Name)
 -- Find all the things the rdr-name maps to
--- and pick the one with the right parent namep
+-- and pick the one with the right parent name
 lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name = do
   res <-
     lookupExactOrOrig rdr_name (FoundChild NoParent . NormalGreName) $
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index dbf1f88cba..b3360ad73b 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -690,7 +690,8 @@ extendGlobalRdrEnvRn :: [AvailInfo]
 -- see Note [Top-level Names in Template Haskell decl quotes]
 
 extendGlobalRdrEnvRn avails new_fixities
-  = do  { (gbl_env, lcl_env) <- getEnvs
+  = checkNoErrs $  -- See Note [Fail fast on duplicate definitions]
+    do  { (gbl_env, lcl_env) <- getEnvs
         ; stage <- getStage
         ; isGHCi <- getIsGHCi
         ; let rdr_env  = tcg_rdr_env gbl_env
@@ -767,7 +768,19 @@ extendGlobalRdrEnvRn avails new_fixities
               (False, True)  -> isNoFieldSelectorGRE gre'
               (False, False) -> False
 
-{-
+{- Note [Fail fast on duplicate definitions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If there are duplicate bindings for the same thing, we want to fail
+fast. Having two bindings for the same thing can cause follow-on errors.
+Example (test T9975a):
+   data Test = Test { x :: Int }
+   pattern Test wat = Test { x = wat }
+This defines 'Test' twice.  The second defn has no field-names; and then
+we get an error from Test { x=wat }, saying "Test has no field 'x'".
+
+Easiest thing is to bale out fast on duplicate definitions, which
+we do via `checkNoErrs` on `extendGlobalRdrEnvRn`.
+
 Note [Reporting duplicate local declarations]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 In general, a single module may not define the same OccName multiple times. This
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index 6497a51c02..1647c19e32 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -18,7 +18,7 @@ module GHC.Rename.Utils (
         warnForallIdentifier,
         checkUnusedRecordWildcard,
         mkFieldEnv,
-        badQualBndrErr, typeAppErr,
+        badQualBndrErr, typeAppErr, badFieldConErr,
         wrapGenSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genAppType,
         genHsIntegralLit, genHsTyLit,
         HsDocContext(..), pprHsDocContext,
@@ -616,6 +616,12 @@ typeAppErr what (L _ k)
             <+> quotes (char '@' <> ppr k))
        2 (text "Perhaps you intended to use TypeApplications")
 
+badFieldConErr :: Name -> FieldLabelString -> TcRnMessage
+badFieldConErr con field
+  = TcRnUnknownMessage $ mkPlainError noHints $
+    hsep [text "Constructor" <+> quotes (ppr con),
+          text "does not have field", quotes (ppr field)]
+
 -- | Ensure that a boxed or unboxed tuple has arity no larger than
 -- 'mAX_TUPLE_SIZE'.
 checkTupSize :: Int -> TcM ()