{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs            #-}
{-# LANGUAGE MultiWayIf       #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TupleSections    #-}

{-
(c) The GRASP/AQUA Project, Glasgow University, 1992-2006

GHC.Rename.Env contains functions which convert RdrNames into Names.

-}

module GHC.Rename.Env (
        newTopSrcBinder,

        lookupLocatedTopBndrRn, lookupLocatedTopBndrRnN, lookupTopBndrRn,
        lookupLocatedTopConstructorRn, lookupLocatedTopConstructorRnN,

        lookupLocatedOccRn, lookupLocatedOccRnConstr, lookupLocatedOccRnRecField,
        lookupLocatedOccRnNone,
        lookupOccRn, lookupOccRn_maybe, lookupSameOccRn_maybe,
        lookupLocalOccRn_maybe, lookupInfoOccRn,
        lookupLocalOccThLvl_maybe, lookupLocalOccRn,
        lookupTypeOccRn,
        lookupGlobalOccRn, lookupGlobalOccRn_maybe,

        lookupExprOccRn,
        lookupRecFieldOcc,
        lookupRecUpdFields,
        getFieldUpdLbl,
        getUpdFieldLbls,

        ChildLookupResult(..),
        lookupSubBndrOcc_helper,

        HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn, lookupSigOccRnN,
        lookupSigCtxtOccRn,

        lookupInstDeclBndr, lookupFamInstName,
        lookupConstructorInfo, lookupConstructorFields,
        lookupGREInfo,

        irrefutableConLikeRn, irrefutableConLikeTc,

        lookupGreAvailRn,

        -- Rebindable Syntax
        lookupSyntax, lookupSyntaxExpr, lookupSyntaxNames,
        lookupSyntaxName,
        lookupIfThenElse,

        -- QualifiedDo
        lookupQualifiedDoExpr, lookupQualifiedDo,
        lookupQualifiedDoName, lookupNameWithQualifier,

        -- Constructing usage information
        DeprecationWarnings(..),
        addUsedGRE, addUsedGREs, addUsedDataCons,

        dataTcOccs, --TODO: Move this somewhere, into utils?

    ) where

import GHC.Prelude

import Language.Haskell.Syntax.Basic (FieldLabelString(..))

import GHC.Iface.Load
import GHC.Iface.Env
import GHC.Hs
import GHC.Types.Name.Reader
import GHC.Tc.Errors.Types
import GHC.Tc.Errors.Ppr (pprScopeError)
import GHC.Tc.Utils.Env
import GHC.Tc.Types.LclEnv
import GHC.Tc.Utils.Monad
import GHC.Parser.PostProcess ( setRdrNameSpace )
import GHC.Builtin.Types
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env
import GHC.Types.Avail
import GHC.Types.Hint
import GHC.Types.Error
import GHC.Unit.Module
import GHC.Unit.Module.ModIface
import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Builtin.Names( rOOT_MAIN )
import GHC.Types.Basic  ( TopLevelFlag(..), TupleSort(..), tupleSortBoxity )
import GHC.Types.TyThing ( tyThingGREInfo )
import GHC.Types.SrcLoc as SrcLoc
import GHC.Utils.Outputable as Outputable
import GHC.Types.Unique.FM
import GHC.Types.Unique.DSet
import GHC.Types.Unique.Set
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Data.Maybe
import GHC.Driver.Env
import GHC.Driver.Session
import GHC.Data.FastString
import GHC.Data.List.SetOps ( minusList )
import qualified GHC.LanguageExtensions as LangExt
import GHC.Rename.Unbound
import GHC.Rename.Utils
import GHC.Data.Bag
import GHC.Types.CompleteMatch
import GHC.Types.PkgQual
import GHC.Types.GREInfo

import Control.Arrow    ( first )
import Control.Monad
import Data.Either      ( partitionEithers )
import Data.Function    ( on )
import Data.List        ( find, partition, groupBy, sortBy )
import qualified Data.List.NonEmpty as NE
import qualified Data.Semigroup as Semi
import System.IO.Unsafe ( unsafePerformIO )

{-
*********************************************************
*                                                      *
                Source-code binders
*                                                      *
*********************************************************

Note [Signature lazy interface loading]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

GHC's lazy interface loading can be a bit confusing, so this Note is an
empirical description of what happens in one interesting case. When
compiling a signature module against an its implementation, we do NOT
load interface files associated with its names until after the type
checking phase.  For example:

    module ASig where
        data T
        f :: T -> T

Suppose we compile this with -sig-of "A is ASig":

    module B where
        data T = T
        f T = T

    module A(module B) where
        import B

During type checking, we'll load A.hi because we need to know what the
RdrEnv for the module is, but we DO NOT load the interface for B.hi!
It's wholly unnecessary: our local definition 'data T' in ASig is all
the information we need to finish type checking.  This is contrast to
type checking of ordinary Haskell files, in which we would not have the
local definition "data T" and would need to consult B.hi immediately.
(Also, this situation never occurs for hs-boot files, since you're not
allowed to reexport from another module.)

After type checking, we then check that the types we provided are
consistent with the backing implementation (in checkHiBootOrHsigIface).
At this point, B.hi is loaded, because we need something to compare
against.

I discovered this behavior when trying to figure out why type class
instances for Data.Map weren't in the EPS when I was type checking a
test very much like ASig (sigof02dm): the associated interface hadn't
been loaded yet!  (The larger issue is a moot point, since an instance
declared in a signature can never be a duplicate.)

This behavior might change in the future.  Consider this
alternate module B:

    module B where
        {-# DEPRECATED T, f "Don't use" #-}
        data T = T
        f T = T

One might conceivably want to report deprecation warnings when compiling
ASig with -sig-of B, in which case we need to look at B.hi to find the
deprecation warnings during renaming.  At the moment, you don't get any
warning until you use the identifier further downstream.  This would
require adjusting addUsedGRE so that during signature compilation,
we do not report deprecation warnings for LocalDef.  See also
Note [Handling of deprecations] in GHC.Rename.Utils
-}

newTopSrcBinder :: LocatedN RdrName -> RnM Name
newTopSrcBinder :: LocatedN RdrName -> RnM Name
newTopSrcBinder (L SrcSpanAnnN
loc RdrName
rdr_name)
  | Just Name
name <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr_name
  =     -- This is here to catch
        --   (a) Exact-name binders created by Template Haskell
        --   (b) The PrelBase defn of (say) [] and similar, for which
        --       the parser reads the special syntax and returns an Exact RdrName
        -- We are at a binding site for the name, so check first that it
        -- the current module is the correct one; otherwise GHC can get
        -- very confused indeed. This test rejects code like
        --      data T = (,) Int Int
        -- unless we are in GHC.Tup
    if Name -> Bool
isExternalName Name
name then
      do { this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
         ; unless (this_mod == nameModule name)
                  (addErrAt (locA loc) (TcRnBindingOfExistingName rdr_name))
         ; return name }
    else   -- See Note [Binders in Template Haskell] in "GHC.ThToHs"
      do { this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
         ; externaliseName this_mod name }

  | Just (Module
rdr_mod, OccName
rdr_occ) <- RdrName -> Maybe (Module, OccName)
isOrig_maybe RdrName
rdr_name
  = do  { this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
        ; unless (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
                 (addErrAt (locA loc) (TcRnBindingOfExistingName rdr_name))
        -- When reading External Core we get Orig names as binders,
        -- but they should agree with the module gotten from the monad
        --
        -- We can get built-in syntax showing up here too, sadly.  If you type
        --      data T = (,,,)
        -- the constructor is parsed as a type, and then GHC.Parser.PostProcess.tyConToDataCon
        -- uses setRdrNameSpace to make it into a data constructors.  At that point
        -- the nice Exact name for the TyCon gets swizzled to an Orig name.
        -- Hence the TcRnBindingOfExistingName error message.
        --

        -- MP 2022: I suspect this code path is never called for `rOOT_MAIN` anymore
        -- because External Core has been removed but we instead have some similar logic for
        -- serialising whole programs into interface files in GHC.IfaceToCore.mk_top_id.

        -- Except for the ":Main.main = ..." definition inserted into
        -- the Main module; ugh!

        -- Because of this latter case, we call newGlobalBinder with a module from
        -- the RdrName, not from the environment.  In principle, it'd be fine to
        -- have an arbitrary mixture of external core definitions in a single module,
        -- (apart from module-initialisation issues, perhaps).
        ; newGlobalBinder rdr_mod rdr_occ (locA loc) }

  | Bool
otherwise
  = do  { Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RdrName -> Bool
isQual RdrName
rdr_name)
                 (SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt (SrcSpanAnnN -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA SrcSpanAnnN
loc) (RdrName -> TcRnMessage
badQualBndrErr RdrName
rdr_name))
                -- Binders should not be qualified; if they are, and with a different
                -- module name, we get a confusing "M.T is not in scope" error later

        ; stage <- TcM ThStage
getStage
        ; if isBrackStage stage then
                -- We are inside a TH bracket, so make an *Internal* name
                -- See Note [Top-level Names in Template Haskell decl quotes] in GHC.Rename.Names
             do { uniq <- newUnique
                ; return (mkInternalName uniq (rdrNameOcc rdr_name) (locA loc)) }
          else
             do { this_mod <- getModule
                ; traceRn "newTopSrcBinder" (ppr this_mod $$ ppr rdr_name $$ ppr (locA loc))
                ; newGlobalBinder this_mod (rdrNameOcc rdr_name) (locA loc) }
        }

{-
*********************************************************
*                                                      *
        Source code occurrences
*                                                      *
*********************************************************

Looking up a name in the GHC.Rename.Env.

Note [Type and class operator definitions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We want to reject all of these unless we have -XTypeOperators (#3265)
   data a :*: b  = ...
   class a :*: b where ...
   data (:*:) a b  = ....
   class (:*:) a b where ...
The latter two mean that we are not just looking for a
*syntactically-infix* declaration, but one that uses an operator
OccName.  We use OccName.isSymOcc to detect that case, which isn't
terribly efficient, but there seems to be no better way.
-}

-- Can be made to not be exposed
-- Only used unwrapped in rnAnnProvenance
lookupTopBndrRn :: WhatLooking -> RdrName -> RnM Name
-- Look up a top-level source-code binder.   We may be looking up an unqualified 'f',
-- and there may be several imported 'f's too, which must not confuse us.
-- For example, this is OK:
--      import Foo( f )
--      infix 9 f       -- The 'f' here does not need to be qualified
--      f x = x         -- Nor here, of course
-- So we have to filter out the non-local ones.
--
-- A separate function (importsFromLocalDecls) reports duplicate top level
-- decls, so here it's safe just to choose an arbitrary one.
lookupTopBndrRn :: WhatLooking -> RdrName -> RnM Name
lookupTopBndrRn WhatLooking
which_suggest RdrName
rdr_name =
  RdrName -> (GlobalRdrElt -> Name) -> RnM Name -> RnM Name
forall r. RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName (RnM Name -> RnM Name) -> RnM Name -> RnM Name
forall a b. (a -> b) -> a -> b
$
    do  {  -- Check for operators in type or class declarations
           -- See Note [Type and class operator definitions]
          let occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
rdr_name
        ; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OccName -> Bool
isTcOcc OccName
occ Bool -> Bool -> Bool
&& OccName -> Bool
isSymOcc OccName
occ)
               (do { op_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.TypeOperators
                   ; unless op_ok (addErr (TcRnIllegalTypeOperatorDecl rdr_name)) })
        ; env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
        ; case filter isLocalGRE (lookupGRE env $ LookupRdrName rdr_name $ RelevantGREsFOS WantNormal) of
            [GlobalRdrElt
gre] -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre)
            [GlobalRdrElt]
_     -> do -- Ambiguous (can't happen) or unbound
                        String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupTopBndrRN fail" (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
                        LookingFor -> RdrName -> RnM Name
unboundName (WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
which_suggest WhereLooking
WL_LocalTop) RdrName
rdr_name
    }

lookupLocatedTopConstructorRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopConstructorRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopConstructorRn = (RdrName -> RnM Name) -> Located RdrName -> RnM (Located Name)
forall t a b.
HasLoc t =>
(a -> TcM b) -> GenLocated t a -> TcM (Located b)
wrapLocM (WhatLooking -> RdrName -> RnM Name
lookupTopBndrRn WhatLooking
WL_Constructor)

lookupLocatedTopConstructorRnN :: LocatedN RdrName -> RnM (LocatedN Name)
lookupLocatedTopConstructorRnN :: LocatedN RdrName -> RnM (LocatedN Name)
lookupLocatedTopConstructorRnN = (RdrName -> RnM Name) -> LocatedN RdrName -> RnM (LocatedN Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
wrapLocMA (WhatLooking -> RdrName -> RnM Name
lookupTopBndrRn WhatLooking
WL_Constructor)

lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopBndrRn = (RdrName -> RnM Name) -> Located RdrName -> RnM (Located Name)
forall t a b.
HasLoc t =>
(a -> TcM b) -> GenLocated t a -> TcM (Located b)
wrapLocM (WhatLooking -> RdrName -> RnM Name
lookupTopBndrRn WhatLooking
WL_Anything)

lookupLocatedTopBndrRnN :: LocatedN RdrName -> RnM (LocatedN Name)
lookupLocatedTopBndrRnN :: LocatedN RdrName -> RnM (LocatedN Name)
lookupLocatedTopBndrRnN = (RdrName -> RnM Name) -> LocatedN RdrName -> RnM (LocatedN Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
wrapLocMA (WhatLooking -> RdrName -> RnM Name
lookupTopBndrRn WhatLooking
WL_Anything)

-- | Lookup an @Exact@ @RdrName@. See Note [Looking up Exact RdrNames].
-- This never adds an error, but it may return one, see
-- Note [Errors in lookup functions]
lookupExactOcc_either :: Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupExactOcc_either :: Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupExactOcc_either Name
name
  | Just TyThing
thing <- Name -> Maybe TyThing
wiredInNameTyThing_maybe Name
name
  , Just (TyCon
tycon, TupleSort -> GREInfo
mkInfo)
      <- case TyThing
thing of
          ATyCon TyCon
tc ->
            (TyCon, TupleSort -> GREInfo)
-> Maybe (TyCon, TupleSort -> GREInfo)
forall a. a -> Maybe a
Just (TyCon
tc, TyConFlavour Name -> GREInfo
IAmTyCon (TyConFlavour Name -> GREInfo)
-> (TupleSort -> TyConFlavour Name) -> TupleSort -> GREInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Boxity -> TyConFlavour Name
forall tc. Boxity -> TyConFlavour tc
TupleFlavour (Boxity -> TyConFlavour Name)
-> (TupleSort -> Boxity) -> TupleSort -> TyConFlavour Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TupleSort -> Boxity
tupleSortBoxity)
          AConLike (RealDataCon DataCon
dc) ->
            let tc :: TyCon
tc = DataCon -> TyCon
dataConTyCon DataCon
dc
            in (TyCon, TupleSort -> GREInfo)
-> Maybe (TyCon, TupleSort -> GREInfo)
forall a. a -> Maybe a
Just (TyCon
tc, ConInfo -> GREInfo
IAmConLike (ConInfo -> GREInfo)
-> (TupleSort -> ConInfo) -> TupleSort -> GREInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ TupleSort
_ -> ConLikeInfo -> Arity -> [FieldLabel] -> ConInfo
mkConInfo ([Name] -> ConLikeInfo
ConIsData ([Name] -> ConLikeInfo) -> [Name] -> ConLikeInfo
forall a b. (a -> b) -> a -> b
$ (DataCon -> Name) -> [DataCon] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> Name
dataConName ([DataCon] -> [Name]) -> [DataCon] -> [Name]
forall a b. (a -> b) -> a -> b
$ TyCon -> [DataCon]
tyConDataCons TyCon
tc) (DataCon -> Arity
dataConSourceArity DataCon
dc) []))
          TyThing
_ -> Maybe (TyCon, TupleSort -> GREInfo)
forall a. Maybe a
Nothing
  , Just TupleSort
tupleSort <- TyCon -> Maybe TupleSort
tyConTuple_maybe TyCon
tycon
  = do { let tupArity :: Arity
tupArity = case TupleSort
tupleSort of
               -- Unboxed tuples have twice as many arguments because of the
               -- 'RuntimeRep's (#17837)
               TupleSort
UnboxedTuple -> TyCon -> Arity
tyConArity TyCon
tycon Arity -> Arity -> Arity
forall a. Integral a => a -> a -> a
`div` Arity
2
               TupleSort
_ -> TyCon -> Arity
tyConArity TyCon
tycon
       ; let info :: GREInfo
info = TupleSort -> GREInfo
mkInfo TupleSort
tupleSort
       ; Arity -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkTupSize Arity
tupArity
       ; Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either NotInScopeError GlobalRdrElt
 -> RnM (Either NotInScopeError GlobalRdrElt))
-> Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Either NotInScopeError GlobalRdrElt
forall a b. b -> Either a b
Right (GlobalRdrElt -> Either NotInScopeError GlobalRdrElt)
-> GlobalRdrElt -> Either NotInScopeError GlobalRdrElt
forall a b. (a -> b) -> a -> b
$ Name -> GREInfo -> GlobalRdrElt
mkExactGRE Name
name GREInfo
info }

  | Name -> Bool
isExternalName Name
name
  = do { info <- Name -> RnM GREInfo
lookupExternalExactName Name
name
       ; return $ Right $ mkExactGRE name info }

  | Bool
otherwise
  = Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupLocalExactGRE Name
name

lookupExternalExactName :: Name -> RnM GREInfo
lookupExternalExactName :: Name -> RnM GREInfo
lookupExternalExactName Name
name
  = do { thing <-
           case Name -> Maybe TyThing
wiredInNameTyThing_maybe Name
name of
             Just TyThing
thing -> TyThing -> IOEnv (Env TcGblEnv TcLclEnv) TyThing
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return TyThing
thing
             Maybe TyThing
_          -> Name -> IOEnv (Env TcGblEnv TcLclEnv) TyThing
tcLookupGlobal Name
name
       ; return $ tyThingGREInfo thing }

lookupLocalExactGRE :: Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupLocalExactGRE :: Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupLocalExactGRE Name
name
  = do { env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
       ; let lk = LookupExactName { lookupExactName :: Name
lookupExactName = Name
name
                                  , lookInAllNameSpaces :: Bool
lookInAllNameSpaces = Bool
True }
             -- We want to check for clashes where the same Unique
             -- occurs in two different NameSpaces, as per
             -- Note [Template Haskell ambiguity]. So we
             -- check ALL namespaces, not just the NameSpace of the Name.
             -- See test cases T9066, T11809.
       ; case lookupGRE env lk of
           [GlobalRdrElt
gre] -> Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Either NotInScopeError GlobalRdrElt
forall a b. b -> Either a b
Right GlobalRdrElt
gre)

           []    -> -- See Note [Splicing Exact names]
                    do { lcl_env <- RnM LocalRdrEnv
getLocalRdrEnv
                       ; let gre = Parent -> Name -> GlobalRdrElt
mkLocalVanillaGRE Parent
NoParent Name
name -- LocalRdrEnv only contains Vanilla things
                       ; if name `inLocalRdrEnvScope` lcl_env
                         then return (Right gre)
                         else
                         do { th_topnames_var <- fmap tcg_th_topnames getGblEnv
                            ; th_topnames <- readTcRef th_topnames_var
                            ; if name `elemNameSet` th_topnames
                              then return (Right gre)
                              else return (Left (NoExactName name))
                            }
                       }

           [GlobalRdrElt]
gres -> Either NotInScopeError GlobalRdrElt
-> RnM (Either NotInScopeError GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NotInScopeError -> Either NotInScopeError GlobalRdrElt
forall a b. a -> Either a b
Left ([GlobalRdrElt] -> NotInScopeError
SameName [GlobalRdrElt]
gres)) }
           -- Ugh!  See Note [Template Haskell ambiguity] }

-----------------------------------------------
lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
-- This is called on the method name on the left-hand side of an
-- instance declaration binding. eg.  instance Functor T where
--                                       fmap = ...
--                                       ^^^^ called on this
-- Regardless of how many unqualified fmaps are in scope, we want
-- the one that comes from the Functor class.
--
-- Furthermore, note that we take no account of whether the
-- name is only in scope qualified.  I.e. even if method op is
-- in scope as M.op, we still allow plain 'op' on the LHS of
-- an instance decl
--
-- The "what" parameter says "method" or "associated type",
-- depending on what we are looking up
lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
lookupInstDeclBndr Name
cls SDoc
what RdrName
rdr
  = do { Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RdrName -> Bool
isQual RdrName
rdr)
              (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (RdrName -> TcRnMessage
badQualBndrErr RdrName
rdr))
                -- In an instance decl you aren't allowed
                -- to use a qualified name for the method
                -- (Although it'd make perfect sense.)
       ; mb_name <- DeprecationWarnings
-> Name -> SDoc -> RdrName -> RnM (Either NotInScopeError Name)
lookupSubBndrOcc
                          DeprecationWarnings
NoDeprecationWarnings
                                -- we don't give deprecated
                                -- warnings when a deprecated class
                                -- method is defined. We only warn
                                -- when it's used
                          Name
cls SDoc
doc RdrName
rdr
       ; case mb_name of
           Left NotInScopeError
err -> do { TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (RdrName -> NotInScopeError -> TcRnMessage
mkTcRnNotInScope RdrName
rdr NotInScopeError
err)
                          ; Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr) }
           Right Name
nm -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
nm }
  where
    doc :: SDoc
doc = SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
cls)

-----------------------------------------------
lookupFamInstName :: Maybe Name -> LocatedN RdrName
                  -> RnM (LocatedN Name)
-- Used for TyData and TySynonym family instances only,
-- See Note [Family instance binders]
lookupFamInstName :: Maybe Name -> LocatedN RdrName -> RnM (LocatedN Name)
lookupFamInstName (Just Name
cls) LocatedN RdrName
tc_rdr  -- Associated type; c.f GHC.Rename.Bind.rnMethodBind
  = (RdrName -> RnM Name) -> LocatedN RdrName -> RnM (LocatedN Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
wrapLocMA (Name -> SDoc -> RdrName -> RnM Name
lookupInstDeclBndr Name
cls (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"associated type")) LocatedN RdrName
tc_rdr
lookupFamInstName Maybe Name
Nothing LocatedN RdrName
tc_rdr     -- Family instance; tc_rdr is an *occurrence*
  = LocatedN RdrName -> RnM (LocatedN Name)
forall ann.
GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnConstr LocatedN RdrName
tc_rdr

-----------------------------------------------
lookupConstructorFields :: HasDebugCallStack => Name -> RnM [FieldLabel]
lookupConstructorFields :: HasDebugCallStack => Name -> RnM [FieldLabel]
lookupConstructorFields = (ConInfo -> [FieldLabel])
-> IOEnv (Env TcGblEnv TcLclEnv) ConInfo -> RnM [FieldLabel]
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConInfo -> [FieldLabel]
conInfoFields (IOEnv (Env TcGblEnv TcLclEnv) ConInfo -> RnM [FieldLabel])
-> (Name -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo)
-> Name
-> RnM [FieldLabel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => Name -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
Name -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
lookupConstructorInfo

-- | Look up the arity and record fields of a constructor.
lookupConstructorInfo :: HasDebugCallStack => Name -> RnM ConInfo
lookupConstructorInfo :: HasDebugCallStack => Name -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
lookupConstructorInfo Name
con_name
  = do { info <- HasDebugCallStack => Name -> RnM GREInfo
Name -> RnM GREInfo
lookupGREInfo_GRE Name
con_name
       ; case info of
            IAmConLike ConInfo
con_info -> ConInfo -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ConInfo
con_info
            GREInfo
UnboundGRE          -> ConInfo -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConInfo -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo)
-> ConInfo -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
forall a b. (a -> b) -> a -> b
$ ConLikeInfo -> ConFieldInfo -> ConInfo
ConInfo ([Name] -> ConLikeInfo
ConIsData []) ConFieldInfo
ConHasPositionalArgs
            IAmTyCon {}         -> WhatLooking -> Name -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
forall a. WhatLooking -> Name -> TcM a
failIllegalTyCon WhatLooking
WL_Constructor Name
con_name
            GREInfo
_ -> String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"lookupConstructorInfo: not a ConLike" (SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo)
-> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ConInfo
forall a b. (a -> b) -> a -> b
$
                      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"name:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
con_name ]
       }

-- In CPS style as `RnM r` is monadic
-- Reports an error if the name is an Exact or Orig and it can't find the name
-- Otherwise if it is not an Exact or Orig, returns k
lookupExactOrOrig :: RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig :: forall r. RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name GlobalRdrElt -> r
res RnM r
k
  = do { men <- RdrName -> RnM ExactOrOrigResult
lookupExactOrOrig_base RdrName
rdr_name
       ; case men of
          FoundExactOrOrig GlobalRdrElt
gre -> r -> RnM r
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> RnM r) -> r -> RnM r
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> r
res GlobalRdrElt
gre
          ExactOrOrigResult
NotExactOrOrig       -> RnM r
k
          ExactOrOrigError NotInScopeError
e   ->
            do { TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (RdrName -> NotInScopeError -> TcRnMessage
mkTcRnNotInScope RdrName
rdr_name NotInScopeError
e)
               ; r -> RnM r
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> RnM r) -> r -> RnM r
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> r
res (RdrName -> GlobalRdrElt
mkUnboundGRERdr RdrName
rdr_name) } }

