diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Rename/Env.hs | 38 | ||||
| -rw-r--r-- | compiler/GHC/Rename/Names.hs | 17 | ||||
| -rw-r--r-- | compiler/GHC/Rename/Utils.hs | 8 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Gen/Expr.hs | 3 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Gen/Pat.hs | 9 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Utils/Monad.hs | 2 |
6 files changed, 36 insertions, 41 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 () diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs index 230acdc3f5..46775235df 100644 --- a/compiler/GHC/Tc/Gen/Expr.hs +++ b/compiler/GHC/Tc/Gen/Expr.hs @@ -52,7 +52,6 @@ import GHC.Tc.Utils.Env import GHC.Tc.Gen.Arrow import GHC.Tc.Gen.Match import GHC.Tc.Gen.HsType -import GHC.Tc.Gen.Pat import GHC.Tc.Utils.TcMType import GHC.Tc.Types.Origin import GHC.Tc.Utils.TcType as TcType @@ -1399,7 +1398,7 @@ tcRecordField con_like flds_w_tys (L loc (FieldOcc sel_name lbl)) rhs -- (so the desugarer knows the type of local binder to make) ; return (Just (L loc (FieldOcc field_id lbl), rhs')) } | otherwise - = do { addErrTc (badFieldCon con_like field_lbl) + = do { addErrTc (badFieldConErr (getName con_like) field_lbl) ; return Nothing } where field_lbl = occNameFS $ rdrNameOcc (unLoc lbl) diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs index 6034d05720..132f58b7b4 100644 --- a/compiler/GHC/Tc/Gen/Pat.hs +++ b/compiler/GHC/Tc/Gen/Pat.hs @@ -21,7 +21,6 @@ module GHC.Tc.Gen.Pat , tcCheckPat, tcCheckPat_O, tcInferPat , tcPats , addDataConStupidTheta - , badFieldCon , polyPatSig ) where @@ -1282,7 +1281,7 @@ tcConArgs con_like arg_tys tenv penv con_args thing_inside = case con_args of -- f (R { foo = (a,b) }) = a+b -- If foo isn't one of R's fields, we don't want to crash when -- typechecking the "a+b". - [] -> failWith (badFieldCon con_like lbl) + [] -> failWith (badFieldConErr (getName con_like) lbl) -- The normal case, when the field comes from the right constructor (pat_ty : extras) -> do @@ -1489,12 +1488,6 @@ checkGADT conlike ex_tvs arg_tys = \case has_existentials :: Bool has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs -badFieldCon :: ConLike -> FieldLabelString -> TcRnMessage -badFieldCon con field - = TcRnUnknownMessage $ mkPlainError noHints $ - hsep [text "Constructor" <+> quotes (ppr con), - text "does not have field", quotes (ppr field)] - polyPatSig :: TcType -> SDoc polyPatSig sig_ty = hang (text "Illegal polymorphic type signature in pattern:") diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index ea3b50fa3c..ca2915e8fa 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -1142,7 +1142,7 @@ reportDiagnostic msg ----------------------- checkNoErrs :: TcM r -> TcM r -- (checkNoErrs m) succeeds iff m succeeds and generates no errors --- If m fails then (checkNoErrsTc m) fails. +-- If m fails then (checkNoErrs m) fails. -- If m succeeds, it checks whether m generated any errors messages -- (it might have recovered internally) -- If so, it fails too. |