lookupLocatedOccRn, lookupOccRn, lookupOccRn_maybe,
lookupLocalOccRn_maybe, lookupInfoOccRn,
lookupLocalOccThLvl_maybe, lookupLocalOccRn,
- lookupTypeOccRn, lookupKindOccRn,
+ lookupTypeOccRn,
lookupGlobalOccRn, lookupGlobalOccRn_maybe,
lookupOccRn_overloaded, lookupGlobalOccRn_overloaded, lookupExactOcc,
import HscTypes
import TcEnv
import TcRnMonad
-import RdrHsSyn ( setRdrNameSpace )
+import RdrHsSyn ( filterCTuple, setRdrNameSpace )
import TysWiredIn
import Name
import NameSet
import qualified GHC.LanguageExtensions as LangExt
import RnUnbound
import RnUtils
-import Data.Maybe (isJust)
import qualified Data.Semigroup as Semi
+import Data.Either ( partitionEithers )
+import Data.List (find)
{-
*********************************************************
= do { when (isQual rdr_name)
(addErrAt loc (badQualBndrErr rdr_name))
-- Binders should not be qualified; if they are, and with a different
- -- module name, we we get a confusing "M.T is not in scope" error later
+ -- module name, we get a confusing "M.T is not in scope" error later
; stage <- getStage
; if isBrackStage stage then
-----------------------------------------------
--- Used for record construction and pattern matching
--- When the -XDisambiguateRecordFields flag is on, take account of the
--- constructor name to disambiguate which field to use; it's just the
--- same as for instance decls
+-- | Look up an occurrence of a field in record construction or pattern
+-- matching (but not update). When the -XDisambiguateRecordFields
+-- flag is on, take account of the data constructor name to
+-- disambiguate which field to use.
--
--- NB: Consider this:
--- module Foo where { data R = R { fld :: Int } }
--- module Odd where { import Foo; fld x = x { fld = 3 } }
--- Arguably this should work, because the reference to 'fld' is
--- unambiguous because there is only one field id 'fld' in scope.
--- But currently it's rejected.
-
-lookupRecFieldOcc :: Maybe Name -- Nothing => just look it up as usual
- -- Just tycon => use tycon to disambiguate
- -> SDoc -> RdrName
+-- See Note [DisambiguateRecordFields].
+lookupRecFieldOcc :: Maybe Name -- Nothing => just look it up as usual
+ -- Just con => use data con to disambiguate
+ -> RdrName
-> RnM Name
-lookupRecFieldOcc parent doc rdr_name
- | Just tc_name <- parent
- = do { mb_name <- lookupSubBndrOcc True tc_name doc rdr_name
- ; case mb_name of
- Left err -> do { addErr err; return (mkUnboundNameRdr rdr_name) }
- Right n -> return n }
-
+lookupRecFieldOcc mb_con rdr_name
+ | Just con <- mb_con
+ , isUnboundName con -- Avoid error cascade
+ = return (mkUnboundNameRdr rdr_name)
+ | Just con <- mb_con
+ = do { flds <- lookupConstructorFields con
+ ; env <- getGlobalRdrEnv
+ ; let lbl = occNameFS (rdrNameOcc rdr_name)
+ mb_field = do fl <- find ((== lbl) . flLabel) flds
+ -- We have the label, now check it is in
+ -- scope (with the correct qualifier if
+ -- there is one, hence calling pickGREs).
+ gre <- lookupGRE_FieldLabel env fl
+ guard (not (isQual rdr_name
+ && null (pickGREs rdr_name [gre])))
+ return (fl, gre)
+ ; case mb_field of
+ Just (fl, gre) -> do { addUsedGRE True gre
+ ; return (flSelector fl) }
+ Nothing -> lookupGlobalOccRn 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.
= lookupGlobalOccRn rdr_name
+{- Note [DisambiguateRecordFields]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When we are looking up record fields in record construction or pattern
+matching, we can take advantage of the data constructor name to
+resolve fields that would otherwise be ambiguous (provided the
+-XDisambiguateRecordFields flag is on).
+
+For example, consider:
+
+ data S = MkS { x :: Int }
+ data T = MkT { x :: Int }
+
+ e = MkS { x = 3 }
+
+When we are renaming the occurrence of `x` in `e`, instead of looking
+`x` up directly (and finding both fields), lookupRecFieldOcc will
+search the fields of `MkS` to find the only possible `x` the user can
+mean.
+
+Of course, we still have to check the field is in scope, using
+lookupGRE_FieldLabel. The handling of qualified imports is slightly
+subtle: the occurrence may be unqualified even if the field is
+imported only qualified (but if the occurrence is qualified, the
+qualifier must be correct). For example:
+
+ module A where
+ data S = MkS { x :: Int }
+ data T = MkT { x :: Int }
+
+ module B where
+ import qualified A (S(..))
+ import A (T(MkT))
+
+ e1 = MkT { x = 3 } -- x not in scope, so fail
+ e2 = A.MkS { B.x = 3 } -- module qualifier is wrong, so fail
+ e3 = A.MkS { x = 3 } -- x in scope (lack of module qualifier permitted)
+
+In case `e1`, lookupGRE_FieldLabel will return Nothing. In case `e2`,
+lookupGRE_FieldLabel will return the GRE for `A.x`, but then the guard
+will fail because the field RdrName `B.x` is qualified and pickGREs
+rejects the GRE. In case `e3`, lookupGRE_FieldLabel will return the
+GRE for `A.x` and the guard will succeed because the field RdrName `x`
+is unqualified.
+
+
+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 (Trac #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.
+Consider (Trac #12130):
+
+ module Foo where
+ import M
+ b = $(funny)
+
+ module M(funny) where
+ data T = MkT { x :: Int }
+ funny :: Q Exp
+ funny = [| MkT { x = 3 } |]
+
+When we splice, `MkT` is not lexically in scope, so
+lookupGRE_FieldLabel will fail. But there is no need for
+disambiguation anyway, because `x` is an original name, and
+lookupGlobalOccRn will find it.
+-}
+
-- | Used in export lists to lookup the children.
NoParent -> Nothing
picked_gres :: [GlobalRdrElt] -> DisambigInfo
+ -- For Unqual, find GREs that are in scope qualified or unqualified
+ -- For Qual, find GREs that are in scope with that qualification
picked_gres gres
| isUnqual rdr_name
- = mconcat (map right_parent gres)
+ = mconcat (map right_parent gres)
| otherwise
- = mconcat (map right_parent (pickGREs rdr_name gres))
-
+ = mconcat (map right_parent (pickGREs rdr_name gres))
right_parent :: GlobalRdrElt -> DisambigInfo
right_parent p
- | Just cur_parent <- getParent p
- = if parent == cur_parent
- then DisambiguatedOccurrence p
- else NoOccurrence
- | otherwise
- = UniqueOccurrence p
+ = case getParent p of
+ Just cur_parent
+ | parent == cur_parent -> DisambiguatedOccurrence p
+ | otherwise -> NoOccurrence
+ Nothing -> UniqueOccurrence p
-- This domain specific datatype is used to record why we decided it was
NameNotFound -> return (Left (unknownSubordinateErr doc rdr_name))
FoundName _p n -> return (Right n)
FoundFL fl -> return (Right (flSelector fl))
- IncorrectParent {} -> return $ Left (unknownSubordinateErr doc rdr_name)
-
+ IncorrectParent {}
+ -- See [Mismatched class methods and associated type families]
+ -- in TcInstDecls.
+ -> return $ Left (unknownSubordinateErr doc rdr_name)
{-
Note [Family instance binders]
Just name -> return name
Nothing -> unboundName WL_LocalOnly rdr_name }
-lookupKindOccRn :: RdrName -> RnM Name
--- Looking up a name occurring in a kind
-lookupKindOccRn rdr_name
- | isVarOcc (rdrNameOcc rdr_name) -- See Note [Promoted variables in types]
- = badVarInType rdr_name
- | otherwise
- = do { typeintype <- xoptM LangExt.TypeInType
- ; if | typeintype -> lookupTypeOccRn rdr_name
- -- With -XNoTypeInType, treat any usage of * in kinds as in scope
- -- this is a dirty hack, but then again so was the old * kind.
- | isStar rdr_name -> return starKindTyConName
- | isUniStar rdr_name -> return unicodeStarKindTyConName
- | otherwise -> lookupOccRn rdr_name }
-
-- lookupPromotedOccRn looks up an optionally promoted RdrName.
lookupTypeOccRn :: RdrName -> RnM Name
-- see Note [Demotion]
= badVarInType rdr_name
| otherwise
= do { mb_name <- lookupOccRn_maybe rdr_name
- ; case mb_name of {
- Just name -> return name ;
- Nothing -> do { dflags <- getDynFlags
- ; lookup_demoted rdr_name dflags } } }
+ ; case mb_name of
+ Just name -> return name
+ Nothing -> lookup_demoted rdr_name }
-lookup_demoted :: RdrName -> DynFlags -> RnM Name
-lookup_demoted rdr_name dflags
+lookup_demoted :: RdrName -> RnM Name
+lookup_demoted rdr_name
| Just demoted_rdr <- demoteRdrName rdr_name
-- Maybe it's the name of a *data* constructor
= do { data_kinds <- xoptM LangExt.DataKinds
+ ; star_is_type <- xoptM LangExt.StarIsType
+ ; let star_info = starInfo star_is_type rdr_name
; if data_kinds
then do { mb_demoted_name <- lookupOccRn_maybe demoted_rdr
; case mb_demoted_name of
mb_demoted_name <- discardErrs $
lookupOccRn_maybe demoted_rdr
; let suggestion | isJust mb_demoted_name = suggest_dk
- | otherwise = star_info
+ | otherwise = star_info
; unboundNameX WL_Any rdr_name suggestion } }
| otherwise
, text "instead of"
, quotes (ppr name) <> dot ]
- star_info
- | isStar rdr_name || isUniStar rdr_name
- = if xopt LangExt.TypeInType dflags
- then text "NB: With TypeInType, you must import" <+>
- ppr rdr_name <+> text "from Data.Kind"
- else empty
-
- | otherwise
- = empty
-
-
badVarInType :: RdrName -> RnM Name
badVarInType rdr_name
= do { addErr (text "Illegal promoted term variable in a type:"
-- See Note [Fixity signature lookup]
lookupLocalTcNames ctxt what rdr_name
= do { mb_gres <- mapM lookup (dataTcOccs rdr_name)
- ; let (errs, names) = splitEithers mb_gres
+ ; let (errs, names) = partitionEithers mb_gres
; when (null names) $ addErr (head errs) -- Bleat about one only
; return names }
where
- lookup rdr = do { name <- lookupBindGroupOcc ctxt what rdr
- ; return (fmap ((,) rdr) name) }
+ lookup rdr = do { this_mod <- getModule
+ ; nameEither <- lookupBindGroupOcc ctxt what rdr
+ ; return (guard_builtin_syntax this_mod rdr nameEither) }
+
+ -- Guard against the built-in syntax (ex: `infixl 6 :`), see #15233
+ guard_builtin_syntax this_mod rdr (Right name)
+ | Just _ <- isBuiltInOcc_maybe (occName rdr)
+ , this_mod /= nameModule name
+ = Left (hsep [text "Illegal", what, text "of built-in syntax:", ppr rdr])
+ | otherwise
+ = Right (rdr, name)
+ guard_builtin_syntax _ _ (Left err) = Left err
dataTcOccs :: RdrName -> [RdrName]
-- Return both the given name and the same name promoted to the TcClsName
lookupSyntaxNames std_names
= do { rebindable_on <- xoptM LangExt.RebindableSyntax
; if not rebindable_on then
- return (map (HsVar . noLoc) std_names, emptyFVs)
+ return (map (HsVar noExt . noLoc) std_names, emptyFVs)
else
do { usr_names <- mapM (lookupOccRn . mkRdrUnqual . nameOccName) std_names
- ; return (map (HsVar . noLoc) usr_names, mkFVs usr_names) } }
+ ; return (map (HsVar noExt . noLoc) usr_names, mkFVs usr_names) } }
-- Error messages
--
-- (See Trac #13968.)
where
- occ = rdrNameOcc name
+ occ = rdrNameOcc $ filterCTuple name
git.haskell.org / ghc.git / blobdiff