-- Variant of 'lookupExactOrOrig' that does not report an error
-- See Note [Errors in lookup functions]
-- Calls k if the name is neither an Exact nor Orig
lookupExactOrOrig_maybe :: RdrName -> (Maybe GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe :: forall r. RdrName -> (Maybe GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe RdrName
rdr_name Maybe GlobalRdrElt -> r
res RnM r
k
  = do { men <- RdrName -> RnM ExactOrOrigResult
lookupExactOrOrig_base RdrName
rdr_name
       ; case men of
           FoundExactOrOrig GlobalRdrElt
gre -> r -> RnM r
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt -> r
res (GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just GlobalRdrElt
gre))
           ExactOrOrigError NotInScopeError
_   -> r -> RnM r
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt -> r
res Maybe GlobalRdrElt
forall a. Maybe a
Nothing)
           ExactOrOrigResult
NotExactOrOrig       -> RnM r
k }

data ExactOrOrigResult
  = FoundExactOrOrig GlobalRdrElt
    -- ^ Found an Exact Or Orig Name
  | ExactOrOrigError NotInScopeError
    -- ^ The RdrName was an Exact
     -- or Orig, but there was an
     -- error looking up the Name
  | NotExactOrOrig
    -- ^ The RdrName is neither an Exact nor Orig

-- Does the actual looking up an Exact or Orig name, see 'ExactOrOrigResult'
lookupExactOrOrig_base :: RdrName -> RnM ExactOrOrigResult
lookupExactOrOrig_base :: RdrName -> RnM ExactOrOrigResult
lookupExactOrOrig_base RdrName
rdr_name
  | Just Name
n <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr_name   -- This happens in derived code
  = Either NotInScopeError GlobalRdrElt -> ExactOrOrigResult
cvtEither (Either NotInScopeError GlobalRdrElt -> ExactOrOrigResult)
-> RnM (Either NotInScopeError GlobalRdrElt)
-> RnM ExactOrOrigResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupExactOcc_either Name
n
  | Just (Module
rdr_mod, OccName
rdr_occ) <- RdrName -> Maybe (Module, OccName)
isOrig_maybe RdrName
rdr_name
  = do { nm <- Module -> OccName -> RnM Name
forall a b. Module -> OccName -> TcRnIf a b Name
lookupOrig Module
rdr_mod OccName
rdr_occ

       ; this_mod <- getModule
       ; mb_gre <-
         if nameIsLocalOrFrom this_mod nm
         then lookupLocalExactGRE nm
         else do { info <- lookupExternalExactName nm
                 ; return $ Right $ mkExactGRE nm info }
       ; return $ case mb_gre of
          Left  NotInScopeError
err -> NotInScopeError -> ExactOrOrigResult
ExactOrOrigError NotInScopeError
err
          Right GlobalRdrElt
gre -> GlobalRdrElt -> ExactOrOrigResult
FoundExactOrOrig GlobalRdrElt
gre }
  | Bool
otherwise = ExactOrOrigResult -> RnM ExactOrOrigResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ExactOrOrigResult
NotExactOrOrig
  where
    cvtEither :: Either NotInScopeError GlobalRdrElt -> ExactOrOrigResult
cvtEither (Left NotInScopeError
e)    = NotInScopeError -> ExactOrOrigResult
ExactOrOrigError NotInScopeError
e
    cvtEither (Right GlobalRdrElt
gre) = GlobalRdrElt -> ExactOrOrigResult
FoundExactOrOrig GlobalRdrElt
gre

{- Note [Errors in lookup functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Many of these lookup functions will attach an error if it can't find the Name it
is trying to lookup. However there are also _maybe and _either variants for many
of these functions.

These variants should *not* attach any errors, as there are
places where we want to attempt looking up a name, but it's not the end of the
world if we don't find it.

For example, see lookupThName_maybe: It calls lookupOccRn_maybe multiple
times for varying names in different namespaces. lookupOccRn_maybe should
therefore never attach an error, instead just return a Nothing.

For these _maybe/_either variant functions then, avoid calling further lookup
functions that can attach errors and instead call their _maybe/_either
counterparts.
-}

-----------------------------------------------
-- | Look up an occurrence of a field in record construction or pattern
-- matching (but not update).
--
-- If -XDisambiguateRecordFields is off, then we will pass 'Nothing' for the
-- 'DataCon' 'Name', i.e. we don't use the data constructor for disambiguation.
-- See Note [DisambiguateRecordFields] and Note [NoFieldSelectors].
lookupRecFieldOcc :: Maybe Name -- Nothing  => just look it up as usual
                                -- Just con => use data con to disambiguate
                  -> RdrName
                  -> RnM Name
lookupRecFieldOcc :: Maybe Name -> RdrName -> RnM Name
lookupRecFieldOcc Maybe Name
mb_con RdrName
rdr_name
  | Just Name
con <- Maybe Name
mb_con
  , Name -> Bool
isUnboundName Name
con  -- Avoid error cascade
  = Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RnM Name) -> Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ Name -> Name
mk_unbound_rec_fld Name
con
  | Just Name
con <- Maybe Name
mb_con
  = do { let lbl :: FieldLabelString
lbl = FastString -> FieldLabelString
FieldLabelString (FastString -> FieldLabelString) -> FastString -> FieldLabelString
forall a b. (a -> b) -> a -> b
$ OccName -> FastString
occNameFS (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
       ; mb_nm <- RdrName
-> (GlobalRdrElt -> Maybe Name)
-> RnM (Maybe Name)
-> RnM (Maybe Name)
forall r. RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name GlobalRdrElt -> Maybe Name
ensure_recfld (RnM (Maybe Name) -> RnM (Maybe Name))
-> RnM (Maybe Name) -> RnM (Maybe Name)
forall a b. (a -> b) -> a -> b
$  -- See Note [Record field names and Template Haskell]
            do { flds <- HasDebugCallStack => Name -> RnM [FieldLabel]
Name -> RnM [FieldLabel]
lookupConstructorFields Name
con
               ; env <- getGlobalRdrEnv
               ; let mb_gre = do fl <- (FieldLabel -> Bool) -> [FieldLabel] -> Maybe FieldLabel
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((FieldLabelString -> FieldLabelString -> Bool
forall a. Eq a => a -> a -> Bool
== FieldLabelString
lbl) (FieldLabelString -> Bool)
-> (FieldLabel -> FieldLabelString) -> FieldLabel -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> FieldLabelString
flLabel) [FieldLabel]
flds
                                 -- We have the label, now check it is in scope.  If
                                 -- there is a qualifier, use pickGREs to check that
                                 -- the qualifier is correct, and return the filtered
                                 -- GRE so we get import usage right (see #17853).
                                 gre <- lookupGRE_FieldLabel env fl
                                 if isQual rdr_name
                                 then listToMaybe $ pickGREs rdr_name [gre]
                                 else return gre
               ; traceRn "lookupRecFieldOcc" $
                   vcat [ text "mb_con:" <+> ppr mb_con
                        , text "rdr_name:" <+> ppr rdr_name
                        , text "flds:" <+> ppr flds
                        , text "mb_gre:" <+> ppr mb_gre ]
               ; mapM_ (addUsedGRE AllDeprecationWarnings) mb_gre
               ; return $ flSelector . fieldGRELabel <$> mb_gre }
       ; case mb_nm of
          { Maybe Name
Nothing  -> do { TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (Name -> FieldLabelString -> TcRnMessage
badFieldConErr Name
con FieldLabelString
lbl)
                           ; Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RnM Name) -> Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ Name -> Name
mk_unbound_rec_fld Name
con }
          ; Just Name
nm -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
nm } }

  | Bool
otherwise  -- Can't use the data constructor to disambiguate
  = WhichGREs GREInfo -> RdrName -> RnM Name
lookupGlobalOccRn' (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantField) RdrName
rdr_name
    -- This use of Global is right as we are looking up a selector,
    -- which can only be defined at the top level.

  where
    -- When lookup fails, make an unbound name with the right record field
    -- namespace, as that's what we expect to be returned
    -- from 'lookupRecFieldOcc'. See T14307.
    mk_unbound_rec_fld :: Name -> Name
mk_unbound_rec_fld Name
con = OccName -> Name
mkUnboundName (OccName -> Name) -> OccName -> Name
forall a b. (a -> b) -> a -> b
$
      FastString -> FastString -> OccName
mkRecFieldOccFS (Name -> FastString
forall a. NamedThing a => a -> FastString
getOccFS Name
con) (OccName -> FastString
occNameFS OccName
occ)
    occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
rdr_name

    ensure_recfld :: GlobalRdrElt -> Maybe Name
    ensure_recfld :: GlobalRdrElt -> Maybe Name
ensure_recfld GlobalRdrElt
gre = do { Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isRecFldGRE GlobalRdrElt
gre)
                           ; Name -> Maybe Name
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre }

{- 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 [DisambiguateRecordFields for updates]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When we are looking up record fields in record update, we can take advantage of
the fact that we know we are looking for a field, even though we do not know the
data constructor name (as in Note [DisambiguateRecordFields]), provided the
-XDisambiguateRecordFields flag is on.

For example, consider:

  module N where
    f = ()

  {-# LANGUAGE DisambiguateRecordFields #-}
  module M where
    import N (f)
    data T = MkT { f :: Int }
    t = MkT { f = 1 }  -- unambiguous because MkT determines which field we mean
    u = t { f = 2 }    -- unambiguous because we ignore the non-field 'f'

We filter out non-fields in lookupFieldGREs by using isRecFldGRE, which allows
us to accept the above program.
Of course, if a record update has two fields in scope with the same name,
it is still ambiguous.

We also look up the non-fields with the same textual name

  1. to throw an error if the user hasn't enabled DisambiguateRecordFields,
  2. in order to improve the error message when a user mistakenly tries to use
     a non-field in a record update:

        f = ()
        e x = x { f = () }

Unlike with constructors or pattern-matching, we do not allow the module
qualifier to be omitted from the field names, because we do not have a
data constructor to use to determine the appropriate qualifier.

This is all done in the function lookupFieldGREs, which is called by
GHC.Rename.Pat.rnHsRecUpdFields, which deals with record updates.

Note [Record field names and Template Haskell]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider (#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.
lookupSubBndrOcc_helper :: Bool -> DeprecationWarnings
                        -> Name
                        -> RdrName -- ^ thing we are looking up
                        -> LookupChild -- ^ how to look it up (e.g. which
                                       -- 'NameSpace's to look in)
                        -> RnM ChildLookupResult
lookupSubBndrOcc_helper :: Bool
-> DeprecationWarnings
-> Name
-> RdrName
-> LookupChild
-> RnM ChildLookupResult
lookupSubBndrOcc_helper Bool
must_have_parent DeprecationWarnings
warn_if_deprec Name
parent RdrName
rdr_name LookupChild
how_lkup
  | Name -> Bool
isUnboundName Name
parent
    -- Avoid an error cascade
  = ChildLookupResult -> RnM ChildLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> ChildLookupResult
FoundChild (RdrName -> GlobalRdrElt
mkUnboundGRERdr RdrName
rdr_name))

  | Bool
otherwise = do
  gre_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
  let original_gres = GlobalRdrEnv -> LookupGRE GREInfo -> [GlobalRdrElt]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnv
gre_env (OccName -> LookupChild -> LookupGRE GREInfo
forall info. OccName -> LookupChild -> LookupGRE info
LookupChildren (RdrName -> OccName
rdrNameOcc RdrName
rdr_name) LookupChild
how_lkup)
      picked_gres = [GlobalRdrElt] -> DisambigInfo
pick_gres [GlobalRdrElt]
original_gres
  -- The remaining GREs are things that we *could* export here.
  -- Note that this includes things which have `NoParent`;
  -- those are sorted in `checkPatSynParent`.
  traceRn "parent" (ppr parent)
  traceRn "lookupExportChild original_gres:" (ppr original_gres)
  traceRn "lookupExportChild picked_gres:" (ppr picked_gres $$ ppr must_have_parent)
  case picked_gres of
    DisambigInfo
NoOccurrence ->
      [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr [GlobalRdrElt]
original_gres
    UniqueOccurrence GlobalRdrElt
g ->
      if Bool
must_have_parent
      then [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr [GlobalRdrElt]
original_gres
      else GlobalRdrElt -> RnM ChildLookupResult
checkFld GlobalRdrElt
g
    DisambiguatedOccurrence GlobalRdrElt
g ->
      GlobalRdrElt -> RnM ChildLookupResult
checkFld GlobalRdrElt
g
    AmbiguousOccurrence NonEmpty GlobalRdrElt
gres ->
      NonEmpty GlobalRdrElt -> RnM ChildLookupResult
mkNameClashErr NonEmpty GlobalRdrElt
gres
    where
        checkFld :: GlobalRdrElt -> RnM ChildLookupResult
        checkFld :: GlobalRdrElt -> RnM ChildLookupResult
checkFld GlobalRdrElt
g = do
          DeprecationWarnings
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGRE DeprecationWarnings
warn_if_deprec GlobalRdrElt
g
          ChildLookupResult -> RnM ChildLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChildLookupResult -> RnM ChildLookupResult)
-> ChildLookupResult -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> ChildLookupResult
FoundChild GlobalRdrElt
g

        -- Called when we find no matching GREs after disambiguation but
        -- there are three situations where this happens.
        -- 1. There were none to begin with.
        -- 2. None of the matching ones were the parent but
        --  a. They were from an overloaded record field so we can report
        --     a better error
        --  b. The original lookup was actually ambiguous.
        --     For example, the case where overloading is off and two
        --     record fields are in scope from different record
        --     constructors, neither of which is the parent.
        noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
        noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr [GlobalRdrElt]
original_gres = do
          String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"npe" ([GlobalRdrElt] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
original_gres)
          dup_fields_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DuplicateRecordFields
          case original_gres of
            []  -> ChildLookupResult -> RnM ChildLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ChildLookupResult
NameNotFound
            [GlobalRdrElt
g] -> ChildLookupResult -> RnM ChildLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChildLookupResult -> RnM ChildLookupResult)
-> ChildLookupResult -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$ Name -> GlobalRdrElt -> [Name] -> ChildLookupResult
IncorrectParent Name
parent GlobalRdrElt
g
                              [Name
p | ParentIs Name
p <- [GlobalRdrElt -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrElt
g]]
            gss :: [GlobalRdrElt]
gss@(GlobalRdrElt
g:gss' :: [GlobalRdrElt]
gss'@(GlobalRdrElt
_:[GlobalRdrElt]
_)) ->
              if (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isRecFldGRE [GlobalRdrElt]
gss Bool -> Bool -> Bool
&& Bool
dup_fields_ok
              then ChildLookupResult -> RnM ChildLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChildLookupResult -> RnM ChildLookupResult)
-> ChildLookupResult -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$
                    Name -> GlobalRdrElt -> [Name] -> ChildLookupResult
IncorrectParent Name
parent GlobalRdrElt
g
                      [Name
p | GlobalRdrElt
x <- [GlobalRdrElt]
gss, ParentIs Name
p <- [GlobalRdrElt -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrElt
x]]
              else NonEmpty GlobalRdrElt -> RnM ChildLookupResult
mkNameClashErr (NonEmpty GlobalRdrElt -> RnM ChildLookupResult)
-> NonEmpty GlobalRdrElt -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt
g GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
forall a. a -> [a] -> NonEmpty a
NE.:| [GlobalRdrElt]
gss'

        mkNameClashErr :: NE.NonEmpty GlobalRdrElt -> RnM ChildLookupResult
        mkNameClashErr :: NonEmpty GlobalRdrElt -> RnM ChildLookupResult
mkNameClashErr NonEmpty GlobalRdrElt
gres = do
          RdrName
-> NonEmpty GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name NonEmpty GlobalRdrElt
gres
          ChildLookupResult -> RnM ChildLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> ChildLookupResult
FoundChild (NonEmpty GlobalRdrElt -> GlobalRdrElt
forall a. NonEmpty a -> a
NE.head NonEmpty GlobalRdrElt
gres))

        pick_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
        pick_gres :: [GlobalRdrElt] -> DisambigInfo
pick_gres [GlobalRdrElt]
gres
          | RdrName -> Bool
isUnqual RdrName
rdr_name
          = [DisambigInfo] -> DisambigInfo
forall a. Monoid a => [a] -> a
mconcat ((GlobalRdrElt -> DisambigInfo) -> [GlobalRdrElt] -> [DisambigInfo]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> DisambigInfo
right_parent [GlobalRdrElt]
gres)
          | Bool
otherwise
          = [DisambigInfo] -> DisambigInfo
forall a. Monoid a => [a] -> a
mconcat ((GlobalRdrElt -> DisambigInfo) -> [GlobalRdrElt] -> [DisambigInfo]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> DisambigInfo
right_parent (RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
forall info.
RdrName -> [GlobalRdrEltX info] -> [GlobalRdrEltX info]
pickGREs RdrName
rdr_name [GlobalRdrElt]
gres))

        right_parent :: GlobalRdrElt -> DisambigInfo
        right_parent :: GlobalRdrElt -> DisambigInfo
right_parent GlobalRdrElt
gre
          = case GlobalRdrElt -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrElt
gre of
              ParentIs Name
cur_parent
                 | Name
parent Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
cur_parent -> GlobalRdrElt -> DisambigInfo
DisambiguatedOccurrence GlobalRdrElt
gre
                 | Bool
otherwise            -> DisambigInfo
NoOccurrence
              Parent
NoParent                  -> GlobalRdrElt -> DisambigInfo
UniqueOccurrence GlobalRdrElt
gre
{-# INLINEABLE lookupSubBndrOcc_helper #-}

-- | This domain specific datatype is used to record why we decided it was
-- possible that a GRE could be exported with a parent.
data DisambigInfo
       = NoOccurrence
          -- ^ The GRE could not be found, or it has the wrong parent.
       | UniqueOccurrence GlobalRdrElt
          -- ^ The GRE has no parent. It could be a pattern synonym.
       | DisambiguatedOccurrence GlobalRdrElt
          -- ^ The parent of the GRE is the correct parent.
       | AmbiguousOccurrence (NE.NonEmpty GlobalRdrElt)
          -- ^ The GRE is ambiguous.
          --
          -- For example, two normal identifiers with the same name are in
          -- scope. They will both be resolved to "UniqueOccurrence" and the
          -- monoid will combine them to this failing case.

instance Outputable DisambigInfo where
  ppr :: DisambigInfo -> SDoc
ppr DisambigInfo
NoOccurrence = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NoOccurrence"
  ppr (UniqueOccurrence GlobalRdrElt
gre) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"UniqueOccurrence:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
gre
  ppr (DisambiguatedOccurrence GlobalRdrElt
gre) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"DiambiguatedOccurrence:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
gre
  ppr (AmbiguousOccurrence NonEmpty GlobalRdrElt
gres)    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ambiguous:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NonEmpty GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr NonEmpty GlobalRdrElt
gres

instance Semi.Semigroup DisambigInfo where
  -- These are the key lines: we prefer disambiguated occurrences to other
  -- names.
  DisambigInfo
_ <> :: DisambigInfo -> DisambigInfo -> DisambigInfo
<> DisambiguatedOccurrence GlobalRdrElt
g' = GlobalRdrElt -> DisambigInfo
DisambiguatedOccurrence GlobalRdrElt
g'
  DisambiguatedOccurrence GlobalRdrElt
g' <> DisambigInfo
_ = GlobalRdrElt -> DisambigInfo
DisambiguatedOccurrence GlobalRdrElt
g'

  DisambigInfo
NoOccurrence <> DisambigInfo
m = DisambigInfo
m
  DisambigInfo
m <> DisambigInfo
NoOccurrence = DisambigInfo
m
  UniqueOccurrence GlobalRdrElt
g <> UniqueOccurrence GlobalRdrElt
g'
    = NonEmpty GlobalRdrElt -> DisambigInfo
AmbiguousOccurrence (NonEmpty GlobalRdrElt -> DisambigInfo)
-> NonEmpty GlobalRdrElt -> DisambigInfo
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt
g GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
forall a. a -> [a] -> NonEmpty a
NE.:| [GlobalRdrElt
g']
  UniqueOccurrence GlobalRdrElt
g <> AmbiguousOccurrence NonEmpty GlobalRdrElt
gs
    = NonEmpty GlobalRdrElt -> DisambigInfo
AmbiguousOccurrence (GlobalRdrElt
g GlobalRdrElt -> NonEmpty GlobalRdrElt -> NonEmpty GlobalRdrElt
forall a. a -> NonEmpty a -> NonEmpty a
`NE.cons` NonEmpty GlobalRdrElt
gs)
  AmbiguousOccurrence NonEmpty GlobalRdrElt
gs <> UniqueOccurrence GlobalRdrElt
g'
    = NonEmpty GlobalRdrElt -> DisambigInfo
AmbiguousOccurrence (GlobalRdrElt
g' GlobalRdrElt -> NonEmpty GlobalRdrElt -> NonEmpty GlobalRdrElt
forall a. a -> NonEmpty a -> NonEmpty a
`NE.cons` NonEmpty GlobalRdrElt
gs)
  AmbiguousOccurrence NonEmpty GlobalRdrElt
gs <> AmbiguousOccurrence NonEmpty GlobalRdrElt
gs'
    = NonEmpty GlobalRdrElt -> DisambigInfo
AmbiguousOccurrence (NonEmpty GlobalRdrElt
gs NonEmpty GlobalRdrElt
-> NonEmpty GlobalRdrElt -> NonEmpty GlobalRdrElt
forall a. Semigroup a => a -> a -> a
Semi.<> NonEmpty GlobalRdrElt
gs')

instance Monoid DisambigInfo where
  mempty :: DisambigInfo
mempty = DisambigInfo
NoOccurrence
  mappend :: DisambigInfo -> DisambigInfo -> DisambigInfo
mappend = DisambigInfo -> DisambigInfo -> DisambigInfo
forall a. Semigroup a => a -> a -> a
(Semi.<>)

-- Lookup SubBndrOcc can never be ambiguous
--
-- Records the result of looking up a child.
data ChildLookupResult
      -- | We couldn't find a suitable name
      = NameNotFound
      -- | The child has an incorrect parent
      | IncorrectParent Name          -- ^ parent
                        GlobalRdrElt  -- ^ child we were looking for
                        [Name]        -- ^ list of possible parents
      -- | We resolved to a child
      | FoundChild GlobalRdrElt

instance Outputable ChildLookupResult where
  ppr :: ChildLookupResult -> SDoc
ppr ChildLookupResult
NameNotFound = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NameNotFound"
  ppr (FoundChild GlobalRdrElt
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Found:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Parent -> SDoc
forall a. Outputable a => a -> SDoc
ppr (GlobalRdrElt -> Parent
forall info. GlobalRdrEltX info -> Parent
greParent GlobalRdrElt
n) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
n
  ppr (IncorrectParent Name
p GlobalRdrElt
g [Name]
ns)
    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"IncorrectParent"
      SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
p, Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
g, [Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
ns]

lookupSubBndrOcc :: DeprecationWarnings
                 -> Name     -- Parent
                 -> SDoc
                 -> RdrName
                 -> RnM (Either NotInScopeError Name)
-- ^ Find all the things the 'RdrName' maps to,
-- and pick the one with the right 'Parent' 'Name'.
lookupSubBndrOcc :: DeprecationWarnings
-> Name -> SDoc -> RdrName -> RnM (Either NotInScopeError Name)
lookupSubBndrOcc DeprecationWarnings
warn_if_deprec Name
the_parent SDoc
doc RdrName
rdr_name =
  RdrName
-> (GlobalRdrElt -> Either NotInScopeError Name)
-> RnM (Either NotInScopeError Name)
-> RnM (Either NotInScopeError Name)
forall r. RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name (Name -> Either NotInScopeError Name
forall a b. b -> Either a b
Right (Name -> Either NotInScopeError Name)
-> (GlobalRdrElt -> Name)
-> GlobalRdrElt
-> Either NotInScopeError Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName) (RnM (Either NotInScopeError Name)
 -> RnM (Either NotInScopeError Name))
-> RnM (Either NotInScopeError Name)
-> RnM (Either NotInScopeError Name)
forall a b. (a -> b) -> a -> b
$
    -- This happens for built-in classes, see mod052 for example
    do { child <- Bool
-> DeprecationWarnings
-> Name
-> RdrName
-> LookupChild
-> RnM ChildLookupResult
lookupSubBndrOcc_helper Bool
True DeprecationWarnings
warn_if_deprec Name
the_parent RdrName
rdr_name LookupChild
what_lkup
       ; return $ case child of
           FoundChild GlobalRdrElt
g       -> Name -> Either NotInScopeError Name
forall a b. b -> Either a b
Right (GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
g)
           ChildLookupResult
NameNotFound       -> NotInScopeError -> Either NotInScopeError Name
forall a b. a -> Either a b
Left (SDoc -> NotInScopeError
UnknownSubordinate SDoc
doc)
           IncorrectParent {} -> NotInScopeError -> Either NotInScopeError Name
forall a b. a -> Either a b
Left (SDoc -> NotInScopeError
UnknownSubordinate SDoc
doc) }
       -- See [Mismatched class methods and associated type families]
       -- in TcInstDecls.
  where
    what_lkup :: LookupChild
what_lkup = LookupChild { wantedParent :: Name
wantedParent        = Name
the_parent
                            , lookupDataConFirst :: Bool
lookupDataConFirst  = Bool
False
                            , prioritiseParent :: Bool
prioritiseParent    = Bool
True -- See T23664.
                            }
{-
Note [Family instance binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
  data family F a
  data instance F T = X1 | X2

The 'data instance' decl has an *occurrence* of F (and T), and *binds*
X1 and X2.  (This is unlike a normal data type declaration which would
bind F too.)  So we want an AvailTC F [X1,X2].

Now consider a similar pair:
  class C a where
    data G a
  instance C S where
    data G S = Y1 | Y2

The 'data G S' *binds* Y1 and Y2, and has an *occurrence* of G.

But there is a small complication: in an instance decl, we don't use
qualified names on the LHS; instead we use the class to disambiguate.
Thus:
  module M where
    import Blib( G )
    class C a where
      data G a
    instance C S where
      data G S = Y1 | Y2
Even though there are two G's in scope (M.G and Blib.G), the occurrence
of 'G' in the 'instance C S' decl is unambiguous, because C has only
one associated type called G. This is exactly what happens for methods,
and it is only consistent to do the same thing for types. That's the
role of the function lookupTcdName; the (Maybe Name) give the class of
the enclosing instance decl, if any.

Note [Looking up Exact RdrNames]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exact RdrNames are generated by:

* Template Haskell (See Note [Binders in Template Haskell] in GHC.ThToHs)
* Derived instances (See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate)

For data types and classes have Exact system Names in the binding
positions for constructors, TyCons etc.  For example
    [d| data T = MkT Int |]
when we splice in and convert to HsSyn RdrName, we'll get
    data (Exact (system Name "T")) = (Exact (system Name "MkT")) ...
These System names are generated by GHC.ThToHs.thRdrName

But, constructors and the like need External Names, not System Names!
So we do the following

 * In GHC.Rename.Env.newTopSrcBinder we spot Exact RdrNames that wrap a
   non-External Name, and make an External name for it. This is
   the name that goes in the GlobalRdrEnv

 * When looking up an occurrence of an Exact name, done in
   GHC.Rename.Env.lookupExactOcc, we find the Name with the right unique in the
   GlobalRdrEnv, and use the one from the envt -- it will be an
   External Name in the case of the data type/constructor above.

 * Exact names are also use for purely local binders generated
   by TH, such as    \x_33. x_33
   Both binder and occurrence are Exact RdrNames.  The occurrence
   gets looked up in the LocalRdrEnv by GHC.Rename.Env.lookupOccRn, and
   misses, because lookupLocalRdrEnv always returns Nothing for
   an Exact Name.  Now we fall through to lookupExactOcc, which
   will find the Name is not in the GlobalRdrEnv, so we just use
   the Exact supplied Name.

Note [Splicing Exact names]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider the splice $(do { x <- newName "x"; return (VarE x) })
This will generate a (HsExpr RdrName) term that mentions the
Exact RdrName "x_56" (or whatever), but does not bind it.  So
when looking such Exact names we want to check that it's in scope,
otherwise the type checker will get confused.  To do this we need to
keep track of all the Names in scope, and the LocalRdrEnv does just that;
we consult it with RdrName.inLocalRdrEnvScope.

There is another wrinkle.  With TH and -XDataKinds, consider
   $( [d| data Nat = Zero
          data T = MkT (Proxy 'Zero)  |] )
After splicing, but before renaming we get this:
   data Nat_77{tc} = Zero_78{d}
   data T_79{tc} = MkT_80{d} (Proxy 'Zero_78{tc})  |] )
The occurrence of 'Zero in the data type for T has the right unique,
but it has a TcClsName name-space in its OccName.  (This is set by
the ctxt_ns argument of Convert.thRdrName.)  When we check that is
in scope in the GlobalRdrEnv, we need to look up the DataName namespace
too.  (An alternative would be to make the GlobalRdrEnv also have
a Name -> GRE mapping.)

Note [Template Haskell ambiguity]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The GlobalRdrEnv invariant says that if
  occ -> [gre1, ..., gren]
then the gres have distinct Names (INVARIANT 1 of GlobalRdrEnv).
This is guaranteed by extendGlobalRdrEnvRn (the dups check in add_gre).

So how can we get multiple gres in lookupExactOcc_maybe?  Because in
TH we might use the same TH NameU in two different name spaces.
eg (#7241):
   $(newName "Foo" >>= \o -> return [DataD [] o [] [RecC o []] [''Show]])
Here we generate a type constructor and data constructor with the same
unique, but different name spaces.

It'd be nicer to rule this out in extendGlobalRdrEnvRn, but that would
mean looking up the OccName in every name-space, just in case, and that
seems a bit brutal.  So it's just done here on lookup.  But we might
need to revisit that choice.

Note [Usage for sub-bndrs]
~~~~~~~~~~~~~~~~~~~~~~~~~~
If you have this
   import qualified M( C( f ) )
   instance M.C T where
     f x = x
then is the qualified import M.f used?  Obviously yes.
But the RdrName used in the instance decl is unqualified.  In effect,
we fill in the qualification by looking for f's whose class is M.C
But when adding to the UsedRdrNames we must make that qualification
explicit (saying "used  M.f"), otherwise we get "Redundant import of M.f".

So we make up a suitable (fake) RdrName.  But be careful
   import qualified M
   import M( C(f) )
   instance C T where
     f x = x
Here we want to record a use of 'f', not of 'M.f', otherwise
we'll miss the fact that the qualified import is redundant.

--------------------------------------------------
--              Occurrences
--------------------------------------------------
-}


lookupLocatedOccRn :: GenLocated (EpAnn ann) RdrName
                   -> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRn :: forall ann.
GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRn = (RdrName -> RnM Name)
-> GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
wrapLocMA RdrName -> RnM Name
lookupOccRn

lookupLocatedOccRnConstr :: GenLocated (EpAnn ann) RdrName
                         -> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnConstr :: forall ann.
GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnConstr = (RdrName -> RnM Name)
-> GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
wrapLocMA RdrName -> RnM Name
lookupOccRnConstr

lookupLocatedOccRnRecField :: GenLocated (EpAnn ann) RdrName
                           -> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnRecField :: forall ann.
GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnRecField = (RdrName -> RnM Name)
-> GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
wrapLocMA RdrName -> RnM Name
lookupOccRnRecField

lookupLocatedOccRnNone :: GenLocated (EpAnn ann) RdrName
                       -> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnNone :: forall ann.
GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
lookupLocatedOccRnNone = (RdrName -> RnM Name)
-> GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
wrapLocMA RdrName -> RnM Name
lookupOccRnNone

lookupLocalOccRn_maybe :: RdrName -> RnM (Maybe Name)
-- Just look in the local environment
lookupLocalOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
  = do { local_env <- RnM LocalRdrEnv
getLocalRdrEnv
       ; return (lookupLocalRdrEnv local_env rdr_name) }

lookupLocalOccThLvl_maybe :: Name -> RnM (Maybe (TopLevelFlag, ThLevel))
-- Just look in the local environment
lookupLocalOccThLvl_maybe :: Name -> RnM (Maybe (TopLevelFlag, Arity))
lookupLocalOccThLvl_maybe Name
name
  = do { lcl_env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
       ; return (lookupNameEnv (getLclEnvThBndrs lcl_env) name) }

-- lookupOccRn' looks up an occurrence of a RdrName, and uses its argument to
-- determine what kind of suggestions should be displayed if it is not in scope
lookupOccRn' :: WhatLooking -> RdrName -> RnM Name
lookupOccRn' :: WhatLooking -> RdrName -> RnM Name
lookupOccRn' WhatLooking
which_suggest RdrName
rdr_name
  = do { mb_gre <- RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe RdrName
rdr_name
       ; case mb_gre of
           Just GlobalRdrElt
gre  -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RnM Name) -> Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
           Maybe GlobalRdrElt
Nothing   -> WhatLooking -> RdrName -> RnM Name
reportUnboundName' WhatLooking
which_suggest RdrName
rdr_name }

-- lookupOccRn looks up an occurrence of a RdrName and displays suggestions if
-- it is not in scope
lookupOccRn :: RdrName -> RnM Name
lookupOccRn :: RdrName -> RnM Name
lookupOccRn = WhatLooking -> RdrName -> RnM Name
lookupOccRn' WhatLooking
WL_Anything

-- | Look up an occurrence of a 'RdrName'.
--
-- Displays constructors and pattern synonyms as suggestions if
-- it is not in scope.
--
-- See Note [lookupOccRnConstr]
lookupOccRnConstr :: RdrName -> RnM Name
lookupOccRnConstr :: RdrName -> RnM Name
lookupOccRnConstr RdrName
rdr_name
  = do { mb_gre <- RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe RdrName
rdr_name
       ; case mb_gre of
           Just GlobalRdrElt
gre  -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RnM Name) -> Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
           Maybe GlobalRdrElt
Nothing   -> do
            { mb_ty_gre <- RdrName -> RnM (Maybe GlobalRdrElt)
lookup_promoted RdrName
rdr_name
            ; case mb_ty_gre of
              Just GlobalRdrElt
gre -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RnM Name) -> Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
              Maybe GlobalRdrElt
Nothing ->  WhatLooking -> RdrName -> RnM Name
reportUnboundName' WhatLooking
WL_Constructor RdrName
rdr_name} }

{- Note [lookupOccRnConstr]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
lookupOccRnConstr looks up a data constructor or pattern synonym. Simple.

However, there is a fallback to the type level when the lookup fails.
This is required to implement a pat-to-type transformation
(See Note [Pattern to type (P2T) conversion] in GHC.Tc.Gen.Pat)

Consider this example:

  data VisProxy a where VP :: forall a -> VisProxy a

  f :: VisProxy Int -> ()
  f (VP Int) = ()

Here `Int` is actually a type, but it occurs in a position in which we expect
a data constructor.

In all other cases we just use this additional lookup for better
error messaging (See Note [Promotion]).
-}

-- lookupOccRnRecField looks up an occurrence of a RdrName and displays
-- record fields as suggestions if it is not in scope
lookupOccRnRecField :: RdrName -> RnM Name
lookupOccRnRecField :: RdrName -> RnM Name
lookupOccRnRecField = WhatLooking -> RdrName -> RnM Name
lookupOccRn' WhatLooking
WL_RecField

-- lookupOccRnRecField looks up an occurrence of a RdrName and displays
-- no suggestions if it is not in scope
lookupOccRnNone :: RdrName -> RnM Name
lookupOccRnNone :: RdrName -> RnM Name
lookupOccRnNone = WhatLooking -> RdrName -> RnM Name
lookupOccRn' WhatLooking
WL_None

-- Only used in one place, to rename pattern synonym binders.
-- See Note [Renaming pattern synonym variables] in GHC.Rename.Bind
lookupLocalOccRn :: RdrName -> RnM Name
lookupLocalOccRn :: RdrName -> RnM Name
lookupLocalOccRn RdrName
rdr_name
  = do { mb_name <- RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
       ; case mb_name of
           Just Name
name -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name
           Maybe Name
Nothing   -> LookingFor -> RdrName -> RnM Name
unboundName (WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
WL_Anything WhereLooking
WL_LocalOnly) RdrName
rdr_name }

-- lookupTypeOccRn looks up an optionally promoted RdrName.
-- Used for looking up type variables.
lookupTypeOccRn :: RdrName -> RnM Name
-- see Note [Demotion]
lookupTypeOccRn :: RdrName -> RnM Name
lookupTypeOccRn RdrName
rdr_name
  = do { mb_gre <- RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe RdrName
rdr_name
       ; case mb_gre of
             Just GlobalRdrElt
gre -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RnM Name) -> Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre
             Maybe GlobalRdrElt
Nothing   ->
               if RdrName -> OccName
forall name. HasOccName name => name -> OccName
occName RdrName
rdr_name OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName -> OccName
forall name. HasOccName name => name -> OccName
occName RdrName
eqTyCon_RDR -- See Note [eqTyCon (~) compatibility fallback]
               then Name
eqTyConName Name -> IOEnv (Env TcGblEnv TcLclEnv) () -> RnM Name
forall a b.
a
-> IOEnv (Env TcGblEnv TcLclEnv) b
-> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addDiagnostic TcRnMessage
TcRnTypeEqualityOutOfScope
               else RdrName -> RnM Name
lookup_demoted RdrName
rdr_name }

{- Note [eqTyCon (~) compatibility fallback]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Before GHC Proposal #371, the (~) type operator used in type equality
constraints (a~b) was considered built-in syntax.

This had two implications:

1. Users could use it without importing it from Data.Type.Equality or Prelude.
2. TypeOperators were not required to use it (it was guarded behind TypeFamilies/GADTs instead)

To ease migration and minimize breakage, we continue to support those usages
but emit appropriate warnings.
-}

-- Used when looking up a term name (varName or dataName) in a type
lookup_demoted :: RdrName -> RnM Name
lookup_demoted :: RdrName -> RnM Name
lookup_demoted RdrName
rdr_name
  | Just RdrName
demoted_rdr <- RdrName -> Maybe RdrName
demoteRdrName RdrName
rdr_name
    -- Maybe it's the name of a *data* constructor
  = do { data_kinds <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DataKinds
       ; star_is_type <- xoptM LangExt.StarIsType
       ; let is_star_type = if Bool
star_is_type then StarIsType
StarIsType else StarIsType
StarIsNotType
             star_is_type_hints = StarIsType -> RdrName -> [GhcHint]
noStarIsTypeHints StarIsType
is_star_type RdrName
rdr_name
       ; if data_kinds
            then do { mb_demoted_gre <- lookupOccRn_maybe demoted_rdr
                    ; case mb_demoted_gre of
                        Maybe GlobalRdrElt
Nothing -> LookingFor -> RdrName -> [GhcHint] -> RnM Name
unboundNameX LookingFor
looking_for RdrName
rdr_name [GhcHint]
star_is_type_hints
                        Just GlobalRdrElt
demoted_gre -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RnM Name) -> Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
demoted_gre}
            else do { -- We need to check if a data constructor of this name is
                      -- in scope to give good error messages. However, we do
                      -- not want to give an additional error if the data
                      -- constructor happens to be out of scope! See #13947.
                      mb_demoted_name <- discardErrs $
                                         lookupOccRn_maybe demoted_rdr
                    ; let suggestion | Maybe GlobalRdrElt -> Bool
forall a. Maybe a -> Bool
isJust Maybe GlobalRdrElt
mb_demoted_name
                                     , let additional :: SDoc
additional = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to refer to the data constructor of that name?"
                                     = [LanguageExtensionHint -> GhcHint
SuggestExtension (LanguageExtensionHint -> GhcHint)
-> LanguageExtensionHint -> GhcHint
forall a b. (a -> b) -> a -> b
$ SDoc -> Extension -> LanguageExtensionHint
SuggestSingleExtension SDoc
additional Extension
LangExt.DataKinds]
                                     | Bool
otherwise
                                     = [GhcHint]
star_is_type_hints
                    ; unboundNameX looking_for rdr_name suggestion } }

  | RdrName -> Bool
isQual RdrName
rdr_name,
    Just RdrName
demoted_rdr_name <- RdrName -> Maybe RdrName
demoteRdrNameTv RdrName
rdr_name
    -- Definitely an illegal term variable, as type variables are never exported.
    -- See Note [Demotion of unqualified variables] (W2)
  = RdrName -> RdrName -> RnM Name
report_qualified_term_in_types RdrName
rdr_name RdrName
demoted_rdr_name

  | RdrName -> Bool
isUnqual RdrName
rdr_name,
    Just RdrName
demoted_rdr_name <- RdrName -> Maybe RdrName
demoteRdrNameTv RdrName
rdr_name
    -- See Note [Demotion of unqualified variables]
  = do { required_type_arguments <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RequiredTypeArguments
       ; if required_type_arguments
         then do { mb_demoted_gre <- lookupOccRn_maybe demoted_rdr_name
                 ; case mb_demoted_gre of
                     Maybe GlobalRdrElt
Nothing -> LookingFor -> RdrName -> RnM Name
unboundName (WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
WL_Anything WhereLooking
WL_Anywhere) RdrName
rdr_name
                     Just GlobalRdrElt
demoted_gre -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RnM Name) -> Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
demoted_gre }
         else unboundName looking_for rdr_name }

  | Bool
otherwise
  = LookingFor -> RdrName -> RnM Name
unboundName LookingFor
looking_for RdrName
rdr_name

  where
    looking_for :: LookingFor
looking_for = WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
WL_Constructor WhereLooking
WL_Anywhere

{- Note [Demotion of unqualified variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Under RequiredTypeArguments, a term-level variable name (i.e. a name whose
`occNameSpace` is `varName` as opposed to `tvName`) does not necessarily denote
a term variable. It can actually stand for a type:

  {-# LANGUAGE RequiredTypeArguments #-}
  idv :: forall a -> a -> a     -- Note the "forall a ->" in the type
  idv  t  (x :: t) = id @t x    -- #23739
  --   ^        ^        ^
  --  varName  tvName  tvName   -- NameSpace (GHC.Types.Name.Occurrence)

The variable `t` is an alias for the type variable `a`, so it's valid to use it
in type-level contexts. The only problem is that the namespaces do not match.
Demotion allows us to connect the `tvName` usages to the `varName` binding.

Demotion of an RdrName means that we change its namespace from tvName/tcClsName
to varName/dataName. Suppose we are looking up an occurrence of a variable `a`
in a type (in `lookupTypeOccRn`). The parser gave `a` a `tvName` occurrence,
so we try looking that up first.  If that fails, and RequiredTypeArguments is
on, then "demote" it to the `varName` namespace with `demoteRdrNameTv` and look
that up instead. If that succeeds, use it.

(W1) Wrinkle 1
  As a side effect of demotion, the renamer accepts all these examples:
    t = True         -- Ordinary term-level binding
    x = Proxy @t     -- (1) Bad usage in a HsExpr
    type T = t       -- (2) Bad usage in a TyClDecl
    f :: t -> t      -- (3) Bad usage in a SigDecl

  However, GHC doesn't promote arbitrary terms to types. See the "T2T-Mapping"
  section of GHC Proposal #281: "In the type checking environment, the variable
  must stand for a type variable". Even though the renamer accepts these
  constructs, the type checker has to reject the uses of `t` shown above.

  All three examples are rejected with the `TermVariablePE` promotion error.
  The error is generated by `tcTyVar` (GHC.Tc.Gen.HsType)
      tcTyVar :: Name -> TcM (TcType, TcKind)
  The first thing `tcTyVar` does is call the `tcLookup` helper (GHC.Tc.Utils.Env)
  to find the variable in the type checking environment
      tcLookup :: Name -> TcM TcTyThing
  What happens next depends on the example in question.

  * In the HsExpr example (1), `tcLookup` finds `ATcId` that corresponds to
    the `t = True` binding. The `ATcId` is then then turned into an error by
    the following clause in `tcTyVar`:
       ATcId{} -> promotionErr name TermVariablePE

  * In the TyClDecl example (2) and the SigDecl example (3), we don't have
    `ATcId` in the environment just yet because type declarations and signatures
    are type-checked /before/ term-level bindings.

    This means that `tcLookup` fails to find `t` in the local environment and
    calls `tcLookupGlobal` (GHC.Tc.Utils.Env)
        tcLookupGlobal :: Name -> TcM TyThing

    The global environment does not contain `t` either, so `tcLookupGlobal`
    calls `notFound` (GHC.Tc.Utils.Env)
        notFound :: Name -> TcM TyThing

    At this point GHC would normally generate a panic: if the variable is
    neither in the local nor in the global environment, then it shouldn't have
    passed the renamer. Unfortunately, this expectation is tiresome and
    expensive to maintain, so we add a special case in `notFound` instead.
    If the namespace of the variable is `varName`, the only explanation other
    than a bug in GHC is that the user tried to use a term variable in a type
    context. Hence the following clause in `notFound`:
      _ | isTermVarOrFieldNameSpace (nameNameSpace name) ->
          failWithTc $ TcRnUnpromotableThing name TermVariablePE

(W2) Wrinkle 2
   Only unqualified variable names are demoted, e.g. `f` but not `M.f`.
   The reason is that type variables are never bound to a qualified name:
   they can't be bound at the top level of a module, nor can they be
   exported or imported, so a qualified occurrence `M.f` must refer to a
   term-level definition and is never legal at the type level.
   Demotion of qualified names would not allow us to accept any new programs.
   We use this fact to generate better suggestions in error messages,
   see `report_qualified_term_in_types`.
-}

-- Report a qualified variable name in a type signature:
--   badSig :: Prelude.head
--             ^^^^^^^^^^^
report_qualified_term_in_types :: RdrName -> RdrName -> RnM Name
report_qualified_term_in_types :: RdrName -> RdrName -> RnM Name
report_qualified_term_in_types RdrName
rdr_name RdrName
demoted_rdr_name =
  do { mName <- WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_maybe (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal) RdrName
demoted_rdr_name
     ; case mName of
         (Just GlobalRdrElt
_) -> LookingFor -> RdrName -> RdrName -> [GhcHint] -> RnM Name
termNameInType LookingFor
looking_for RdrName
rdr_name RdrName
demoted_rdr_name []
         Maybe GlobalRdrElt
Nothing -> LookingFor -> RdrName -> RdrName -> RnM Name
unboundTermNameInTypes LookingFor
looking_for RdrName
rdr_name RdrName
demoted_rdr_name }
  where
    looking_for :: LookingFor
looking_for = WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
WL_Constructor WhereLooking
WL_Global

-- If the given RdrName can be promoted to the type level and its promoted variant is in scope,
-- lookup_promoted returns the corresponding type-level Name.
-- Otherwise, the function returns Nothing.
-- See Note [Promotion] below.
lookup_promoted :: RdrName -> RnM (Maybe GlobalRdrElt)
lookup_promoted :: RdrName -> RnM (Maybe GlobalRdrElt)
lookup_promoted RdrName
rdr_name
  | Just RdrName
promoted_rdr <- RdrName -> Maybe RdrName
promoteRdrName RdrName
rdr_name
  = RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe RdrName
promoted_rdr
  | Bool
otherwise
  = Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlobalRdrElt
forall a. Maybe a
Nothing

{- Note [Demotion]
~~~~~~~~~~~~~~~~~~
When the user writes:
  data Nat = Zero | Succ Nat
  foo :: f Zero -> Int

'Zero' in the type signature of 'foo' is parsed as:
  HsTyVar ("Zero", TcClsName)

When the renamer hits this occurrence of 'Zero' it's going to realise
that it's not in scope. But because it is renaming a type, it knows
that 'Zero' might be a promoted data constructor, so it will demote
its namespace to DataName and do a second lookup.

The final result (after the renamer) will be:
  HsTyVar ("Zero", DataName)

Another case of demotion happens when the user tries to
use a qualified term at the type level:

  f :: Prelude.id -> Int

This signature passes the parser to be caught by the renamer.
It allows the compiler to create more informative error messages.

'Prelude.id' in the type signature is parsed as
  HsTyVar ("id", TvName)

To separate the case of a typo from the case of an
intentional attempt to use an imported term's name the compiler demotes
the namespace to VarName (using 'demoteTvNameSpace') and does a lookup.

The same type of demotion happens when the compiler needs to check
if a name of a type variable has already been used for a term that is in scope.
We need to do it to check if a user should change the name
to make his code compatible with the RequiredTypeArguments extension.

Note [Promotion]
~~~~~~~~~~~~~~~
When the user mentions a type constructor or a type variable in a
term-level context, then we report that a value identifier was expected
instead of a type-level one. That makes error messages more precise.
Previously, such errors contained only the info that a given value was out of scope (#18740).
We promote the namespace of RdrName and look up after that
(see the functions promotedRdrName and lookup_promoted).

In particular, we have the following error message
  • Illegal term-level use of the type constructor ‘Int’
      imported from ‘Prelude’ (and originally defined in ‘GHC.Types’)
  • In the first argument of ‘id’, namely ‘Int’
    In the expression: id Int
    In an equation for ‘x’: x = id Int

when the user writes the following declaration

  x = id Int
-}

lookupOccRnX_maybe :: (RdrName -> RnM (Maybe r)) -> (GlobalRdrElt -> RnM r) -> RdrName
                   -> RnM (Maybe r)
lookupOccRnX_maybe :: forall r.
(RdrName -> RnM (Maybe r))
-> (GlobalRdrElt -> RnM r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe RdrName -> RnM (Maybe r)
globalLookup GlobalRdrElt -> RnM r
wrapper RdrName
rdr_name
  = MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r -> RnM (Maybe r)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r -> RnM (Maybe r))
-> ([RnM (Maybe r)] -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> [RnM (Maybe r)]
-> RnM (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r]
 -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> ([RnM (Maybe r)] -> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r])
-> [RnM (Maybe r)]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RnM (Maybe r) -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r)
-> [RnM (Maybe r)] -> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r]
forall a b. (a -> b) -> [a] -> [b]
map RnM (Maybe r) -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) r
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ([RnM (Maybe r)] -> RnM (Maybe r))
-> [RnM (Maybe r)] -> RnM (Maybe r)
forall a b. (a -> b) -> a -> b
$
      [ do { res <- RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
           ; case res of
           { Maybe Name
Nothing -> Maybe r -> RnM (Maybe r)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe r
forall a. Maybe a
Nothing
           ; Just Name
nm ->
           -- Elements in the LocalRdrEnv are always Vanilla GREs
        do { let gre :: GlobalRdrElt
gre = Parent -> Name -> GlobalRdrElt
mkLocalVanillaGRE Parent
NoParent Name
nm
           ; r -> Maybe r
forall a. a -> Maybe a
Just (r -> Maybe r) -> RnM r -> RnM (Maybe r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GlobalRdrElt -> RnM r
wrapper GlobalRdrElt
gre } } }
      , RdrName -> RnM (Maybe r)
globalLookup RdrName
rdr_name ]

lookupOccRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupOccRn_maybe =
  (RdrName -> RnM (Maybe GlobalRdrElt))
-> (GlobalRdrElt -> RnM GlobalRdrElt)
-> RdrName
-> RnM (Maybe GlobalRdrElt)
forall r.
(RdrName -> RnM (Maybe r))
-> (GlobalRdrElt -> RnM r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe
    (WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_maybe (WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt))
-> WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal)
    GlobalRdrElt -> RnM GlobalRdrElt
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- Used outside this module only by TH name reification (lookupName, lookupThName_maybe)
lookupSameOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupSameOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupSameOccRn_maybe =
  (RdrName -> RnM (Maybe Name))
-> (GlobalRdrElt -> RnM Name) -> RdrName -> RnM (Maybe Name)
forall r.
(RdrName -> RnM (Maybe r))
-> (GlobalRdrElt -> RnM r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe
    (RnM (Maybe GlobalRdrElt) -> RnM (Maybe Name)
get_name (RnM (Maybe GlobalRdrElt) -> RnM (Maybe Name))
-> (RdrName -> RnM (Maybe GlobalRdrElt))
-> RdrName
-> RnM (Maybe Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_maybe WhichGREs GREInfo
forall info. WhichGREs info
SameNameSpace)
    (Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> RnM Name)
-> (GlobalRdrElt -> Name) -> GlobalRdrElt -> RnM Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName)
  where
    get_name :: RnM (Maybe GlobalRdrElt) -> RnM (Maybe Name)
    get_name :: RnM (Maybe GlobalRdrElt) -> RnM (Maybe Name)
get_name = (Maybe GlobalRdrElt -> Maybe Name)
-> RnM (Maybe GlobalRdrElt) -> RnM (Maybe Name)
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GlobalRdrElt -> Name) -> Maybe GlobalRdrElt -> Maybe Name
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName)

-- | Look up a 'RdrName' used as a variable in an expression.
--
-- This may be a local variable, global variable, or one or more record selector
-- functions.  It will not return record fields created with the
-- @NoFieldSelectors@ extension (see Note [NoFieldSelectors]).
--
-- If the name is not in scope at the term level, but its promoted equivalent is
-- in scope at the type level, the lookup will succeed (so that the type-checker
-- can report a more informative error later).  See Note [Promotion].
--
lookupExprOccRn :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupExprOccRn :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupExprOccRn RdrName
rdr_name
  = do { mb_name <- (RdrName -> RnM (Maybe GlobalRdrElt))
-> (GlobalRdrElt -> RnM GlobalRdrElt)
-> RdrName
-> RnM (Maybe GlobalRdrElt)
forall r.
(RdrName -> RnM (Maybe r))
-> (GlobalRdrElt -> RnM r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe
                      RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_overloaded
                      GlobalRdrElt -> RnM GlobalRdrElt
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return
                      RdrName
rdr_name
       ; case mb_name of
           Maybe GlobalRdrElt
Nothing   -> RdrName -> RnM (Maybe GlobalRdrElt)
lookup_promoted RdrName
rdr_name
                        -- See Note [Promotion].
                        -- We try looking up the name as a
                        -- type constructor or type variable, if
                        -- we failed to look up the name at the term level.
           Maybe GlobalRdrElt
p         -> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlobalRdrElt
p }

lookupGlobalOccRn_maybe :: WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
-- Looks up a RdrName occurrence in the top-level
-- environment, including using lookupQualifiedNameGHCi
-- for the GHCi case, but first tries to find an Exact or Orig name.
-- No filter function; does not report an error on failure
-- See Note [Errors in lookup functions]
-- Uses addUsedRdrName to record use and deprecations
--
-- Used directly only by getLocalNonValBinders (new_assoc).
lookupGlobalOccRn_maybe :: WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_maybe WhichGREs GREInfo
which_gres RdrName
rdr_name =
  RdrName
-> (Maybe GlobalRdrElt -> Maybe GlobalRdrElt)
-> RnM (Maybe GlobalRdrElt)
-> RnM (Maybe GlobalRdrElt)
forall r. RdrName -> (Maybe GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe RdrName
rdr_name Maybe GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> a
id (RnM (Maybe GlobalRdrElt) -> RnM (Maybe GlobalRdrElt))
-> RnM (Maybe GlobalRdrElt) -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$
    WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_base WhichGREs GREInfo
which_gres RdrName
rdr_name

lookupGlobalOccRn :: RdrName -> RnM Name
-- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global
-- environment.  Adds an error message if the RdrName is not in scope.
-- You usually want to use "lookupOccRn" which also looks in the local
-- environment.
--
-- Used by exports_from_avail
lookupGlobalOccRn :: RdrName -> RnM Name
lookupGlobalOccRn = WhichGREs GREInfo -> RdrName -> RnM Name
lookupGlobalOccRn' (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal)

lookupGlobalOccRn' :: WhichGREs GREInfo -> RdrName -> RnM Name
lookupGlobalOccRn' :: WhichGREs GREInfo -> RdrName -> RnM Name
lookupGlobalOccRn' WhichGREs GREInfo
which_gres RdrName
rdr_name =
  RdrName -> (GlobalRdrElt -> Name) -> RnM Name -> RnM Name
forall r. RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName (RnM Name -> RnM Name) -> RnM Name -> RnM Name
forall a b. (a -> b) -> a -> b
$ do
    mb_gre <- WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_base WhichGREs GREInfo
which_gres RdrName
rdr_name
    case mb_gre of
      Just GlobalRdrElt
gre -> Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre)
      Maybe GlobalRdrElt
Nothing -> do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupGlobalOccRn" (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
                    ; LookingFor -> RdrName -> RnM Name
unboundName (WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
which_suggest WhereLooking
WL_Global) RdrName
rdr_name }
        where which_suggest :: WhatLooking
which_suggest = case WhichGREs GREInfo -> FieldsOrSelectors
includeFieldSelectors WhichGREs GREInfo
which_gres of
                FieldsOrSelectors
WantBoth   -> WhatLooking
WL_RecField
                FieldsOrSelectors
WantField  -> WhatLooking
WL_RecField
                FieldsOrSelectors
WantNormal -> WhatLooking
WL_Anything

-- Looks up a RdrName occurrence in the GlobalRdrEnv and with
-- lookupQualifiedNameGHCi. Does not try to find an Exact or Orig name first.
-- lookupQualifiedNameGHCi here is used when we're in GHCi and a name like
-- 'Data.Map.elems' is typed, even if you didn't import Data.Map
lookupGlobalOccRn_base :: WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_base :: WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_base WhichGREs GREInfo
which_gres RdrName
rdr_name =
    MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt
-> RnM (Maybe GlobalRdrElt)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt
 -> RnM (Maybe GlobalRdrElt))
-> ([RnM (Maybe GlobalRdrElt)]
    -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt)
-> [RnM (Maybe GlobalRdrElt)]
-> RnM (Maybe GlobalRdrElt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt]
 -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt)
-> ([RnM (Maybe GlobalRdrElt)]
    -> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt])
-> [RnM (Maybe GlobalRdrElt)]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RnM (Maybe GlobalRdrElt)
 -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt)
-> [RnM (Maybe GlobalRdrElt)]
-> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt]
forall a b. (a -> b) -> [a] -> [b]
map RnM (Maybe GlobalRdrElt)
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) GlobalRdrElt
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ([RnM (Maybe GlobalRdrElt)] -> RnM (Maybe GlobalRdrElt))
-> [RnM (Maybe GlobalRdrElt)] -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$
    [ WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGreRn_maybe WhichGREs GREInfo
which_gres RdrName
rdr_name
    , FieldsOrSelectors -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupOneQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name ]
                      -- This test is not expensive,
                      -- and only happens for failed lookups
  where
    fos :: FieldsOrSelectors
fos = case WhichGREs GREInfo
which_gres of
      RelevantGREs { includeFieldSelectors :: WhichGREs GREInfo -> FieldsOrSelectors
includeFieldSelectors = FieldsOrSelectors
sel } -> FieldsOrSelectors
sel
      WhichGREs GREInfo
_ -> if OccName -> Bool
isFieldOcc (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
           then FieldsOrSelectors
WantField
           else FieldsOrSelectors
WantNormal

-- | Lookup a 'Name' in the 'GlobalRdrEnv', falling back to looking up
-- in the type environment it if fails.
lookupGREInfo_GRE :: HasDebugCallStack => Name -> RnM GREInfo
lookupGREInfo_GRE :: HasDebugCallStack => Name -> RnM GREInfo
lookupGREInfo_GRE Name
name
  = do { rdr_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
       ; case lookupGRE_Name rdr_env name of
          Just ( GRE { gre_info :: forall info. GlobalRdrEltX info -> info
gre_info = GREInfo
info } )
            -> GREInfo -> RnM GREInfo
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return GREInfo
info
          Maybe GlobalRdrElt
_ -> do { hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
                  ; return $ lookupGREInfo hsc_env name } }
  -- Just looking in the GlobalRdrEnv is insufficient, as we also
  -- need to handle qualified imports in GHCi; see e.g. T9815ghci.

lookupInfoOccRn :: RdrName -> RnM [Name]
-- ^ lookupInfoOccRn is intended for use in GHCi's ":info" command
-- It finds all the GREs that RdrName could mean, not complaining
-- about ambiguity, but rather returning them all (c.f. #9881).
--
-- lookupInfoOccRn is also used in situations where we check for
-- at least one definition of the RdrName, not complaining about
-- multiple definitions (see #17832).
lookupInfoOccRn :: RdrName -> RnM [Name]
lookupInfoOccRn RdrName
rdr_name =
  RdrName -> (GlobalRdrElt -> [Name]) -> RnM [Name] -> RnM [Name]
forall r. RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name (\ GlobalRdrElt
gre -> [GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre]) (RnM [Name] -> RnM [Name]) -> RnM [Name] -> RnM [Name]
forall a b. (a -> b) -> a -> b
$
    do { rdr_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
       ; let nms = (GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName ([GlobalRdrElt] -> [Name]) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv -> LookupGRE GREInfo -> [GlobalRdrElt]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnv
rdr_env (RdrName -> WhichGREs GREInfo -> LookupGRE GREInfo
forall info. RdrName -> WhichGREs info -> LookupGRE info
LookupRdrName RdrName
rdr_name (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantBoth))
       ; qual_nms <- map greName <$> lookupQualifiedNameGHCi WantBoth rdr_name
       ; return $ nms ++ (qual_nms `minusList` nms) }

-- | Look up all record field names, available in the 'GlobalRdrEnv',
-- that a given 'RdrName' might refer to.
-- (Also includes implicit qualified imports in GHCi).
--
-- Throws an error if no fields are found.
--
-- See Note [DisambiguateRecordFields for updates].
lookupFieldGREs :: GlobalRdrEnv -> LocatedN RdrName -> RnM (NE.NonEmpty FieldGlobalRdrElt)
lookupFieldGREs :: GlobalRdrEnv -> LocatedN RdrName -> RnM (NonEmpty GlobalRdrElt)
lookupFieldGREs GlobalRdrEnv
env (L SrcSpanAnnN
loc RdrName
rdr)
  = SrcSpanAnnN
-> RnM (NonEmpty GlobalRdrElt) -> RnM (NonEmpty GlobalRdrElt)
forall ann a. EpAnn ann -> TcRn a -> TcRn a
setSrcSpanA SrcSpanAnnN
loc
  (RnM (NonEmpty GlobalRdrElt) -> RnM (NonEmpty GlobalRdrElt))
-> RnM (NonEmpty GlobalRdrElt) -> RnM (NonEmpty GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ do { res <- RdrName
-> (GlobalRdrElt -> [GlobalRdrElt])
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall r. RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr (\ GlobalRdrElt
gre -> Maybe GlobalRdrElt -> [GlobalRdrElt]
forall a. Maybe a -> [a]
maybeToList (Maybe GlobalRdrElt -> [GlobalRdrElt])
-> Maybe GlobalRdrElt -> [GlobalRdrElt]
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Maybe GlobalRdrElt
fieldGRE_maybe GlobalRdrElt
gre) (IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
 -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt])
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall a b. (a -> b) -> a -> b
$
           do { let ([GlobalRdrElt]
env_fld_gres, [GlobalRdrElt]
env_var_gres) =
                      (GlobalRdrElt -> Bool)
-> [GlobalRdrElt] -> ([GlobalRdrElt], [GlobalRdrElt])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isRecFldGRE ([GlobalRdrElt] -> ([GlobalRdrElt], [GlobalRdrElt]))
-> [GlobalRdrElt] -> ([GlobalRdrElt], [GlobalRdrElt])
forall a b. (a -> b) -> a -> b
$
                      GlobalRdrEnv -> LookupGRE GREInfo -> [GlobalRdrElt]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnv
env (RdrName -> WhichGREs GREInfo -> LookupGRE GREInfo
forall info. RdrName -> WhichGREs info -> LookupGRE info
LookupRdrName RdrName
rdr (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantBoth))

              -- Handle implicit qualified imports in GHCi. See T10439.
              ; ghci_gres <- HasDebugCallStack =>
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
lookupQualifiedNameGHCi FieldsOrSelectors
WantBoth RdrName
rdr
              ; let (ghci_fld_gres, ghci_var_gres) =
                      partition isRecFldGRE $
                      ghci_gres

              ; let fld_gres = [GlobalRdrElt]
ghci_fld_gres [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++ [GlobalRdrElt]
env_fld_gres
                    var_gres = [GlobalRdrElt]
ghci_var_gres [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++ [GlobalRdrElt]
env_var_gres

              -- Add an error for ambiguity when -XDisambiguateRecordFields is off.
              --
              -- See Note [DisambiguateRecordFields for updates].
              ; disamb_ok <- xoptM LangExt.DisambiguateRecordFields
              ;  if | not disamb_ok
                    , gre1 : gre2 : others <- fld_gres ++ var_gres
                    -> addErrTc $ TcRnAmbiguousFieldInUpdate (gre1, gre2, others)
                    | otherwise
                    -> return ()
              ; return fld_gres }

       -- Add an error if lookup failed.
       ; case res of
          GlobalRdrElt
gre : [GlobalRdrElt]
gres -> NonEmpty GlobalRdrElt -> RnM (NonEmpty GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty GlobalRdrElt -> RnM (NonEmpty GlobalRdrElt))
-> NonEmpty GlobalRdrElt -> RnM (NonEmpty GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
forall a. a -> [a] -> NonEmpty a
NE.:| [GlobalRdrElt]
gres
          [] -> do { (imp_errs, hints) <-
                       LocalRdrEnv
-> WhatLooking -> RdrName -> RnM ([ImportError], [GhcHint])
unknownNameSuggestions LocalRdrEnv
emptyLocalRdrEnv WhatLooking
WL_RecField RdrName
rdr
                   ; failWithTc $
                       TcRnNotInScope NotARecordField rdr imp_errs hints } }

-- | Look up a 'RdrName', which might refer to an overloaded record field.
--
-- Don't allow any ambiguity: emit a name-clash error if there are multiple
-- matching GREs.
lookupGlobalOccRn_overloaded :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_overloaded :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupGlobalOccRn_overloaded RdrName
rdr_name =
  RdrName
-> (Maybe GlobalRdrElt -> Maybe GlobalRdrElt)
-> RnM (Maybe GlobalRdrElt)
-> RnM (Maybe GlobalRdrElt)
forall r. RdrName -> (Maybe GlobalRdrElt -> r) -> RnM r -> RnM r
lookupExactOrOrig_maybe RdrName
rdr_name Maybe GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> a
id (RnM (Maybe GlobalRdrElt) -> RnM (Maybe GlobalRdrElt))
-> RnM (Maybe GlobalRdrElt) -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$
    do { res <- WhichGREs GREInfo
-> RdrName -> DeprecationWarnings -> RnM GreLookupResult
lookupGreRn_helper (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal) RdrName
rdr_name DeprecationWarnings
AllDeprecationWarnings
       ; case res of
           GreLookupResult
GreNotFound        -> FieldsOrSelectors -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupOneQualifiedNameGHCi FieldsOrSelectors
WantNormal RdrName
rdr_name
           OneNameMatch GlobalRdrElt
gre   -> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt))
-> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just GlobalRdrElt
gre
           MultipleNames gres :: NonEmpty GlobalRdrElt
gres@(GlobalRdrElt
gre NE.:| [GlobalRdrElt]
_) -> do
              RdrName
-> NonEmpty GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name NonEmpty GlobalRdrElt
gres
              Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just GlobalRdrElt
gre) }

getFieldUpdLbl :: LHsRecUpdField (GhcPass p) q -> LocatedN RdrName
getFieldUpdLbl :: forall (p :: Pass) q.
LHsRecUpdField (GhcPass p) q -> LocatedN RdrName
getFieldUpdLbl = AmbiguousFieldOcc (GhcPass p) -> LocatedN RdrName
forall (p :: Pass).
AmbiguousFieldOcc (GhcPass p) -> LocatedN RdrName
ambiguousFieldOccLRdrName (AmbiguousFieldOcc (GhcPass p) -> LocatedN RdrName)
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
         (LHsExpr q))
    -> AmbiguousFieldOcc (GhcPass p))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
        (LHsExpr q))
-> LocatedN RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p))
-> AmbiguousFieldOcc (GhcPass p)
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p))
 -> AmbiguousFieldOcc (GhcPass p))
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
         (LHsExpr q))
    -> GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
        (LHsExpr q))
-> AmbiguousFieldOcc (GhcPass p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsFieldBind
  (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
  (LHsExpr q)
-> GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p))
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS (HsFieldBind
   (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
   (LHsExpr q)
 -> GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
         (LHsExpr q))
    -> HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
         (LHsExpr q))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
        (LHsExpr q))
-> GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
     (LHsExpr q))
-> HsFieldBind
     (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
     (LHsExpr q)
forall l e. GenLocated l e -> e
unLoc

-- | Returns all possible collections of field labels for the given
-- record update.
--
--   Example:
--
--       data D = MkD { fld1 :: Int, fld2 :: Bool }
--       data E = MkE1 { fld1 :: Int, fld2 :: Bool, fld3 :: Char }
--              | MkE2 { fld1 :: Int, fld2 :: Bool }
--       data F = MkF1 { fld1 :: Int } | MkF2 { fld2 :: Bool }
--
--       f r = r { fld1 = a, fld2 = b }
--
--     This function will return:
--
--       [ [ D.fld1, D.fld2 ] -- could be a record update at type D
--       , [ E.fld1, E.fld2 ] -- could be a record update at type E
--       ] -- cannot be a record update at type F: no constructor has both
--         -- of the fields fld1 and fld2
--
-- If there are no valid parents for the record update,
-- throws a 'TcRnBadRecordUpdate' error.
lookupRecUpdFields :: NE.NonEmpty (LHsRecUpdField GhcPs GhcPs)
                   -> RnM (NE.NonEmpty (HsRecUpdParent GhcRn))
lookupRecUpdFields :: NonEmpty (LHsRecUpdField GhcPs GhcPs)
-> RnM (NonEmpty (HsRecUpdParent GhcRn))
lookupRecUpdFields NonEmpty (LHsRecUpdField GhcPs GhcPs)
flds
-- See Note [Disambiguating record updates] in GHC.Rename.Pat.
  = do { -- Retrieve the possible GlobalRdrElts that each field could refer to.
       ; gre_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
       ; fld1_gres NE.:| other_flds_gres <- mapM (lookupFieldGREs gre_env . getFieldUpdLbl) flds
         -- Take an intersection: we are only interested in constructors
         -- which have all of the fields.
       ; let possible_GREs = NonEmpty GlobalRdrElt
-> [NonEmpty GlobalRdrElt] -> [HsRecUpdParent GhcRn]
intersect_by_cons NonEmpty GlobalRdrElt
fld1_gres [NonEmpty GlobalRdrElt]
other_flds_gres

       ; traceRn "lookupRecUpdFields" $
           vcat [ text "flds:" <+> ppr (fmap getFieldUpdLbl flds)
                , text "possible_GREs:" <+>
                    ppr (map (fmap greName . rnRecUpdLabels) possible_GREs) ]

       ; case possible_GREs of

          -- There is at least one parent: we can proceed.
          -- The typechecker might be able to finish disambiguating.
          -- See Note [Type-directed record disambiguation] in GHC.Rename.Pat.
       { HsRecUpdParent GhcRn
p1:[HsRecUpdParent GhcRn]
ps -> NonEmpty (HsRecUpdParent GhcRn)
-> RnM (NonEmpty (HsRecUpdParent GhcRn))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsRecUpdParent GhcRn
p1 HsRecUpdParent GhcRn
-> [HsRecUpdParent GhcRn] -> NonEmpty (HsRecUpdParent GhcRn)
forall a. a -> [a] -> NonEmpty a
NE.:| [HsRecUpdParent GhcRn]
ps)

          -- There are no possible parents for the record update: compute
          -- a minimum set of fields which does not belong to any data constructor,
          -- to report an informative error to the user.
       ; [HsRecUpdParent GhcRn]
_ ->
          let
            -- The constructors which have the first field.
            fld1_cons :: UniqSet ConLikeName
            fld1_cons :: UniqSet ConLikeName
fld1_cons = [UniqSet ConLikeName] -> UniqSet ConLikeName
forall a. [UniqSet a] -> UniqSet a
unionManyUniqSets
                      ([UniqSet ConLikeName] -> UniqSet ConLikeName)
-> [UniqSet ConLikeName] -> UniqSet ConLikeName
forall a b. (a -> b) -> a -> b
$ NonEmpty (UniqSet ConLikeName) -> [UniqSet ConLikeName]
forall a. NonEmpty a -> [a]
NE.toList
                      (NonEmpty (UniqSet ConLikeName) -> [UniqSet ConLikeName])
-> NonEmpty (UniqSet ConLikeName) -> [UniqSet ConLikeName]
forall a b. (a -> b) -> a -> b
$ (GlobalRdrElt -> UniqSet ConLikeName)
-> NonEmpty GlobalRdrElt -> NonEmpty (UniqSet ConLikeName)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (RecFieldInfo -> UniqSet ConLikeName
recFieldCons (RecFieldInfo -> UniqSet ConLikeName)
-> (GlobalRdrElt -> RecFieldInfo)
-> GlobalRdrElt
-> UniqSet ConLikeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => GlobalRdrElt -> RecFieldInfo
GlobalRdrElt -> RecFieldInfo
fieldGREInfo) NonEmpty GlobalRdrElt
fld1_gres
            -- The field labels of the constructors which have the first field.
            fld1_cons_fields :: UniqFM ConLikeName [FieldLabel]
            fld1_cons_fields :: UniqFM ConLikeName [FieldLabel]
fld1_cons_fields
              = (ConLikeName -> [FieldLabel])
-> UniqFM ConLikeName ConLikeName
-> UniqFM ConLikeName [FieldLabel]
forall a b.
(a -> b) -> UniqFM ConLikeName a -> UniqFM ConLikeName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GlobalRdrEnv -> ConLikeName -> [FieldLabel]
lkp_con_fields GlobalRdrEnv
gre_env)
              (UniqFM ConLikeName ConLikeName -> UniqFM ConLikeName [FieldLabel])
-> UniqFM ConLikeName ConLikeName
-> UniqFM ConLikeName [FieldLabel]
forall a b. (a -> b) -> a -> b
$ UniqSet ConLikeName -> UniqFM ConLikeName ConLikeName
forall a. UniqSet a -> UniqFM a a
getUniqSet UniqSet ConLikeName
fld1_cons
          in TcRnMessage -> RnM (NonEmpty (HsRecUpdParent GhcRn))
forall a. TcRnMessage -> TcM a
failWithTc (TcRnMessage -> RnM (NonEmpty (HsRecUpdParent GhcRn)))
-> TcRnMessage -> RnM (NonEmpty (HsRecUpdParent GhcRn))
forall a b. (a -> b) -> a -> b
$ [LHsRecUpdField GhcPs GhcPs]
-> UniqFM ConLikeName [FieldLabel] -> TcRnMessage
forall (p :: Pass) q.
OutputableBndrId p =>
[LHsRecUpdField (GhcPass p) q]
-> UniqFM ConLikeName [FieldLabel] -> TcRnMessage
badFieldsUpd (NonEmpty
  (GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
        (XRec GhcPs (HsExpr GhcPs))))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
         (XRec GhcPs (HsExpr GhcPs)))]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LHsRecUpdField GhcPs GhcPs)
NonEmpty
  (GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcPs))
        (XRec GhcPs (HsExpr GhcPs))))
flds) UniqFM ConLikeName [FieldLabel]
fld1_cons_fields } }

  where
    intersect_by_cons :: NE.NonEmpty FieldGlobalRdrElt
                      -> [NE.NonEmpty FieldGlobalRdrElt]
                      -> [HsRecUpdParent GhcRn]
    intersect_by_cons :: NonEmpty GlobalRdrElt
-> [NonEmpty GlobalRdrElt] -> [HsRecUpdParent GhcRn]
intersect_by_cons NonEmpty GlobalRdrElt
this [] =
      (GlobalRdrElt -> HsRecUpdParent GhcRn)
-> [GlobalRdrElt] -> [HsRecUpdParent GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map
        (\ GlobalRdrElt
fld -> NonEmpty GlobalRdrElt
-> UniqSet ConLikeName -> HsRecUpdParent GhcRn
RnRecUpdParent (GlobalRdrElt
fld GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
forall a. a -> [a] -> NonEmpty a
NE.:| []) (RecFieldInfo -> UniqSet ConLikeName
recFieldCons (HasDebugCallStack => GlobalRdrElt -> RecFieldInfo
GlobalRdrElt -> RecFieldInfo
fieldGREInfo GlobalRdrElt
fld)))
        (NonEmpty GlobalRdrElt -> [GlobalRdrElt]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty GlobalRdrElt
this)
    intersect_by_cons NonEmpty GlobalRdrElt
this (NonEmpty GlobalRdrElt
new : [NonEmpty GlobalRdrElt]
rest) =
      [ NonEmpty GlobalRdrElt
-> UniqSet ConLikeName -> HsRecUpdParent GhcRn
RnRecUpdParent (GlobalRdrElt
this_fld GlobalRdrElt -> NonEmpty GlobalRdrElt -> NonEmpty GlobalRdrElt
forall a. a -> NonEmpty a -> NonEmpty a
NE.<| NonEmpty GlobalRdrElt
next_flds) UniqSet ConLikeName
both_cons
      | GlobalRdrElt
this_fld <- NonEmpty GlobalRdrElt -> [GlobalRdrElt]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty GlobalRdrElt
this
      , let this_cons :: UniqSet ConLikeName
this_cons = RecFieldInfo -> UniqSet ConLikeName
recFieldCons (RecFieldInfo -> UniqSet ConLikeName)
-> RecFieldInfo -> UniqSet ConLikeName
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => GlobalRdrElt -> RecFieldInfo
GlobalRdrElt -> RecFieldInfo
fieldGREInfo GlobalRdrElt
this_fld
      , RnRecUpdParent NonEmpty GlobalRdrElt
next_flds UniqSet ConLikeName
next_cons <- NonEmpty GlobalRdrElt
-> [NonEmpty GlobalRdrElt] -> [HsRecUpdParent GhcRn]
intersect_by_cons NonEmpty GlobalRdrElt
new [NonEmpty GlobalRdrElt]
rest
      , let both_cons :: UniqSet ConLikeName
both_cons = UniqSet ConLikeName
next_cons UniqSet ConLikeName -> UniqSet ConLikeName -> UniqSet ConLikeName
forall a. UniqSet a -> UniqSet a -> UniqSet a
`intersectUniqSets` UniqSet ConLikeName
this_cons
      , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ UniqSet ConLikeName -> Bool
forall a. UniqSet a -> Bool
isEmptyUniqSet UniqSet ConLikeName
both_cons
      ]

    lkp_con_fields :: GlobalRdrEnv -> ConLikeName -> [FieldLabel]
    lkp_con_fields :: GlobalRdrEnv -> ConLikeName -> [FieldLabel]
lkp_con_fields GlobalRdrEnv
gre_env ConLikeName
con =
      [ FieldLabel
fl
      | let nm :: Name
nm = ConLikeName -> Name
conLikeName_Name ConLikeName
con
      , GlobalRdrElt
gre      <- Maybe GlobalRdrElt -> [GlobalRdrElt]
forall a. Maybe a -> [a]
maybeToList (Maybe GlobalRdrElt -> [GlobalRdrElt])
-> Maybe GlobalRdrElt -> [GlobalRdrElt]
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
gre_env Name
nm
      , ConInfo
con_info <- Maybe ConInfo -> [ConInfo]
forall a. Maybe a -> [a]
maybeToList (Maybe ConInfo -> [ConInfo]) -> Maybe ConInfo -> [ConInfo]
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => GlobalRdrElt -> Maybe ConInfo
GlobalRdrElt -> Maybe ConInfo
recFieldConLike_maybe GlobalRdrElt
gre
      , FieldLabel
fl       <- ConInfo -> [FieldLabel]
conInfoFields ConInfo
con_info ]

{-**********************************************************************
*                                                                      *
                      Record field errors
*                                                                      *
**********************************************************************-}

getUpdFieldLbls :: forall p q. UnXRec (GhcPass p)
                => [LHsRecUpdField (GhcPass p) q] -> [RdrName]
getUpdFieldLbls :: forall (p :: Pass) q.
UnXRec (GhcPass p) =>
[LHsRecUpdField (GhcPass p) q] -> [RdrName]
getUpdFieldLbls
  = (LHsRecUpdField (GhcPass p) q -> RdrName)
-> [LHsRecUpdField (GhcPass p) q] -> [RdrName]
forall a b. (a -> b) -> [a] -> [b]
map ((LHsRecUpdField (GhcPass p) q -> RdrName)
 -> [LHsRecUpdField (GhcPass p) q] -> [RdrName])
-> (LHsRecUpdField (GhcPass p) q -> RdrName)
-> [LHsRecUpdField (GhcPass p) q]
-> [RdrName]
forall a b. (a -> b) -> a -> b
$ AmbiguousFieldOcc (GhcPass p) -> RdrName
forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
ambiguousFieldOccRdrName
        (AmbiguousFieldOcc (GhcPass p) -> RdrName)
-> (LHsRecUpdField (GhcPass p) q -> AmbiguousFieldOcc (GhcPass p))
-> LHsRecUpdField (GhcPass p) q
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @(GhcPass p)
        (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p))
 -> AmbiguousFieldOcc (GhcPass p))
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
         (XRec q (HsExpr q)))
    -> GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
        (XRec q (HsExpr q)))
-> AmbiguousFieldOcc (GhcPass p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsFieldBind
  (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
  (XRec q (HsExpr q))
-> GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p))
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS
        (HsFieldBind
   (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
   (XRec q (HsExpr q))
 -> GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
         (XRec q (HsExpr q)))
    -> HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
         (XRec q (HsExpr q)))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
        (XRec q (HsExpr q)))
-> GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @(GhcPass p)

-- | Create an error message when there is no single 'ConLike' which
-- has all of the required fields for a record update.
--
-- This boils down the problem to a smaller set of fields, to avoid
-- the error message containing a lot of uninformative field names that
-- aren't really relevant to the problem.
--
-- NB: this error message should only be triggered when all the field names
-- are in scope (i.e. each individual field name does belong to some
-- constructor in scope).
badFieldsUpd
  :: (OutputableBndrId p)
  => [LHsRecUpdField (GhcPass p) q]
               -- ^ Field names that don't belong to a single datacon
  -> UniqFM ConLikeName [FieldLabel]
      -- ^ The list of field labels for each constructor.
      -- (These are the constructors in which the first field occurs.)
  -> TcRnMessage
badFieldsUpd :: forall (p :: Pass) q.
OutputableBndrId p =>
[LHsRecUpdField (GhcPass p) q]
-> UniqFM ConLikeName [FieldLabel] -> TcRnMessage
badFieldsUpd [LHsRecUpdField (GhcPass p) q]
rbinds UniqFM ConLikeName [FieldLabel]
fld1_cons_fields
  = [RdrName] -> BadRecordUpdateReason -> TcRnMessage
TcRnBadRecordUpdate
      ([LHsRecUpdField (GhcPass p) q] -> [RdrName]
forall (p :: Pass) q.
UnXRec (GhcPass p) =>
[LHsRecUpdField (GhcPass p) q] -> [RdrName]
getUpdFieldLbls [LHsRecUpdField (GhcPass p) q]
rbinds)
      ([FieldLabelString] -> BadRecordUpdateReason
NoConstructorHasAllFields [FieldLabelString]
conflictingFields)
          -- See Note [Finding the conflicting fields]
  where
    -- A (preferably small) set of fields such that no constructor contains
    -- all of them.  See Note [Finding the conflicting fields]
    conflictingFields :: [FieldLabelString]
conflictingFields = case [(FieldLabelString, [Bool])]
nonMembers of
        -- nonMember belongs to a different type.
        (FieldLabelString
nonMember, [Bool]
_) : [(FieldLabelString, [Bool])]
_ -> [FieldLabelString
aMember, FieldLabelString
nonMember]
        [] -> let
            -- All of rbinds belong to one type. In this case, repeatedly add
            -- a field to the set until no constructor contains the set.

            -- Each field, together with a list indicating which constructors
            -- have all the fields so far.
            growingSets :: [(FieldLabelString, [Bool])]
            growingSets :: [(FieldLabelString, [Bool])]
growingSets = ((FieldLabelString, [Bool])
 -> (FieldLabelString, [Bool]) -> (FieldLabelString, [Bool]))
-> [(FieldLabelString, [Bool])] -> [(FieldLabelString, [Bool])]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 (FieldLabelString, [Bool])
-> (FieldLabelString, [Bool]) -> (FieldLabelString, [Bool])
forall {a} {a}. (a, [Bool]) -> (a, [Bool]) -> (a, [Bool])
combine [(FieldLabelString, [Bool])]
membership
            combine :: (a, [Bool]) -> (a, [Bool]) -> (a, [Bool])
combine (a
_, [Bool]
setMem) (a
field, [Bool]
fldMem)
              = (a
field, (Bool -> Bool -> Bool) -> [Bool] -> [Bool] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Bool -> Bool
(&&) [Bool]
setMem [Bool]
fldMem)
            in
            -- Fields that don't change the membership status of the set
            -- are redundant and can be dropped.
            ([(FieldLabelString, [Bool])] -> FieldLabelString)
-> [[(FieldLabelString, [Bool])]] -> [FieldLabelString]
forall a b. (a -> b) -> [a] -> [b]
map ((FieldLabelString, [Bool]) -> FieldLabelString
forall a b. (a, b) -> a
fst ((FieldLabelString, [Bool]) -> FieldLabelString)
-> ([(FieldLabelString, [Bool])] -> (FieldLabelString, [Bool]))
-> [(FieldLabelString, [Bool])]
-> FieldLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FieldLabelString, [Bool])] -> (FieldLabelString, [Bool])
forall a. HasCallStack => [a] -> a
head) ([[(FieldLabelString, [Bool])]] -> [FieldLabelString])
-> [[(FieldLabelString, [Bool])]] -> [FieldLabelString]
forall a b. (a -> b) -> a -> b
$ ((FieldLabelString, [Bool]) -> (FieldLabelString, [Bool]) -> Bool)
-> [(FieldLabelString, [Bool])] -> [[(FieldLabelString, [Bool])]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ([Bool] -> [Bool] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([Bool] -> [Bool] -> Bool)
-> ((FieldLabelString, [Bool]) -> [Bool])
-> (FieldLabelString, [Bool])
-> (FieldLabelString, [Bool])
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (FieldLabelString, [Bool]) -> [Bool]
forall a b. (a, b) -> b
snd) [(FieldLabelString, [Bool])]
growingSets

    aMember :: FieldLabelString
aMember = Bool
-> ((FieldLabelString, [Bool]) -> FieldLabelString)
-> (FieldLabelString, [Bool])
-> FieldLabelString
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not ([(FieldLabelString, [Bool])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, [Bool])]
members) ) (FieldLabelString, [Bool]) -> FieldLabelString
forall a b. (a, b) -> a
fst ([(FieldLabelString, [Bool])] -> (FieldLabelString, [Bool])
forall a. HasCallStack => [a] -> a
head [(FieldLabelString, [Bool])]
members)
    ([(FieldLabelString, [Bool])]
members, [(FieldLabelString, [Bool])]
nonMembers) = ((FieldLabelString, [Bool]) -> Bool)
-> [(FieldLabelString, [Bool])]
-> ([(FieldLabelString, [Bool])], [(FieldLabelString, [Bool])])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool)
-> ((FieldLabelString, [Bool]) -> [Bool])
-> (FieldLabelString, [Bool])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldLabelString, [Bool]) -> [Bool]
forall a b. (a, b) -> b
snd) [(FieldLabelString, [Bool])]
membership

    -- For each field, which constructors contain the field?
    membership :: [(FieldLabelString, [Bool])]
    membership :: [(FieldLabelString, [Bool])]
membership
      = [(FieldLabelString, [Bool])] -> [(FieldLabelString, [Bool])]
forall {a}. [(a, [Bool])] -> [(a, [Bool])]
sortMembership ([(FieldLabelString, [Bool])] -> [(FieldLabelString, [Bool])])
-> [(FieldLabelString, [Bool])] -> [(FieldLabelString, [Bool])]
forall a b. (a -> b) -> a -> b
$
        (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
      (XRec q (HsExpr q)))
 -> (FieldLabelString, [Bool]))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
         (XRec q (HsExpr q)))]
-> [(FieldLabelString, [Bool])]
forall a b. (a -> b) -> [a] -> [b]
map
          ( (\FieldLabelString
fld -> (FieldLabelString
fld, (UniqSet FieldLabelString -> Bool)
-> [UniqSet FieldLabelString] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (FieldLabelString
fld FieldLabelString -> UniqSet FieldLabelString -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
`elementOfUniqSet`) [UniqSet FieldLabelString]
fieldLabelSets))
          (FieldLabelString -> (FieldLabelString, [Bool]))
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
         (XRec q (HsExpr q)))
    -> FieldLabelString)
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
        (XRec q (HsExpr q)))
-> (FieldLabelString, [Bool])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> FieldLabelString
FieldLabelString (FastString -> FieldLabelString)
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
         (XRec q (HsExpr q)))
    -> FastString)
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
        (XRec q (HsExpr q)))
-> FieldLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
occNameFS (OccName -> FastString)
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
         (XRec q (HsExpr q)))
    -> OccName)
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
        (XRec q (HsExpr q)))
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc (RdrName -> OccName)
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
         (XRec q (HsExpr q)))
    -> RdrName)
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
        (XRec q (HsExpr q)))
-> OccName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (LocatedN RdrName -> RdrName)
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
         (XRec q (HsExpr q)))
    -> LocatedN RdrName)
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
        (XRec q (HsExpr q)))
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsRecUpdField (GhcPass p) q -> LocatedN RdrName
GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
     (XRec q (HsExpr q)))
-> LocatedN RdrName
forall (p :: Pass) q.
LHsRecUpdField (GhcPass p) q -> LocatedN RdrName
getFieldUpdLbl )
          [LHsRecUpdField (GhcPass p) q]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated SrcSpanAnnA (AmbiguousFieldOcc (GhcPass p)))
      (XRec q (HsExpr q)))]
rbinds

    fieldLabelSets :: [UniqSet FieldLabelString]
    fieldLabelSets :: [UniqSet FieldLabelString]
fieldLabelSets = ([FieldLabel] -> UniqSet FieldLabelString)
-> [[FieldLabel]] -> [UniqSet FieldLabelString]
forall a b. (a -> b) -> [a] -> [b]
map ([FieldLabelString] -> UniqSet FieldLabelString
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet ([FieldLabelString] -> UniqSet FieldLabelString)
-> ([FieldLabel] -> [FieldLabelString])
-> [FieldLabel]
-> UniqSet FieldLabelString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldLabel -> FieldLabelString)
-> [FieldLabel] -> [FieldLabelString]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> FieldLabelString
flLabel) ([[FieldLabel]] -> [UniqSet FieldLabelString])
-> [[FieldLabel]] -> [UniqSet FieldLabelString]
forall a b. (a -> b) -> a -> b
$ UniqFM ConLikeName [FieldLabel] -> [[FieldLabel]]
forall {k} (key :: k) elt. UniqFM key elt -> [elt]
nonDetEltsUFM UniqFM ConLikeName [FieldLabel]
fld1_cons_fields

    -- Sort in order of increasing number of True, so that a smaller
    -- conflicting set can be found.
    sortMembership :: [(a, [Bool])] -> [(a, [Bool])]
sortMembership =
      ((Arity, (a, [Bool])) -> (a, [Bool]))
-> [(Arity, (a, [Bool]))] -> [(a, [Bool])]
forall a b. (a -> b) -> [a] -> [b]
map (Arity, (a, [Bool])) -> (a, [Bool])
forall a b. (a, b) -> b
snd ([(Arity, (a, [Bool]))] -> [(a, [Bool])])
-> ([(a, [Bool])] -> [(Arity, (a, [Bool]))])
-> [(a, [Bool])]
-> [(a, [Bool])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ((Arity, (a, [Bool])) -> (Arity, (a, [Bool])) -> Ordering)
-> [(Arity, (a, [Bool]))] -> [(Arity, (a, [Bool]))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Arity -> Arity -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Arity -> Arity -> Ordering)
-> ((Arity, (a, [Bool])) -> Arity)
-> (Arity, (a, [Bool]))
-> (Arity, (a, [Bool]))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Arity, (a, [Bool])) -> Arity
forall a b. (a, b) -> a
fst) ([(Arity, (a, [Bool]))] -> [(Arity, (a, [Bool]))])
-> ([(a, [Bool])] -> [(Arity, (a, [Bool]))])
-> [(a, [Bool])]
-> [(Arity, (a, [Bool]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ((a, [Bool]) -> (Arity, (a, [Bool])))
-> [(a, [Bool])] -> [(Arity, (a, [Bool]))]
forall a b. (a -> b) -> [a] -> [b]
map (\ item :: (a, [Bool])
item@(a
_, [Bool]
membershipRow) -> ([Bool] -> Arity
countTrue [Bool]
membershipRow, (a, [Bool])
item))

    countTrue :: [Bool] -> Arity
countTrue = (Bool -> Bool) -> [Bool] -> Arity
forall a. (a -> Bool) -> [a] -> Arity
count Bool -> Bool
forall a. a -> a
id

{-
Note [Finding the conflicting fields]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we have
  data A = A {a0, a1 :: Int}
         | B {b0, b1 :: Int}
and we see a record update
  x { a0 = 3, a1 = 2, b0 = 4, b1 = 5 }
Then we'd like to find the smallest subset of fields that no
constructor has all of.  Here, say, {a0,b0}, or {a0,b1}, etc.
We don't really want to report that no constructor has all of
{a0,a1,b0,b1}, because when there are hundreds of fields it's
hard to see what was really wrong.

We may need more than two fields, though; eg
  data T = A { x,y :: Int, v::Int }
         | B { y,z :: Int, v::Int }
         | C { z,x :: Int, v::Int }
with update
   r { x=e1, y=e2, z=e3 }, we

Finding the smallest subset is hard, so the code here makes
a decent stab, no more.  See #7989.
-}

--------------------------------------------------
--      Lookup in the Global RdrEnv of the module
--------------------------------------------------

data GreLookupResult = GreNotFound
                     | OneNameMatch GlobalRdrElt
                     | MultipleNames (NE.NonEmpty GlobalRdrElt)

lookupGreRn_maybe :: WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
-- Look up the RdrName in the GlobalRdrEnv
--   Exactly one binding: records it as "used", return (Just gre)
--   No bindings:         return Nothing
--   Many bindings:       report "ambiguous", return an arbitrary (Just gre)
-- Uses addUsedRdrName to record use and deprecations
lookupGreRn_maybe :: WhichGREs GREInfo -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupGreRn_maybe WhichGREs GREInfo
which_gres RdrName
rdr_name
  = do
      res <- WhichGREs GREInfo
-> RdrName -> DeprecationWarnings -> RnM GreLookupResult
lookupGreRn_helper WhichGREs GREInfo
which_gres RdrName
rdr_name DeprecationWarnings
AllDeprecationWarnings
      case res of
        OneNameMatch GlobalRdrElt
gre ->  Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt))
-> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just GlobalRdrElt
gre
        MultipleNames NonEmpty GlobalRdrElt
gres -> do
          String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupGreRn_maybe:NameClash" (NonEmpty GlobalRdrElt -> SDoc
forall a. Outputable a => a -> SDoc
ppr NonEmpty GlobalRdrElt
gres)
          RdrName
-> NonEmpty GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name NonEmpty GlobalRdrElt
gres
          Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt))
-> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just (NonEmpty GlobalRdrElt -> GlobalRdrElt
forall a. NonEmpty a -> a
NE.head NonEmpty GlobalRdrElt
gres)
        GreLookupResult
GreNotFound -> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlobalRdrElt
forall a. Maybe a
Nothing

{-

Note [ Unbound vs Ambiguous Names ]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
lookupGreRn_maybe deals with failures in two different ways. If a name
is unbound then we return a `Nothing` but if the name is ambiguous
then we raise an error and return a dummy name.

The reason for this is that when we call `lookupGreRn_maybe` we are
speculatively looking for whatever we are looking up. If we don't find it,
then we might have been looking for the wrong thing and can keep trying.
On the other hand, if we find a clash then there is no way to recover as
we found the thing we were looking for but can no longer resolve which
the correct one is.

One example of this is in `lookupTypeOccRn` which first looks in the type
constructor namespace before looking in the data constructor namespace to
deal with `DataKinds`.

There is however, as always, one exception to this scheme. If we find
an ambiguous occurrence of a record selector and DuplicateRecordFields
is enabled then we defer the selection until the typechecker.

-}


-- Internal Function
lookupGreRn_helper :: WhichGREs GREInfo -> RdrName -> DeprecationWarnings -> RnM GreLookupResult
lookupGreRn_helper :: WhichGREs GREInfo
-> RdrName -> DeprecationWarnings -> RnM GreLookupResult
lookupGreRn_helper WhichGREs GREInfo
which_gres RdrName
rdr_name DeprecationWarnings
warn_if_deprec
  = do  { env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
        ; case lookupGRE env (LookupRdrName rdr_name which_gres) of
            []    -> GreLookupResult -> RnM GreLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return GreLookupResult
GreNotFound
            [GlobalRdrElt
gre] -> do { DeprecationWarnings
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGRE DeprecationWarnings
warn_if_deprec GlobalRdrElt
gre
                        ; GreLookupResult -> RnM GreLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> GreLookupResult
OneNameMatch GlobalRdrElt
gre) }
            -- Don't record usage for ambiguous names
            -- until we know which is meant
            (GlobalRdrElt
gre:[GlobalRdrElt]
others) -> GreLookupResult -> RnM GreLookupResult
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty GlobalRdrElt -> GreLookupResult
MultipleNames (GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
forall a. a -> [a] -> NonEmpty a
NE.:| [GlobalRdrElt]
others)) }

lookupGreAvailRn :: RdrName -> RnM (Maybe GlobalRdrElt)
-- Used in export lists
-- If not found or ambiguous, add error message, and fake with UnboundName
-- Uses addUsedRdrName to record use and deprecations
lookupGreAvailRn :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupGreAvailRn RdrName
rdr_name
  = do
      mb_gre <- WhichGREs GREInfo
-> RdrName -> DeprecationWarnings -> RnM GreLookupResult
lookupGreRn_helper (FieldsOrSelectors -> WhichGREs GREInfo
RelevantGREsFOS FieldsOrSelectors
WantNormal) RdrName
rdr_name DeprecationWarnings
ExportDeprecationWarnings
      case mb_gre of
        GreLookupResult
GreNotFound ->
          do
            String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupGreAvailRn" (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
            _ <- LookingFor -> RdrName -> RnM Name
unboundName (WhatLooking -> WhereLooking -> LookingFor
LF WhatLooking
WL_Anything WhereLooking
WL_Global) RdrName
rdr_name
            return Nothing
        MultipleNames NonEmpty GlobalRdrElt
gres ->
          do
            RdrName
-> NonEmpty GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name NonEmpty GlobalRdrElt
gres
            Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlobalRdrElt
forall a. Maybe a
Nothing
              -- Prevent error cascade
        OneNameMatch GlobalRdrElt
gre ->
          Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt))
-> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just GlobalRdrElt
gre

{-
*********************************************************
*                                                      *
                Deprecations
*                                                      *
*********************************************************

Note [Using isImportedGRE in addUsedGRE]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In addUsedGRE, we want to add any used imported GREs to the tcg_used_gres field,
so that we can emit appropriate warnings (see GHC.Rename.Names.warnUnusedImportDecls).

We want to do this for GREs that were brought into scope through imports. As per
Note [GlobalRdrElt provenance] in GHC.Types.Name.Reader, this means we should
check that gre_imp is non-empty. Checking that gre_lcl is False is INCORRECT,
because we might have obtained the GRE by an Exact or Orig direct reference,
in which case we have both gre_lcl = False and gre_imp = emptyBag.

Geting this wrong can lead to panics in e.g. bestImport, see #23240.
-}

addUsedDataCons :: GlobalRdrEnv -> TyCon -> RnM ()
-- Remember use of in-scope data constructors (#7969)
addUsedDataCons :: GlobalRdrEnv -> TyCon -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedDataCons GlobalRdrEnv
rdr_env TyCon
tycon
  = DeprecationWarnings
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGREs DeprecationWarnings
NoDeprecationWarnings
      [ GlobalRdrElt
gre
      | DataCon
dc <- TyCon -> [DataCon]
tyConDataCons TyCon
tycon
      , Just GlobalRdrElt
gre <- [GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
rdr_env (DataCon -> Name
dataConName DataCon
dc)] ]

addUsedGRE :: DeprecationWarnings -> GlobalRdrElt -> RnM ()
-- Called for both local and imported things
-- Add usage *and* warn if deprecated
addUsedGRE :: DeprecationWarnings
-> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGRE DeprecationWarnings
warn_if_deprec GlobalRdrElt
gre
  = do { DeprecationWarnings
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIfDeprecated DeprecationWarnings
warn_if_deprec [GlobalRdrElt
gre]
       ; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isImportedGRE GlobalRdrElt
gre) (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ -- See Note [Using isImportedGRE in addUsedGRE]
         do { env <- IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
             -- Do not report the GREInfo (#23424)
            ; traceRn "addUsedGRE" (ppr $ greName gre)
            ; updTcRef (tcg_used_gres env) (gre :) } }

addUsedGREs :: DeprecationWarnings -> [GlobalRdrElt] -> RnM ()
-- Record uses of any *imported* GREs
-- Used for recording used sub-bndrs
-- NB: no call to warnIfDeprecated; see Note [Handling of deprecations] in GHC.Rename.Utils
addUsedGREs :: DeprecationWarnings
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGREs DeprecationWarnings
warn_if_deprec [GlobalRdrElt]
gres
  = do { DeprecationWarnings
-> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIfDeprecated DeprecationWarnings
warn_if_deprec [GlobalRdrElt]
gres
       ; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GlobalRdrElt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
imp_gres) (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
         do { env <- IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
              -- Do not report the GREInfo (#23424)
            ; traceRn "addUsedGREs" (ppr $ map greName imp_gres)
            ; updTcRef (tcg_used_gres env) (imp_gres ++) } }
  where
    imp_gres :: [GlobalRdrElt]
imp_gres = (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isImportedGRE [GlobalRdrElt]
gres
    -- See Note [Using isImportedGRE in addUsedGRE]

{-
Note [Used names with interface not loaded]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It's (just) possible to find a used
Name whose interface hasn't been loaded:

a) It might be a WiredInName; in that case we may not load
   its interface (although we could).

b) It might be GHC.Real.fromRational, or GHC.Num.fromInteger
   These are seen as "used" by the renamer (if -XRebindableSyntax)
   is on), but the typechecker may discard their uses
   if in fact the in-scope fromRational is GHC.Read.fromRational,
   (see tcPat.tcOverloadedLit), and the typechecker sees that the type
   is fixed, say, to GHC.Base.Float (see Inst.lookupSimpleInst).
   In that obscure case it won't force the interface in.

In both cases we simply don't permit deprecations;
this is, after all, wired-in stuff.


*********************************************************
*                                                      *
                GHCi support
*                                                      *
*********************************************************

A qualified name on the command line can refer to any module at
all: we try to load the interface if we don't already have it, just
as if there was an "import qualified M" declaration for every
module.

For example, writing `Data.List.sort` will load the interface file for
`Data.List` as if the user had written `import qualified Data.List`.

If we fail we just return Nothing, rather than bleating
about "attempting to use module ‘D’ (./D.hs) which is not loaded"
which is what loadSrcInterface does.

It is enabled by default and disabled by the flag
`-fno-implicit-import-qualified`.

Note [Safe Haskell and GHCi]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We DON'T do this Safe Haskell as we need to check imports. We can
and should instead check the qualified import but at the moment
this requires some refactoring so leave as a TODO

Note [DuplicateRecordFields and -fimplicit-import-qualified]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When DuplicateRecordFields is used, a single module can export the same OccName
multiple times, for example:

  module M where
    data S = MkS { foo :: Int }
    data T = MkT { foo :: Int }

Now if we refer to M.foo via -fimplicit-import-qualified, we need to report an
ambiguity error.

-}

-- | Like 'lookupQualifiedNameGHCi' but returning at most one name, reporting an
-- ambiguity error if there are more than one.
lookupOneQualifiedNameGHCi :: FieldsOrSelectors -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupOneQualifiedNameGHCi :: FieldsOrSelectors -> RdrName -> RnM (Maybe GlobalRdrElt)
lookupOneQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name = do
    all_gres <- HasDebugCallStack =>
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
lookupQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name
    case all_gres of
      []         -> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlobalRdrElt
forall a. Maybe a
Nothing
      [GlobalRdrElt
gre]      -> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt))
-> Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just (GlobalRdrElt -> Maybe GlobalRdrElt)
-> GlobalRdrElt -> Maybe GlobalRdrElt
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt
gre
      (GlobalRdrElt
gre:[GlobalRdrElt]
gres) ->
        do RdrName
-> NonEmpty GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name (GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
forall a. a -> [a] -> NonEmpty a
NE.:| [GlobalRdrElt]
gres)
           Maybe GlobalRdrElt -> RnM (Maybe GlobalRdrElt)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just (OccName -> GlobalRdrElt
mkUnboundGRE (OccName -> GlobalRdrElt) -> OccName -> GlobalRdrElt
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> OccName
forall info. GlobalRdrEltX info -> OccName
greOccName GlobalRdrElt
gre))
             -- (Use mkUnboundGRE to get the correct namespace)

-- | Look up *all* the names to which the 'RdrName' may refer in GHCi (using
-- @-fimplicit-import-qualified@).  This will normally be zero or one, but may
-- be more in the presence of @DuplicateRecordFields@.
lookupQualifiedNameGHCi :: HasDebugCallStack => FieldsOrSelectors -> RdrName -> RnM [GlobalRdrElt]
lookupQualifiedNameGHCi :: HasDebugCallStack =>
FieldsOrSelectors
-> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
lookupQualifiedNameGHCi FieldsOrSelectors
fos RdrName
rdr_name
  = -- We want to behave as we would for a source file import here,
    -- and respect hiddenness of modules/packages, hence loadSrcInterface.
    do { dflags  <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
       ; is_ghci <- getIsGHCi
       ; go_for_it dflags is_ghci }

  where
    go_for_it :: DynFlags -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
go_for_it DynFlags
dflags Bool
is_ghci
      | Just (ModuleName
mod_name,OccName
occ) <- RdrName -> Maybe (ModuleName, OccName)
isQual_maybe RdrName
rdr_name
      , let ns :: NameSpace
ns = OccName -> NameSpace
occNameSpace OccName
occ
      , Bool
is_ghci
      , GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ImplicitImportQualified DynFlags
dflags   -- Enables this GHCi behaviour
      , Bool -> Bool
not (DynFlags -> Bool
safeDirectImpsReq DynFlags
dflags)            -- See Note [Safe Haskell and GHCi]
      = do { res <- SDoc
-> ModuleName
-> IsBootInterface
-> PkgQual
-> RnM (MaybeErr MissingInterfaceError ModIface)
loadSrcInterface_maybe SDoc
doc ModuleName
mod_name IsBootInterface
NotBoot PkgQual
NoPkgQual
           ; case res of
                Succeeded ModIface
iface
                  -> do { hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
                        ; let gres =
                                [ GlobalRdrElt
gre
                                | IfaceExport
avail <- ModIface -> [IfaceExport]
forall (phase :: ModIfacePhase). ModIface_ phase -> [IfaceExport]
mi_exports ModIface
iface
                                , Name
gname <- IfaceExport -> [Name]
availNames IfaceExport
avail
                                , let lk_occ :: OccName
lk_occ = Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
gname
                                      lk_ns :: NameSpace
lk_ns  = OccName -> NameSpace
occNameSpace OccName
lk_occ
                                , OccName -> FastString
occNameFS OccName
occ FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== OccName -> FastString
occNameFS OccName
lk_occ
                                , NameSpace
ns NameSpace -> NameSpace -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace
lk_ns Bool -> Bool -> Bool
|| (NameSpace
ns NameSpace -> NameSpace -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace
varName Bool -> Bool -> Bool
&& NameSpace -> Bool
isFieldNameSpace NameSpace
lk_ns)
                                , let mod :: Module
mod = ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module ModIface
iface
                                      gre :: GlobalRdrElt
gre = Module -> HscEnv -> Name -> GlobalRdrElt
lookupGRE_PTE Module
mod HscEnv
hsc_env Name
gname
                                , FieldsOrSelectors -> GlobalRdrElt -> Bool
allowGRE FieldsOrSelectors
fos GlobalRdrElt
gre
                                  -- Include a field if it has a selector or we are looking for all fields;
                                  -- see Note [NoFieldSelectors].
                                ]
                        ; return gres }

                MaybeErr MissingInterfaceError ModIface
_ -> -- Either we couldn't load the interface, or
                     -- we could but we didn't find the name in it
                     do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupQualifiedNameGHCi" (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
                        ; [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [] } }

      | Bool
otherwise
      = do { String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"lookupQualifiedNameGHCi: off" (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
           ; [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [] }

    doc :: SDoc
doc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Need to find" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name

    -- Lookup a Name for an implicit qualified import in GHCi
    -- in the given PackageTypeEnv.
    lookupGRE_PTE :: Module -> HscEnv -> Name -> GlobalRdrElt
    lookupGRE_PTE :: Module -> HscEnv -> Name -> GlobalRdrElt
lookupGRE_PTE Module
mod HscEnv
hsc_env Name
nm =
      -- Fake a GRE so we can report a sensible name clash error if
      -- -fimplicit-import-qualified is used with a module that exports the same
      -- field name multiple times (see
      -- Note [DuplicateRecordFields and -fimplicit-import-qualified]).
      GRE { gre_name :: Name
gre_name = Name
nm
          , gre_par :: Parent
gre_par = Parent
NoParent
          , gre_lcl :: Bool
gre_lcl = Bool
False
          , gre_imp :: Bag ImportSpec
gre_imp = ImportSpec -> Bag ImportSpec
forall a. a -> Bag a
unitBag ImportSpec
is
          , gre_info :: GREInfo
gre_info = GREInfo
info }
        where
          info :: GREInfo
info = HasDebugCallStack => HscEnv -> Name -> GREInfo
HscEnv -> Name -> GREInfo
lookupGREInfo HscEnv
hsc_env Name
nm
          spec :: ImpDeclSpec
spec = ImpDeclSpec { is_mod :: Module
is_mod = Module
mod, is_as :: ModuleName
is_as = Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod, is_pkg_qual :: PkgQual
is_pkg_qual = PkgQual
NoPkgQual, is_qual :: Bool
is_qual = Bool
True, is_isboot :: IsBootInterface
is_isboot = IsBootInterface
NotBoot, is_dloc :: SrcSpan
is_dloc = SrcSpan
noSrcSpan }
          is :: ImportSpec
is = ImpSpec { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec
spec, is_item :: ImpItemSpec
is_item = ImpItemSpec
ImpAll }

-- | Look up the 'GREInfo' associated with the given 'Name'
-- by looking up in the type environment.
lookupGREInfo :: HasDebugCallStack => HscEnv -> Name -> GREInfo
lookupGREInfo :: HasDebugCallStack => HscEnv -> Name -> GREInfo
lookupGREInfo HscEnv
hsc_env Name
nm
  | Just TyThing
ty_thing <- Name -> Maybe TyThing
wiredInNameTyThing_maybe Name
nm
  = TyThing -> GREInfo
tyThingGREInfo TyThing
ty_thing
  | Bool
otherwise
  -- Create a thunk which, when forced, loads the interface
  -- and looks up the TyThing in the type environment.
  --
  -- See Note [Retrieving the GREInfo from interfaces] in GHC.Types.GREInfo.
  = case Name -> Maybe Module
nameModule_maybe Name
nm of
      Maybe Module
Nothing  -> GREInfo
UnboundGRE
      Just Module
mod ->
        IO GREInfo -> GREInfo
forall a. IO a -> a
unsafePerformIO (IO GREInfo -> GREInfo) -> IO GREInfo -> GREInfo
forall a b. (a -> b) -> a -> b
$ do
          _ <- HscEnv
-> IfG (MaybeErr MissingInterfaceError ModIface)
-> IO (MaybeErr MissingInterfaceError ModIface)
forall a. HscEnv -> IfG a -> IO a
initIfaceLoad HscEnv
hsc_env (IfG (MaybeErr MissingInterfaceError ModIface)
 -> IO (MaybeErr MissingInterfaceError ModIface))
-> IfG (MaybeErr MissingInterfaceError ModIface)
-> IO (MaybeErr MissingInterfaceError ModIface)
forall a b. (a -> b) -> a -> b
$
               SDoc
-> Module
-> WhereFrom
-> IfG (MaybeErr MissingInterfaceError ModIface)
forall lcl.
SDoc
-> Module
-> WhereFrom
-> IfM lcl (MaybeErr MissingInterfaceError ModIface)
loadInterface (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lookupGREInfo" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm))
                 Module
mod WhereFrom
ImportBySystem
          mb_ty_thing <- lookupType hsc_env nm
          case mb_ty_thing of
            Maybe TyThing
Nothing -> do
              String -> SDoc -> IO GREInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"lookupGREInfo" (SDoc -> IO GREInfo) -> SDoc -> IO GREInfo
forall a b. (a -> b) -> a -> b
$
                      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lookup failed:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm ]
            Just TyThing
ty_thing -> GREInfo -> IO GREInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GREInfo -> IO GREInfo) -> GREInfo -> IO GREInfo
forall a b. (a -> b) -> a -> b
$ TyThing -> GREInfo
tyThingGREInfo TyThing
ty_thing

{-
Note [Looking up signature names]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
lookupSigOccRn is used for type signatures and pragmas
Is this valid?
  module A
        import M( f )
        f :: Int -> Int
        f x = x
It's clear that the 'f' in the signature must refer to A.f
The Haskell98 report does not stipulate this, but it will!
So we must treat the 'f' in the signature in the same way
as the binding occurrence of 'f', using lookupBndrRn

However, consider this case:
        import M( f )
        f :: Int -> Int
        g x = x
We don't want to say 'f' is out of scope; instead, we want to
return the imported 'f', so that later on the renamer will
correctly report "misplaced type sig".

Note [Signatures for top level things]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
data HsSigCtxt = ... | TopSigCtxt NameSet | ....

* The NameSet says what is bound in this group of bindings.
  We can't use isLocalGRE from the GlobalRdrEnv, because of this:
       f x = x
       $( ...some TH splice... )
       f :: Int -> Int
  When we encounter the signature for 'f', the binding for 'f'
  will be in the GlobalRdrEnv, and will be a LocalDef. Yet the
  signature is mis-placed

* For type signatures the NameSet should be the names bound by the
  value bindings; for fixity declarations, the NameSet should also
  include class sigs and record selectors

      infix 3 `f`          -- Yes, ok
      f :: C a => a -> a   -- No, not ok
      class C a where
        f :: a -> a
-}

data HsSigCtxt
  = TopSigCtxt NameSet       -- At top level, binding these names
                             -- See Note [Signatures for top level things]
  | LocalBindCtxt NameSet    -- In a local binding, binding these names
  | ClsDeclCtxt   Name       -- Class decl for this class
  | InstDeclCtxt  NameSet    -- Instance decl whose user-written method
                             -- bindings are for these methods
  | HsBootCtxt NameSet       -- Top level of a hs-boot file, binding these names
  | RoleAnnotCtxt NameSet    -- A role annotation, with the names of all types
                             -- in the group

instance Outputable HsSigCtxt where
    ppr :: HsSigCtxt -> SDoc
ppr (TopSigCtxt NameSet
ns) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TopSigCtxt" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameSet
ns
    ppr (LocalBindCtxt NameSet
ns) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"LocalBindCtxt" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameSet
ns
    ppr (ClsDeclCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ClsDeclCtxt" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n
    ppr (InstDeclCtxt NameSet
ns) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"InstDeclCtxt" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameSet
ns
    ppr (HsBootCtxt NameSet
ns) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"HsBootCtxt" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameSet
ns
    ppr (RoleAnnotCtxt NameSet
ns) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RoleAnnotCtxt" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr NameSet
ns

lookupSigOccRn :: HsSigCtxt
               -> Sig GhcPs
               -> LocatedA RdrName -> RnM (LocatedA Name)
lookupSigOccRn :: HsSigCtxt -> Sig GhcPs -> LocatedA RdrName -> RnM (LocatedA Name)
lookupSigOccRn HsSigCtxt
ctxt Sig GhcPs
sig = HsSigCtxt -> SDoc -> LocatedA RdrName -> RnM (LocatedA Name)
forall ann.
HsSigCtxt
-> SDoc
-> GenLocated (EpAnn ann) RdrName
-> RnM (GenLocated (EpAnn ann) Name)
lookupSigCtxtOccRn HsSigCtxt
ctxt (Sig GhcPs -> SDoc
forall (p :: Pass). IsPass p => Sig (GhcPass p) -> SDoc
hsSigDoc Sig GhcPs
sig)

lookupSigOccRnN :: HsSigCtxt
               -> Sig GhcPs
               -> LocatedN RdrName -> RnM (LocatedN Name)
lookupSigOccRnN :: HsSigCtxt -> Sig GhcPs -> LocatedN RdrName -> RnM (LocatedN Name)
lookupSigOccRnN HsSigCtxt
ctxt Sig GhcPs
sig = HsSigCtxt -> SDoc -> LocatedN RdrName -> RnM (LocatedN Name)
forall ann.
HsSigCtxt
-> SDoc
-> GenLocated (EpAnn ann) RdrName
-> RnM (GenLocated (EpAnn ann) Name)
lookupSigCtxtOccRn HsSigCtxt
ctxt (Sig GhcPs -> SDoc
forall (p :: Pass). IsPass p => Sig (GhcPass p) -> SDoc
hsSigDoc Sig GhcPs
sig)

-- | Lookup a name in relation to the names in a 'HsSigCtxt'
lookupSigCtxtOccRn :: HsSigCtxt
                   -> SDoc         -- ^ description of thing we're looking up,
                                   -- like "type family"
                   -> GenLocated (EpAnn ann) RdrName
                   -> RnM (GenLocated (EpAnn ann) Name)
lookupSigCtxtOccRn :: forall ann.
HsSigCtxt
-> SDoc
-> GenLocated (EpAnn ann) RdrName
-> RnM (GenLocated (EpAnn ann) Name)
lookupSigCtxtOccRn HsSigCtxt
ctxt SDoc
what
  = (RdrName -> RnM Name)
-> GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
forall a b ann.
(a -> TcM b)
-> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
wrapLocMA ((RdrName -> RnM Name)
 -> GenLocated (EpAnn ann) RdrName
 -> TcRn (GenLocated (EpAnn ann) Name))
-> (RdrName -> RnM Name)
-> GenLocated (EpAnn ann) RdrName
-> TcRn (GenLocated (EpAnn ann) Name)
forall a b. (a -> b) -> a -> b
$ \ RdrName
rdr_name ->
    do { let also_try_tycons :: Bool
also_try_tycons = Bool
False
       ; mb_names <- HsSigCtxt
-> SDoc
-> RdrName
-> Bool
-> NamespaceSpecifier
-> RnM (NonEmpty (Either NotInScopeError Name))
lookupBindGroupOcc HsSigCtxt
ctxt SDoc
what RdrName
rdr_name Bool
also_try_tycons NamespaceSpecifier
NoNamespaceSpecifier
       ; case mb_names of
           Right Name
name NE.:| [Either NotInScopeError Name]
rest ->
             do { Bool -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *).
(HasCallStack, Applicative m) =>
Bool -> SDoc -> m ()
massertPpr ([Either NotInScopeError Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Either NotInScopeError Name]
rest) (SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
                    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lookupSigCtxtOccRn" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (Either NotInScopeError Name -> SDoc)
-> [Either NotInScopeError Name] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ((NotInScopeError -> SDoc)
-> (Name -> SDoc) -> Either NotInScopeError Name -> SDoc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (RdrName -> NotInScopeError -> SDoc
pprScopeError RdrName
rdr_name) Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr) [Either NotInScopeError Name]
rest)
                ; Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name }
           Left NotInScopeError
err NE.:| [Either NotInScopeError Name]
_ ->
             do { TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (RdrName -> NotInScopeError -> TcRnMessage
mkTcRnNotInScope RdrName
rdr_name NotInScopeError
err)
                ; Name -> RnM Name
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name) }
       }

lookupBindGroupOcc :: HsSigCtxt
                   -> SDoc
                   -> RdrName -- ^ what to look up
                   -> Bool -- ^ if the 'RdrName' we are looking up is in
                           -- a value 'NameSpace', should we also look up
                           -- in the type constructor 'NameSpace'?
                   -> NamespaceSpecifier
                   -> RnM (NE.NonEmpty (Either NotInScopeError Name))
-- ^ Looks up the 'RdrName', expecting it to resolve to one of the
-- bound names currently in scope. If not, return an appropriate error message.
--
-- See Note [Looking up signature names].
lookupBindGroupOcc :: HsSigCtxt
-> SDoc
-> RdrName
-> Bool
-> NamespaceSpecifier
-> RnM (NonEmpty (Either NotInScopeError Name))
lookupBindGroupOcc HsSigCtxt
ctxt SDoc
what RdrName
rdr_name Bool
also_try_tycon_ns NamespaceSpecifier
ns_spec
  | Just Name
n <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr_name
  = do { mb_gre <- Name -> RnM (Either NotInScopeError GlobalRdrElt)
lookupExactOcc_either Name
n
       ; return $ case mb_gre of
          Left NotInScopeError
err  -> Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (Either NotInScopeError Name
 -> NonEmpty (Either NotInScopeError Name))
-> Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a b. (a -> b) -> a -> b
$ NotInScopeError -> Either NotInScopeError Name
forall a b. a -> Either a b
Left NotInScopeError
err
          Right GlobalRdrElt
gre -> NotInScopeError
-> GlobalRdrElt -> NonEmpty (Either NotInScopeError Name)
finish (Name -> NotInScopeError
NoExactName (Name -> NotInScopeError) -> Name -> NotInScopeError
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre) GlobalRdrElt
gre }
      -- Maybe we should check the side conditions
      -- but it's a pain, and Exact things only show
      -- up when you know what you are doing

  | Just (Module
rdr_mod, OccName
rdr_occ) <- RdrName -> Maybe (Module, OccName)
isOrig_maybe RdrName
rdr_name
  = do { Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (Either NotInScopeError Name
 -> NonEmpty (Either NotInScopeError Name))
-> (Name -> Either NotInScopeError Name)
-> Name
-> NonEmpty (Either NotInScopeError Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Either NotInScopeError Name
forall a b. b -> Either a b
Right (Name -> NonEmpty (Either NotInScopeError Name))
-> RnM Name -> RnM (NonEmpty (Either NotInScopeError Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Module -> OccName -> RnM Name
forall a b. Module -> OccName -> TcRnIf a b Name
lookupOrig Module
rdr_mod OccName
rdr_occ }

  | Bool
otherwise
  = case HsSigCtxt
ctxt of
      HsBootCtxt NameSet
ns    -> (Name -> Bool) -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_top (NameSet -> Name -> Bool
elem_name_set_with_namespace NameSet
ns)
      TopSigCtxt NameSet
ns    -> (Name -> Bool) -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_top (NameSet -> Name -> Bool
elem_name_set_with_namespace NameSet
ns)
      RoleAnnotCtxt NameSet
ns -> (Name -> Bool) -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_top (NameSet -> Name -> Bool
elem_name_set_with_namespace NameSet
ns)
      LocalBindCtxt NameSet
ns -> NameSet -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_group NameSet
ns
      ClsDeclCtxt  Name
cls -> Name -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_cls_op Name
cls
      InstDeclCtxt NameSet
ns  -> if (Name -> Bool) -> NameSet -> Bool
forall a. (a -> Bool) -> UniqSet a -> Bool
uniqSetAny Name -> Bool
isUnboundName NameSet
ns -- #16610
                          then NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (Either NotInScopeError Name)
 -> RnM (NonEmpty (Either NotInScopeError Name)))
-> NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a b. (a -> b) -> a -> b
$ Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (Either NotInScopeError Name
 -> NonEmpty (Either NotInScopeError Name))
-> Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a b. (a -> b) -> a -> b
$ Name -> Either NotInScopeError Name
forall a b. b -> Either a b
Right (Name -> Either NotInScopeError Name)
-> Name -> Either NotInScopeError Name
forall a b. (a -> b) -> a -> b
$ RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name
                          else (Name -> Bool) -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_top (NameSet -> Name -> Bool
elem_name_set_with_namespace NameSet
ns)
  where
    elem_name_set_with_namespace :: NameSet -> Name -> Bool
elem_name_set_with_namespace NameSet
ns Name
n = Name -> Bool
check_namespace Name
n Bool -> Bool -> Bool
&& (Name
n Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)

    check_namespace :: Name -> Bool
check_namespace = NamespaceSpecifier -> NameSpace -> Bool
coveredByNamespaceSpecifier NamespaceSpecifier
ns_spec (NameSpace -> Bool) -> (Name -> NameSpace) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> NameSpace
nameNameSpace

    namespace :: NameSpace
namespace = OccName -> NameSpace
occNameSpace OccName
occ
    occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
rdr_name
    relevant_gres :: WhichGREs GREInfo
relevant_gres =
      RelevantGREs
        { includeFieldSelectors :: FieldsOrSelectors
includeFieldSelectors = FieldsOrSelectors
WantBoth
        , lookupVariablesForFields :: Bool
lookupVariablesForFields = Bool
True
        , lookupTyConsAsWell :: Bool
lookupTyConsAsWell = Bool
also_try_tycon_ns }
    ok_gre :: GlobalRdrElt -> Bool
ok_gre = WhichGREs GREInfo -> NameSpace -> GlobalRdrElt -> Bool
greIsRelevant WhichGREs GREInfo
relevant_gres NameSpace
namespace

    finish :: NotInScopeError
-> GlobalRdrElt -> NonEmpty (Either NotInScopeError Name)
finish NotInScopeError
err GlobalRdrElt
gre
      | GlobalRdrElt -> Bool
ok_gre GlobalRdrElt
gre
      = Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (Name -> Either NotInScopeError Name
forall a b. b -> Either a b
Right (Name -> Either NotInScopeError Name)
-> Name -> Either NotInScopeError Name
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName GlobalRdrElt
gre)
      | Bool
otherwise
      = Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (NotInScopeError -> Either NotInScopeError Name
forall a b. a -> Either a b
Left NotInScopeError
err)

    lookup_cls_op :: Name -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_cls_op Name
cls
      = Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (Either NotInScopeError Name
 -> NonEmpty (Either NotInScopeError Name))
-> RnM (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DeprecationWarnings
-> Name -> SDoc -> RdrName -> RnM (Either NotInScopeError Name)
lookupSubBndrOcc DeprecationWarnings
AllDeprecationWarnings Name
cls SDoc
doc RdrName
rdr_name
      where
        doc :: SDoc
doc = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"method of class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
cls)

    lookup_top :: (Name -> Bool) -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_top Name -> Bool
keep_me
      = do { env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
           ; let occ = RdrName -> OccName
rdrNameOcc RdrName
rdr_name
                 all_gres = GlobalRdrEnv -> LookupGRE GREInfo -> [GlobalRdrElt]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnv
env (OccName -> WhichGREs GREInfo -> LookupGRE GREInfo
forall info. OccName -> WhichGREs info -> LookupGRE info
LookupOccName OccName
occ WhichGREs GREInfo
relevant_gres)
                 names_in_scope = -- If rdr_name lacks a binding, only
                                  -- recommend alternatives from relevant
                                  -- namespaces. See #17593.
                                  (GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName
                                ([GlobalRdrElt] -> [Name]) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> a -> b
$ (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter (GlobalRdrElt -> Bool
ok_gre (GlobalRdrElt -> Bool)
-> (GlobalRdrElt -> Bool) -> GlobalRdrElt -> Bool
forall (f :: * -> *). Applicative f => f Bool -> f Bool -> f Bool
<&&> GlobalRdrElt -> Bool
forall info. GlobalRdrEltX info -> Bool
isLocalGRE)
                                ([GlobalRdrElt] -> [GlobalRdrElt])
-> [GlobalRdrElt] -> [GlobalRdrElt]
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnv -> [GlobalRdrElt]
forall info. GlobalRdrEnvX info -> [GlobalRdrEltX info]
globalRdrEnvElts GlobalRdrEnv
env
                 candidates_msg = [Name] -> [GhcHint]
candidates [Name]
names_in_scope
           ; case filter (keep_me . greName) all_gres of
               [] | [GlobalRdrElt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
all_gres -> [GhcHint] -> RnM (NonEmpty (Either NotInScopeError Name))
bale_out_with [GhcHint]
candidates_msg
                  | Bool
otherwise     -> [GhcHint] -> RnM (NonEmpty (Either NotInScopeError Name))
bale_out_with [GhcHint]
local_msg
               (GlobalRdrElt
gre1:[GlobalRdrElt]
gres)        -> NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((GlobalRdrElt -> Either NotInScopeError Name)
-> NonEmpty GlobalRdrElt -> NonEmpty (Either NotInScopeError Name)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> Either NotInScopeError Name
forall a b. b -> Either a b
Right (Name -> Either NotInScopeError Name)
-> (GlobalRdrElt -> Name)
-> GlobalRdrElt
-> Either NotInScopeError Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Name
forall info. GlobalRdrEltX info -> Name
greName) (GlobalRdrElt
gre1 GlobalRdrElt -> [GlobalRdrElt] -> NonEmpty GlobalRdrElt
forall a. a -> [a] -> NonEmpty a
NE.:| [GlobalRdrElt]
gres)) }

    lookup_group :: NameSet -> RnM (NonEmpty (Either NotInScopeError Name))
lookup_group NameSet
bound_names  -- Look in the local envt (not top level)
      = do { mname <- RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
           ; env <- getLocalRdrEnv
           ; let candidates_msg = [Name] -> [GhcHint]
candidates ([Name] -> [GhcHint]) -> [Name] -> [GhcHint]
forall a b. (a -> b) -> a -> b
$ LocalRdrEnv -> [Name]
localRdrEnvElts LocalRdrEnv
env
           ; case mname of
               Just Name
n
                 | Name
n Name -> NameSet -> Bool
`elemNameSet` NameSet
bound_names -> NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (Either NotInScopeError Name)
 -> RnM (NonEmpty (Either NotInScopeError Name)))
-> NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a b. (a -> b) -> a -> b
$ Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (Either NotInScopeError Name
 -> NonEmpty (Either NotInScopeError Name))
-> Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a b. (a -> b) -> a -> b
$ Name -> Either NotInScopeError Name
forall a b. b -> Either a b
Right Name
n
                 | Bool
otherwise                   -> [GhcHint] -> RnM (NonEmpty (Either NotInScopeError Name))
bale_out_with [GhcHint]
local_msg
               Maybe Name
Nothing                         -> [GhcHint] -> RnM (NonEmpty (Either NotInScopeError Name))
bale_out_with [GhcHint]
candidates_msg }

    bale_out_with :: [GhcHint] -> RnM (NonEmpty (Either NotInScopeError Name))
bale_out_with [GhcHint]
hints = NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty (Either NotInScopeError Name)
 -> RnM (NonEmpty (Either NotInScopeError Name)))
-> NonEmpty (Either NotInScopeError Name)
-> RnM (NonEmpty (Either NotInScopeError Name))
forall a b. (a -> b) -> a -> b
$ Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a. a -> NonEmpty a
NE.singleton (Either NotInScopeError Name
 -> NonEmpty (Either NotInScopeError Name))
-> Either NotInScopeError Name
-> NonEmpty (Either NotInScopeError Name)
forall a b. (a -> b) -> a -> b
$ NotInScopeError -> Either NotInScopeError Name
forall a b. a -> Either a b
Left (NotInScopeError -> Either NotInScopeError Name)
-> NotInScopeError -> Either NotInScopeError Name
forall a b. (a -> b) -> a -> b
$ SDoc -> [GhcHint] -> NotInScopeError
MissingBinding SDoc
what [GhcHint]
hints

    local_msg :: [GhcHint]
local_msg = [SDoc -> RdrName -> GhcHint
SuggestMoveToDeclarationSite SDoc
what RdrName
rdr_name]

    -- Identify all similar names and produce a message listing them
    candidates :: [Name] -> [GhcHint]
    candidates :: [Name] -> [GhcHint]
candidates [Name]
names_in_scope
      | (SimilarName
nm : [SimilarName]
nms) <- (Name -> SimilarName) -> [Name] -> [SimilarName]
forall a b. (a -> b) -> [a] -> [b]
map Name -> SimilarName
SimilarName [Name]
similar_names
      = [RdrName -> NonEmpty SimilarName -> GhcHint
SuggestSimilarNames RdrName
rdr_name (SimilarName
nm SimilarName -> [SimilarName] -> NonEmpty SimilarName
forall a. a -> [a] -> NonEmpty a
NE.:| [SimilarName]
nms)]
      | Bool
otherwise
      = []
      where
        similar_names :: [Name]
similar_names
          = String -> [(String, Name)] -> [Name]
forall a. String -> [(String, a)] -> [a]
fuzzyLookup (FastString -> String
unpackFS (FastString -> String) -> FastString -> String
forall a b. (a -> b) -> a -> b
$ OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
          ([(String, Name)] -> [Name]) -> [(String, Name)] -> [Name]
forall a b. (a -> b) -> a -> b
$ (Name -> (String, Name)) -> [Name] -> [(String, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
x -> ((FastString -> String
unpackFS (FastString -> String) -> FastString -> String
forall a b. (a -> b) -> a -> b
$ OccName -> FastString
occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
x), Name
x))
                [Name]
names_in_scope


---------------
lookupLocalTcNames :: HsSigCtxt -> SDoc -> NamespaceSpecifier -> RdrName -> RnM [(RdrName, Name)]
-- GHC extension: look up both the tycon and data con or variable.
-- Used for top-level fixity signatures and deprecations.
-- Complain if neither is in scope.
-- See Note [Fixity signature lookup]
lookupLocalTcNames :: HsSigCtxt
-> SDoc -> NamespaceSpecifier -> RdrName -> RnM [(RdrName, Name)]
lookupLocalTcNames HsSigCtxt
ctxt SDoc
what NamespaceSpecifier
ns_spec RdrName
rdr
  = do { this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
       ; let also_try_tycon_ns = Bool
True
       ; nms_eithers <- fmap (guard_builtin_syntax this_mod rdr) <$>
                        lookupBindGroupOcc ctxt what rdr also_try_tycon_ns ns_spec
       ; let (errs, names) = partitionEithers (NE.toList nms_eithers)
       ; when (null names) $
          addErr (head errs) -- Bleat about one only
       ; return names }
  where
    -- Guard against the built-in syntax (ex: `infixl 6 :`), see #15233
    guard_builtin_syntax :: Module
-> RdrName
-> Either NotInScopeError Name
-> Either TcRnMessage (RdrName, Name)
guard_builtin_syntax Module
this_mod RdrName
rdr (Right Name
name)
      | Just Name
_ <- OccName -> Maybe Name
isBuiltInOcc_maybe (RdrName -> OccName
forall name. HasOccName name => name -> OccName
occName RdrName
rdr)
      , Module
this_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name
      = TcRnMessage -> Either TcRnMessage (RdrName, Name)
forall a b. a -> Either a b
Left (TcRnMessage -> Either TcRnMessage (RdrName, Name))
-> TcRnMessage -> Either TcRnMessage (RdrName, Name)
forall a b. (a -> b) -> a -> b
$ SDoc -> RdrName -> TcRnMessage
TcRnIllegalBuiltinSyntax SDoc
what RdrName
rdr
      | Bool
otherwise
      = (RdrName, Name) -> Either TcRnMessage (RdrName, Name)
forall a b. b -> Either a b
Right (RdrName
rdr, Name
name)
    guard_builtin_syntax Module
_ RdrName
_ (Left NotInScopeError
err)
      = TcRnMessage -> Either TcRnMessage (RdrName, Name)
forall a b. a -> Either a b
Left (TcRnMessage -> Either TcRnMessage (RdrName, Name))
-> TcRnMessage -> Either TcRnMessage (RdrName, Name)
forall a b. (a -> b) -> a -> b
$ RdrName -> NotInScopeError -> TcRnMessage
mkTcRnNotInScope RdrName
rdr NotInScopeError
err

dataTcOccs :: RdrName -> [RdrName]
-- Return both the given name and the same name promoted to the TcClsName
-- namespace.  This is useful when we aren't sure which we are looking at.
-- See also Note [dataTcOccs and Exact Names]
dataTcOccs :: RdrName -> [RdrName]
dataTcOccs RdrName
rdr_name
  | OccName -> Bool
isDataOcc OccName
occ Bool -> Bool -> Bool
|| OccName -> Bool
isVarOcc OccName
occ
  = [RdrName
rdr_name, RdrName
rdr_name_tc]
  | Bool
otherwise
  = [RdrName
rdr_name]
  where
    occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
rdr_name
    rdr_name_tc :: RdrName
rdr_name_tc = RdrName -> NameSpace -> RdrName
setRdrNameSpace RdrName
rdr_name NameSpace
tcName

{- Note [dataTcOccs and Exact Names]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exact RdrNames can occur in code generated by Template Haskell, and generally
those references are, well, exact. However, the TH `Name` type isn't expressive
enough to always track the correct namespace information, so we sometimes get
the right Unique but wrong namespace. Thus, we still have to do the double-lookup
for Exact RdrNames.

There is also an awkward situation for built-in syntax. Example in GHCi
   :info []
This parses as the Exact RdrName for nilDataCon, but we also want
the list type constructor.

Note that setRdrNameSpace on an Exact name requires the Name to be External,
which it always is for built in syntax.
-}

{-
************************************************************************
*                                                                      *
                        Rebindable names
        Dealing with rebindable syntax is driven by the
        Opt_RebindableSyntax dynamic flag.

        In "deriving" code we don't want to use rebindable syntax
        so we switch off the flag locally

*                                                                      *
************************************************************************

Haskell 98 says that when you say "3" you get the "fromInteger" from the
Standard Prelude, regardless of what is in scope.   However, to experiment
with having a language that is less coupled to the standard prelude, we're
trying a non-standard extension that instead gives you whatever "Prelude.fromInteger"
happens to be in scope.  Then you can
        import Prelude ()
        import MyPrelude as Prelude
to get the desired effect.

At the moment this just happens for
  * fromInteger, fromRational on literals (in expressions and patterns)
  * negate (in expressions)
  * minus  (arising from n+k patterns)
  * "do" notation

We store the relevant Name in the HsSyn tree, in
  * HsIntegral/HsFractional/HsIsString
  * NegApp
  * NPlusKPat
  * HsDo
respectively.  Initially, we just store the "standard" name (GHC.Builtin.Names.fromIntegralName,
fromRationalName etc), but the renamer changes this to the appropriate user
name if Opt_NoImplicitPrelude is on.  That is what lookupSyntax does.

We treat the original (standard) names as free-vars too, because the type checker
checks the type of the user thing against the type of the standard thing.
-}

lookupIfThenElse :: RnM (Maybe Name)
-- Looks up "ifThenElse" if rebindable syntax is on
lookupIfThenElse :: RnM (Maybe Name)
lookupIfThenElse
  = do { rebindable_on <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
       ; if not rebindable_on
         then return Nothing
         else do { ite <- lookupOccRnNone (mkVarUnqual (fsLit "ifThenElse"))
                 ; return (Just ite) } }

lookupSyntaxName :: Name                 -- ^ The standard name
                 -> RnM (Name, FreeVars) -- ^ Possibly a non-standard name
-- Lookup a Name that may be subject to Rebindable Syntax (RS).
--
-- - When RS is off, just return the supplied (standard) Name
--
-- - When RS is on, look up the OccName of the supplied Name; return
--   what we find, or the supplied Name if there is nothing in scope
lookupSyntaxName :: Name -> RnM (Name, NameSet)
lookupSyntaxName Name
std_name
  = do { rebind <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
       ; if not rebind
         then return (std_name, emptyFVs)
         else do { nm <- lookupOccRnNone (mkRdrUnqual (nameOccName std_name))
                 ; return (nm, unitFV nm) } }

lookupSyntaxExpr :: Name                          -- ^ The standard name
                 -> RnM (HsExpr GhcRn, FreeVars)  -- ^ Possibly a non-standard name
lookupSyntaxExpr :: Name -> RnM (HsExpr GhcRn, NameSet)
lookupSyntaxExpr Name
std_name
  = do { (name, fvs) <- Name -> RnM (Name, NameSet)
lookupSyntaxName Name
std_name
       ; return (nl_HsVar name, fvs) }

lookupSyntax :: Name                             -- The standard name
             -> RnM (SyntaxExpr GhcRn, FreeVars) -- Possibly a non-standard
                                                 -- name
lookupSyntax :: Name -> RnM (SyntaxExpr GhcRn, NameSet)
lookupSyntax Name
std_name
  = do { (expr, fvs) <- Name -> RnM (HsExpr GhcRn, NameSet)
lookupSyntaxExpr Name
std_name
       ; return (mkSyntaxExpr expr, fvs) }

lookupSyntaxNames :: [Name]                         -- Standard names
     -> RnM ([HsExpr GhcRn], FreeVars) -- See comments with HsExpr.ReboundNames
   -- this works with CmdTop, which wants HsExprs, not SyntaxExprs
lookupSyntaxNames :: [Name] -> RnM ([HsExpr GhcRn], NameSet)
lookupSyntaxNames [Name]
std_names
  = do { rebindable_on <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
       ; if not rebindable_on then
             return (map (HsVar noExtField . noLocA) std_names, emptyFVs)
        else
          do { usr_names <-
                 mapM (lookupOccRnNone . mkRdrUnqual . nameOccName) std_names
             ; return (map (HsVar noExtField . noLocA) usr_names, mkFVs usr_names) } }


{-
Note [QualifiedDo]
~~~~~~~~~~~~~~~~~~
QualifiedDo is implemented using the same placeholders for operation names in
the AST that were devised for RebindableSyntax. Whenever the renamer checks
which names to use for do syntax, it first checks if the do block is qualified
(e.g. M.do { stmts }), in which case it searches for qualified names. If the
qualified names are not in scope, an error is produced. If the do block is not
qualified, the renamer does the usual search of the names which considers
whether RebindableSyntax is enabled or not. Dealing with QualifiedDo is driven
by the Opt_QualifiedDo dynamic flag.
-}

-- Lookup operations for a qualified do. If the context is not a qualified
-- do, then use lookupSyntaxExpr. See Note [QualifiedDo].
lookupQualifiedDoExpr :: HsStmtContext fn -> Name -> RnM (HsExpr GhcRn, FreeVars)
lookupQualifiedDoExpr :: forall fn. HsStmtContext fn -> Name -> RnM (HsExpr GhcRn, NameSet)
lookupQualifiedDoExpr HsStmtContext fn
ctxt Name
std_name
  = (Name -> HsExpr GhcRn)
-> (Name, NameSet) -> (HsExpr GhcRn, NameSet)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first IdP GhcRn -> HsExpr GhcRn
Name -> HsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> HsExpr (GhcPass p)
nl_HsVar ((Name, NameSet) -> (HsExpr GhcRn, NameSet))
-> RnM (Name, NameSet) -> RnM (HsExpr GhcRn, NameSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsStmtContext fn -> Name -> RnM (Name, NameSet)
forall fn. HsStmtContext fn -> Name -> RnM (Name, NameSet)
lookupQualifiedDoName HsStmtContext fn
ctxt Name
std_name

-- Like lookupQualifiedDoExpr but for producing SyntaxExpr.
-- See Note [QualifiedDo].
lookupQualifiedDo :: HsStmtContext fn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDo :: forall fn.
HsStmtContext fn -> Name -> RnM (SyntaxExpr GhcRn, NameSet)
lookupQualifiedDo HsStmtContext fn
ctxt Name
std_name
  = (HsExpr GhcRn -> SyntaxExprRn)
-> (HsExpr GhcRn, NameSet) -> (SyntaxExprRn, NameSet)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first HsExpr GhcRn -> SyntaxExprRn
mkSyntaxExpr ((HsExpr GhcRn, NameSet) -> (SyntaxExprRn, NameSet))
-> RnM (HsExpr GhcRn, NameSet)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, NameSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsStmtContext fn -> Name -> RnM (HsExpr GhcRn, NameSet)
forall fn. HsStmtContext fn -> Name -> RnM (HsExpr GhcRn, NameSet)
lookupQualifiedDoExpr HsStmtContext fn
ctxt Name
std_name

lookupNameWithQualifier :: Name -> ModuleName -> RnM (Name, FreeVars)
lookupNameWithQualifier :: Name -> ModuleName -> RnM (Name, NameSet)
lookupNameWithQualifier Name
std_name ModuleName
modName
  = do { qname <- RdrName -> RnM Name
lookupOccRnNone (ModuleName -> OccName -> RdrName
mkRdrQual ModuleName
modName (Name -> OccName
nameOccName Name
std_name))
       ; return (qname, unitFV qname) }

-- See Note [QualifiedDo].
lookupQualifiedDoName :: HsStmtContext fn -> Name -> RnM (Name, FreeVars)
lookupQualifiedDoName :: forall fn. HsStmtContext fn -> Name -> RnM (Name, NameSet)
lookupQualifiedDoName HsStmtContext fn
ctxt Name
std_name
  = case HsStmtContext fn -> Maybe ModuleName
forall fn. HsStmtContext fn -> Maybe ModuleName
qualifiedDoModuleName_maybe HsStmtContext fn
ctxt of
      Maybe ModuleName
Nothing -> Name -> RnM (Name, NameSet)
lookupSyntaxName Name
std_name
      Just ModuleName
modName -> Name -> ModuleName -> RnM (Name, NameSet)
lookupNameWithQualifier Name
std_name ModuleName
modName

--------------------------------------------------------------------------------
-- Helper functions for 'isIrrefutableHsPat'.
--
-- (Defined here to avoid import cycles.)

-- | Check irrefutability of a 'ConLike' in a 'ConPat GhcRn'
-- (the 'Irref-ConLike' condition of Note [Irrefutability of ConPat]).
irrefutableConLikeRn :: HasDebugCallStack
                     => HscEnv
                     -> GlobalRdrEnv
                     -> CompleteMatches -- ^ in-scope COMPLETE pragmas
                     -> Name -- ^ the 'Name' of the 'ConLike'
                     -> Bool
irrefutableConLikeRn :: HasDebugCallStack =>
HscEnv -> GlobalRdrEnv -> CompleteMatches -> Name -> Bool
irrefutableConLikeRn HscEnv
hsc_env GlobalRdrEnv
rdr_env CompleteMatches
comps Name
con_nm
  | Just GlobalRdrElt
gre <- GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
rdr_env Name
con_nm
  = GREInfo -> Bool
go (GREInfo -> Bool) -> GREInfo -> Bool
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> GREInfo
greInfo GlobalRdrElt
gre
  | Bool
otherwise
  = GREInfo -> Bool
go (GREInfo -> Bool) -> GREInfo -> Bool
forall a b. (a -> b) -> a -> b
$ HasDebugCallStack => HscEnv -> Name -> GREInfo
HscEnv -> Name -> GREInfo
lookupGREInfo HscEnv
hsc_env Name
con_nm
  where
    go :: GREInfo -> Bool
go ( IAmConLike ConInfo
conInfo ) =
      case ConInfo -> ConLikeInfo
conLikeInfo ConInfo
conInfo of
        ConIsData { conLikeDataCons :: ConLikeInfo -> [Name]
conLikeDataCons = [Name]
tc_cons } ->
          [Name] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length [Name]
tc_cons Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
1
        ConLikeInfo
ConIsPatSyn ->
          Name -> CompleteMatches -> Bool
forall con. NamedThing con => Name -> [CompleteMatchX con] -> Bool
in_single_complete_match Name
con_nm CompleteMatches
comps
    go GREInfo
_ = Bool
False

-- | Check irrefutability of the 'ConLike' in a 'ConPat GhcTc'
-- (the 'Irref-ConLike' condition of Note [Irrefutability of ConPat]),
-- given all in-scope COMPLETE pragmas ('CompleteMatches' in the typechecker,
-- 'DsCompleteMatches' in the desugarer).
irrefutableConLikeTc :: NamedThing con
                     => [CompleteMatchX con]
                         -- ^ in-scope COMPLETE pragmas
                     -> ConLike
                     -> Bool
irrefutableConLikeTc :: forall con.
NamedThing con =>
[CompleteMatchX con] -> ConLike -> Bool
irrefutableConLikeTc [CompleteMatchX con]
comps ConLike
con =
  case ConLike
con of
    RealDataCon DataCon
dc -> [DataCon] -> Arity
forall a. [a] -> Arity
forall (t :: * -> *) a. Foldable t => t a -> Arity
length (TyCon -> [DataCon]
tyConDataCons (DataCon -> TyCon
dataConTyCon DataCon
dc)) Arity -> Arity -> Bool
forall a. Eq a => a -> a -> Bool
== Arity
1
    PatSynCon {}   -> Name -> [CompleteMatchX con] -> Bool
forall con. NamedThing con => Name -> [CompleteMatchX con] -> Bool
in_single_complete_match Name
con_nm [CompleteMatchX con]
comps
  where
    con_nm :: Name
con_nm = ConLike -> Name
conLikeName ConLike
con

-- | Internal helper function: check whether a 'ConLike' is the single member
-- of a COMPLETE set without a result 'TyCon'.
--
-- Why 'without a result TyCon'? See Wrinkle [Irrefutability and COMPLETE pragma result TyCons]
-- in Note [Irrefutability of ConPat].
in_single_complete_match :: NamedThing con => Name -> [CompleteMatchX con] -> Bool
in_single_complete_match :: forall con. NamedThing con => Name -> [CompleteMatchX con] -> Bool
in_single_complete_match Name
con_nm = [CompleteMatchX con] -> Bool
go
  where
    go :: [CompleteMatchX con] -> Bool
go [] = Bool
False
    go (CompleteMatchX con
comp:[CompleteMatchX con]
comps)
      | Maybe Name
Nothing <- CompleteMatchX con -> Maybe Name
forall con. CompleteMatchX con -> Maybe Name
cmResultTyCon CompleteMatchX con
comp
        -- conservative, as we don't have enough info to compute
        -- 'completeMatchAppliesAtType'
      , let comp_nms :: UniqDSet Name
comp_nms = (con -> Name) -> UniqDSet con -> UniqDSet Name
forall b a. Uniquable b => (a -> b) -> UniqDSet a -> UniqDSet b
mapUniqDSet con -> Name
forall a. NamedThing a => a -> Name
getName (UniqDSet con -> UniqDSet Name) -> UniqDSet con -> UniqDSet Name
forall a b. (a -> b) -> a -> b
$ CompleteMatchX con -> UniqDSet con
forall con. CompleteMatchX con -> UniqDSet con
cmConLikes CompleteMatchX con
comp
      , UniqDSet Name
comp_nms UniqDSet Name -> UniqDSet Name -> Bool
forall a. Eq a => a -> a -> Bool
== [Name] -> UniqDSet Name
forall a. Uniquable a => [a] -> UniqDSet a
mkUniqDSet [Name
con_nm]
      = Bool
True
      | Bool
otherwise
      = [CompleteMatchX con] -> Bool
go [CompleteMatchX con]
comps

--------------------------------------------------------------------------------