{-# LANGUAGE CPP, MultiWayIf, NamedFieldPuns #-}
module RnEnv (
        newTopSrcBinder,
        lookupLocatedTopBndrRn, lookupTopBndrRn,
        lookupLocatedOccRn, lookupOccRn, lookupOccRn_maybe,
        lookupLocalOccRn_maybe, lookupInfoOccRn,
        lookupLocalOccThLvl_maybe, lookupLocalOccRn,
        lookupTypeOccRn,
        lookupGlobalOccRn, lookupGlobalOccRn_maybe,
        lookupOccRn_overloaded, lookupGlobalOccRn_overloaded, lookupExactOcc,
        ChildLookupResult(..),
        lookupSubBndrOcc_helper,
        combineChildLookupResult, 
        HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn,
        lookupSigCtxtOccRn,
        lookupInstDeclBndr, lookupRecFieldOcc, lookupFamInstName,
        lookupConstructorFields,
        lookupGreAvailRn,
        
        lookupSyntaxName, lookupSyntaxName', lookupSyntaxNames,
        lookupIfThenElse,
        
        addUsedGRE, addUsedGREs, addUsedDataCons,
        dataTcOccs, 
    ) where
#include "HsVersions.h"
import GhcPrelude
import LoadIface        ( loadInterfaceForName, loadSrcInterface_maybe )
import IfaceEnv
import HsSyn
import RdrName
import HscTypes
import TcEnv
import TcRnMonad
import RdrHsSyn         ( filterCTuple, setRdrNameSpace )
import TysWiredIn
import Name
import NameSet
import NameEnv
import Avail
import Module
import ConLike
import DataCon
import TyCon
import ErrUtils         ( MsgDoc )
import PrelNames        ( rOOT_MAIN )
import BasicTypes       ( pprWarningTxtForMsg, TopLevelFlag(..))
import SrcLoc
import Outputable
import Util
import Maybes
import DynFlags
import FastString
import Control.Monad
import ListSetOps       ( minusList )
import qualified GHC.LanguageExtensions as LangExt
import RnUnbound
import RnUtils
import qualified Data.Semigroup as Semi
import Data.Either      ( partitionEithers )
import Data.List        (find)
newTopSrcBinder :: Located RdrName -> RnM Name
newTopSrcBinder :: Located RdrName -> RnM Name
newTopSrcBinder (L loc :: SrcSpan
loc rdr_name :: RdrName
rdr_name)
  | Just name :: Name
name <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr_name
  =     
        
        
        
        
        
        
        
        
    if Name -> Bool
isExternalName Name
name then
      do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
         ; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Module
this_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name)
                  (SrcSpan -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt SrcSpan
loc (RdrName -> MsgDoc
badOrigBinding RdrName
rdr_name))
         ; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name }
    else   
      do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
         ; Module -> Name -> RnM Name
forall m n. Module -> Name -> TcRnIf m n Name
externaliseName Module
this_mod Name
name }
  | Just (rdr_mod :: Module
rdr_mod, rdr_occ :: OccName
rdr_occ) <- RdrName -> Maybe (Module, OccName)
isOrig_maybe RdrName
rdr_name
  = do  { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
        ; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Module
rdr_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
this_mod Bool -> Bool -> Bool
|| Module
rdr_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
rOOT_MAIN)
                 (SrcSpan -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt SrcSpan
loc (RdrName -> MsgDoc
badOrigBinding RdrName
rdr_name))
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        
        ; Module -> OccName -> SrcSpan -> RnM Name
forall a b. Module -> OccName -> SrcSpan -> TcRnIf a b Name
newGlobalBinder Module
rdr_mod OccName
rdr_occ SrcSpan
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 -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErrAt SrcSpan
loc (RdrName -> MsgDoc
badQualBndrErr RdrName
rdr_name))
                
                
        ; ThStage
stage <- TcM ThStage
getStage
        ; if ThStage -> Bool
isBrackStage ThStage
stage then
                
                
             do { Unique
uniq <- TcRnIf TcGblEnv TcLclEnv Unique
forall gbl lcl. TcRnIf gbl lcl Unique
newUnique
                ; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Unique -> OccName -> SrcSpan -> Name
mkInternalName Unique
uniq (RdrName -> OccName
rdrNameOcc RdrName
rdr_name) SrcSpan
loc) }
          else
             do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
                ; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn "newTopSrcBinder" (Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
this_mod MsgDoc -> MsgDoc -> MsgDoc
$$ RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name MsgDoc -> MsgDoc -> MsgDoc
$$ SrcSpan -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr SrcSpan
loc)
                ; Module -> OccName -> SrcSpan -> RnM Name
forall a b. Module -> OccName -> SrcSpan -> TcRnIf a b Name
newGlobalBinder Module
this_mod (RdrName -> OccName
rdrNameOcc RdrName
rdr_name) SrcSpan
loc }
        }
lookupTopBndrRn :: RdrName -> RnM Name
lookupTopBndrRn :: RdrName -> RnM Name
lookupTopBndrRn n :: RdrName
n = do Maybe Name
nopt <- RdrName -> RnM (Maybe Name)
lookupTopBndrRn_maybe RdrName
n
                       case Maybe Name
nopt of
                         Just n' :: Name
n' -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n'
                         Nothing -> do String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn "lookupTopBndrRn fail" (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
n)
                                       WhereLooking -> RdrName -> RnM Name
unboundName WhereLooking
WL_LocalTop RdrName
n
lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopBndrRn = (SrcSpanLess (Located RdrName) -> TcM (SrcSpanLess (Located Name)))
-> Located RdrName -> RnM (Located Name)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM SrcSpanLess (Located RdrName) -> TcM (SrcSpanLess (Located Name))
RdrName -> RnM Name
lookupTopBndrRn
lookupTopBndrRn_maybe :: RdrName -> RnM (Maybe Name)
lookupTopBndrRn_maybe :: RdrName -> RnM (Maybe Name)
lookupTopBndrRn_maybe rdr_name :: RdrName
rdr_name =
  RdrName
-> (Name -> Maybe Name) -> RnM (Maybe Name) -> RnM (Maybe Name)
forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name Name -> Maybe Name
forall a. a -> Maybe a
Just (RnM (Maybe Name) -> RnM (Maybe Name))
-> RnM (Maybe Name) -> RnM (Maybe Name)
forall a b. (a -> b) -> a -> b
$
    do  {  
           
          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 { Bool
op_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.TypeOperators
                   ; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
op_ok (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (RdrName -> MsgDoc
opDeclErr RdrName
rdr_name)) })
        ; GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
        ; case (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
isLocalGRE (RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName RdrName
rdr_name GlobalRdrEnv
env) of
            [gre :: GlobalRdrElt
gre] -> Maybe Name -> RnM (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Maybe Name
forall a. a -> Maybe a
Just (GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre))
            _     -> Maybe Name -> RnM (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
forall a. Maybe a
Nothing  
    }
lookupExactOcc :: Name -> RnM Name
lookupExactOcc :: Name -> RnM Name
lookupExactOcc name :: Name
name
  = do { Either MsgDoc Name
result <- Name -> RnM (Either MsgDoc Name)
lookupExactOcc_either Name
name
       ; case Either MsgDoc Name
result of
           Left err :: MsgDoc
err -> do { MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr MsgDoc
err
                          ; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name }
           Right name' :: Name
name' -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name' }
lookupExactOcc_either :: Name -> RnM (Either MsgDoc Name)
lookupExactOcc_either :: Name -> RnM (Either MsgDoc Name)
lookupExactOcc_either name :: Name
name
  | Just thing :: TyThing
thing <- Name -> Maybe TyThing
wiredInNameTyThing_maybe Name
name
  , Just tycon :: TyCon
tycon <- case TyThing
thing of
                    ATyCon tc :: TyCon
tc                 -> TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just TyCon
tc
                    AConLike (RealDataCon dc :: DataCon
dc) -> TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just (DataCon -> TyCon
dataConTyCon DataCon
dc)
                    _                         -> Maybe TyCon
forall a. Maybe a
Nothing
  , TyCon -> Bool
isTupleTyCon TyCon
tycon
  = do { Int -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkTupSize (TyCon -> Int
tyConArity TyCon
tycon)
       ; Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right Name
name) }
  | Name -> Bool
isExternalName Name
name
  = Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right Name
name)
  | Bool
otherwise
  = do { GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
       ; let 
             main_occ :: OccName
main_occ =  Name -> OccName
nameOccName Name
name
             demoted_occs :: [OccName]
demoted_occs = case OccName -> Maybe OccName
demoteOccName OccName
main_occ of
                              Just occ :: OccName
occ -> [OccName
occ]
                              Nothing  -> []
             gres :: [GlobalRdrElt]
gres = [ GlobalRdrElt
gre | OccName
occ <- OccName
main_occ OccName -> [OccName] -> [OccName]
forall a. a -> [a] -> [a]
: [OccName]
demoted_occs
                          , GlobalRdrElt
gre <- GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
env OccName
occ
                          , GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name ]
       ; case [GlobalRdrElt]
gres of
           [gre :: GlobalRdrElt
gre] -> Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right (GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre))
           []    -> 
                    do { LocalRdrEnv
lcl_env <- RnM LocalRdrEnv
getLocalRdrEnv
                       ; if Name
name Name -> LocalRdrEnv -> Bool
`inLocalRdrEnvScope` LocalRdrEnv
lcl_env
                         then Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right Name
name)
                         else
                         do { TcRef NameSet
th_topnames_var <- (TcGblEnv -> TcRef NameSet)
-> IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
-> IOEnv (Env TcGblEnv TcLclEnv) (TcRef NameSet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TcGblEnv -> TcRef NameSet
tcg_th_topnames IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
                            ; NameSet
th_topnames <- TcRef NameSet -> TcRnIf TcGblEnv TcLclEnv NameSet
forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
readTcRef TcRef NameSet
th_topnames_var
                            ; if Name
name Name -> NameSet -> Bool
`elemNameSet` NameSet
th_topnames
                              then Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right Name
name)
                              else Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> Either MsgDoc Name
forall a b. a -> Either a b
Left MsgDoc
exact_nm_err)
                            }
                       }
           gres :: [GlobalRdrElt]
gres -> Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> Either MsgDoc Name
forall a b. a -> Either a b
Left ([GlobalRdrElt] -> MsgDoc
sameNameErr [GlobalRdrElt]
gres))   
       }
  where
    exact_nm_err :: MsgDoc
exact_nm_err = MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text "The exact Name" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
name) MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit "is not in scope"))
                      2 ([MsgDoc] -> MsgDoc
vcat [ String -> MsgDoc
text "Probable cause: you used a unique Template Haskell name (NameU), "
                              , String -> MsgDoc
text "perhaps via newName, but did not bind it"
                              , String -> MsgDoc
text "If that's it, then -ddump-splices might be useful" ])
sameNameErr :: [GlobalRdrElt] -> MsgDoc
sameNameErr :: [GlobalRdrElt] -> MsgDoc
sameNameErr [] = String -> MsgDoc
forall a. String -> a
panic "addSameNameErr: empty list"
sameNameErr gres :: [GlobalRdrElt]
gres@(_ : _)
  = MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text "Same exact name in multiple name-spaces:")
       2 ([MsgDoc] -> MsgDoc
vcat ((Name -> MsgDoc) -> [Name] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> MsgDoc
pp_one [Name]
sorted_names) MsgDoc -> MsgDoc -> MsgDoc
$$ MsgDoc
th_hint)
  where
    sorted_names :: [Name]
sorted_names = (Name -> SrcLoc) -> [Name] -> [Name]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith Name -> SrcLoc
nameSrcLoc ((GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
gre_name [GlobalRdrElt]
gres)
    pp_one :: Name -> MsgDoc
pp_one name :: Name
name
      = MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (NameSpace -> MsgDoc
pprNameSpace (OccName -> NameSpace
occNameSpace (Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
name))
              MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
name) MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
comma)
           2 (String -> MsgDoc
text "declared at:" MsgDoc -> MsgDoc -> MsgDoc
<+> SrcLoc -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Name -> SrcLoc
nameSrcLoc Name
name))
    th_hint :: MsgDoc
th_hint = [MsgDoc] -> MsgDoc
vcat [ String -> MsgDoc
text "Probable cause: you bound a unique Template Haskell name (NameU),"
                   , String -> MsgDoc
text "perhaps via newName, in different name-spaces."
                   , String -> MsgDoc
text "If that's it, then -ddump-splices might be useful" ]
lookupInstDeclBndr :: Name -> SDoc -> RdrName -> RnM Name
lookupInstDeclBndr :: Name -> MsgDoc -> RdrName -> RnM Name
lookupInstDeclBndr cls :: Name
cls what :: MsgDoc
what rdr :: 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)
              (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (RdrName -> MsgDoc
badQualBndrErr RdrName
rdr))
                
                
                
       ; Either MsgDoc Name
mb_name <- Bool -> Name -> MsgDoc -> RdrName -> RnM (Either MsgDoc Name)
lookupSubBndrOcc
                          Bool
False 
                                
                                
                                
                          Name
cls MsgDoc
doc RdrName
rdr
       ; case Either MsgDoc Name
mb_name of
           Left err :: MsgDoc
err -> do { MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr MsgDoc
err; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr) }
           Right nm :: Name
nm -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
nm }
  where
    doc :: MsgDoc
doc = MsgDoc
what MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text "of class" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
cls)
lookupFamInstName :: Maybe Name -> Located RdrName
                  -> RnM (Located Name)
lookupFamInstName :: Maybe Name -> Located RdrName -> RnM (Located Name)
lookupFamInstName (Just cls :: Name
cls) tc_rdr :: Located RdrName
tc_rdr  
  = (SrcSpanLess (Located RdrName) -> TcM (SrcSpanLess (Located Name)))
-> Located RdrName -> RnM (Located Name)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM (Name -> MsgDoc -> RdrName -> RnM Name
lookupInstDeclBndr Name
cls (String -> MsgDoc
text "associated type")) Located RdrName
tc_rdr
lookupFamInstName Nothing tc_rdr :: Located RdrName
tc_rdr     
  = Located RdrName -> RnM (Located Name)
lookupLocatedOccRn Located RdrName
tc_rdr
lookupConstructorFields :: Name -> RnM [FieldLabel]
lookupConstructorFields :: Name -> RnM [FieldLabel]
lookupConstructorFields con_name :: Name
con_name
  = do  { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
        ; if Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod Name
con_name then
          do { RecFieldEnv
field_env <- TcRn RecFieldEnv
getRecFieldEnv
             ; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc "lookupCF" (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
con_name MsgDoc -> MsgDoc -> MsgDoc
$$ Maybe [FieldLabel] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (RecFieldEnv -> Name -> Maybe [FieldLabel]
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv RecFieldEnv
field_env Name
con_name) MsgDoc -> MsgDoc -> MsgDoc
$$ RecFieldEnv -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RecFieldEnv
field_env)
             ; [FieldLabel] -> RnM [FieldLabel]
forall (m :: * -> *) a. Monad m => a -> m a
return (RecFieldEnv -> Name -> Maybe [FieldLabel]
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv RecFieldEnv
field_env Name
con_name Maybe [FieldLabel] -> [FieldLabel] -> [FieldLabel]
forall a. Maybe a -> a -> a
`orElse` []) }
          else
          do { ConLike
con <- Name -> TcM ConLike
tcLookupConLike Name
con_name
             ; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceTc "lookupCF 2" (ConLike -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ConLike
con)
             ; [FieldLabel] -> RnM [FieldLabel]
forall (m :: * -> *) a. Monad m => a -> m a
return (ConLike -> [FieldLabel]
conLikeFieldLabels ConLike
con) } }
lookupExactOrOrig :: RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig :: RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig rdr_name :: RdrName
rdr_name res :: Name -> r
res k :: RnM r
k
  | Just n :: Name
n <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr_name   
  = Name -> r
res (Name -> r) -> RnM Name -> RnM r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> RnM Name
lookupExactOcc Name
n
  | Just (rdr_mod :: Module
rdr_mod, rdr_occ :: OccName
rdr_occ) <- RdrName -> Maybe (Module, OccName)
isOrig_maybe RdrName
rdr_name
  = Name -> r
res (Name -> r) -> RnM Name -> RnM r
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 = RnM r
k
lookupRecFieldOcc :: Maybe Name 
                                
                  -> RdrName
                  -> RnM Name
lookupRecFieldOcc :: Maybe Name -> RdrName -> RnM Name
lookupRecFieldOcc mb_con :: Maybe Name
mb_con rdr_name :: RdrName
rdr_name
  | Just con :: Name
con <- Maybe Name
mb_con
  , Name -> Bool
isUnboundName Name
con  
  = Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name)
  | Just con :: Name
con <- Maybe Name
mb_con
  = do { [FieldLabel]
flds <- Name -> RnM [FieldLabel]
lookupConstructorFields Name
con
       ; GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
       ; let lbl :: FastString
lbl      = OccName -> FastString
occNameFS (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
             mb_field :: Maybe (FieldLabel, GlobalRdrElt)
mb_field = do FieldLabel
fl <- (FieldLabel -> Bool) -> [FieldLabel] -> Maybe FieldLabel
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== FastString
lbl) (FastString -> Bool)
-> (FieldLabel -> FastString) -> FieldLabel -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> FastString
forall a. FieldLbl a -> FastString
flLabel) [FieldLabel]
flds
                           
                           
                           
                           GlobalRdrElt
gre <- GlobalRdrEnv -> FieldLabel -> Maybe GlobalRdrElt
lookupGRE_FieldLabel GlobalRdrEnv
env FieldLabel
fl
                           Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (RdrName -> Bool
isQual RdrName
rdr_name
                                         Bool -> Bool -> Bool
&& [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
pickGREs RdrName
rdr_name [GlobalRdrElt
gre])))
                           (FieldLabel, GlobalRdrElt) -> Maybe (FieldLabel, GlobalRdrElt)
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldLabel
fl, GlobalRdrElt
gre)
       ; case Maybe (FieldLabel, GlobalRdrElt)
mb_field of
           Just (fl :: FieldLabel
fl, gre :: GlobalRdrElt
gre) -> do { Bool -> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGRE Bool
True GlobalRdrElt
gre
                                ; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector FieldLabel
fl) }
           Nothing        -> RdrName -> RnM Name
lookupGlobalOccRn RdrName
rdr_name }
             
  | Bool
otherwise
  
  
  = RdrName -> RnM Name
lookupGlobalOccRn RdrName
rdr_name
lookupSubBndrOcc_helper :: Bool -> Bool -> Name -> RdrName
                        -> RnM ChildLookupResult
lookupSubBndrOcc_helper :: Bool -> Bool -> Name -> RdrName -> RnM ChildLookupResult
lookupSubBndrOcc_helper must_have_parent :: Bool
must_have_parent warn_if_deprec :: Bool
warn_if_deprec parent :: Name
parent rdr_name :: RdrName
rdr_name
  | Name -> Bool
isUnboundName Name
parent
    
  = ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (Parent -> Name -> ChildLookupResult
FoundName Parent
NoParent (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name))
  | Bool
otherwise = do
  GlobalRdrEnv
gre_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
  let original_gres :: [GlobalRdrElt]
original_gres = GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
gre_env (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
  
  
  
  
  String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn "parent" (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
parent)
  String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn "lookupExportChild original_gres:" ([GlobalRdrElt] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [GlobalRdrElt]
original_gres)
  String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn "lookupExportChild picked_gres:" (DisambigInfo -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (DisambigInfo -> MsgDoc) -> DisambigInfo -> MsgDoc
forall a b. (a -> b) -> a -> b
$ [GlobalRdrElt] -> DisambigInfo
picked_gres [GlobalRdrElt]
original_gres)
  case [GlobalRdrElt] -> DisambigInfo
picked_gres [GlobalRdrElt]
original_gres of
    NoOccurrence ->
      [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr [GlobalRdrElt]
original_gres
    UniqueOccurrence g :: GlobalRdrElt
g ->
      if Bool
must_have_parent then [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr [GlobalRdrElt]
original_gres
                          else GlobalRdrElt -> RnM ChildLookupResult
checkFld GlobalRdrElt
g
    DisambiguatedOccurrence g :: GlobalRdrElt
g ->
      GlobalRdrElt -> RnM ChildLookupResult
checkFld GlobalRdrElt
g
    AmbiguousOccurrence gres :: [GlobalRdrElt]
gres ->
      [GlobalRdrElt] -> RnM ChildLookupResult
mkNameClashErr [GlobalRdrElt]
gres
    where
        
        checkFld :: GlobalRdrElt -> RnM ChildLookupResult
        checkFld :: GlobalRdrElt -> RnM ChildLookupResult
checkFld g :: GlobalRdrElt
g@GRE{Name
gre_name :: Name
gre_name :: GlobalRdrElt -> Name
gre_name, Parent
gre_par :: GlobalRdrElt -> Parent
gre_par :: Parent
gre_par} = do
          Bool -> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGRE Bool
warn_if_deprec GlobalRdrElt
g
          ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ChildLookupResult -> RnM ChildLookupResult)
-> ChildLookupResult -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$ case Parent
gre_par of
            FldParent _ mfs :: Maybe FastString
mfs ->
              FieldLabel -> ChildLookupResult
FoundFL  (Name -> Maybe FastString -> FieldLabel
fldParentToFieldLabel Name
gre_name Maybe FastString
mfs)
            _ -> Parent -> Name -> ChildLookupResult
FoundName Parent
gre_par Name
gre_name
        fldParentToFieldLabel :: Name -> Maybe FastString -> FieldLabel
        fldParentToFieldLabel :: Name -> Maybe FastString -> FieldLabel
fldParentToFieldLabel name :: Name
name mfs :: Maybe FastString
mfs =
          case Maybe FastString
mfs of
            Nothing ->
              let fs :: FastString
fs = OccName -> FastString
occNameFS (Name -> OccName
nameOccName Name
name)
              in FastString -> Bool -> Name -> FieldLabel
forall a. FastString -> Bool -> a -> FieldLbl a
FieldLabel FastString
fs Bool
False Name
name
            Just fs :: FastString
fs -> FastString -> Bool -> Name -> FieldLabel
forall a. FastString -> Bool -> a -> FieldLbl a
FieldLabel FastString
fs Bool
True Name
name
        
        
        
        
        
        
        
        
        
        
        noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
        noMatchingParentErr :: [GlobalRdrElt] -> RnM ChildLookupResult
noMatchingParentErr original_gres :: [GlobalRdrElt]
original_gres = do
          Bool
overload_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DuplicateRecordFields
          case [GlobalRdrElt]
original_gres of
            [] ->  ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return ChildLookupResult
NameNotFound
            [g :: GlobalRdrElt
g] -> ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ChildLookupResult -> RnM ChildLookupResult)
-> ChildLookupResult -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$ Name -> Name -> MsgDoc -> [Name] -> ChildLookupResult
IncorrectParent Name
parent
                              (GlobalRdrElt -> Name
gre_name GlobalRdrElt
g) (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Name -> MsgDoc) -> Name -> MsgDoc
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Name
gre_name GlobalRdrElt
g)
                              [Name
p | Just p :: Name
p <- [GlobalRdrElt -> Maybe Name
getParent GlobalRdrElt
g]]
            gss :: [GlobalRdrElt]
gss@(g :: GlobalRdrElt
g:_:_) ->
              if (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GlobalRdrElt -> Bool
isRecFldGRE [GlobalRdrElt]
gss Bool -> Bool -> Bool
&& Bool
overload_ok
                then ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (ChildLookupResult -> RnM ChildLookupResult)
-> ChildLookupResult -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$
                      Name -> Name -> MsgDoc -> [Name] -> ChildLookupResult
IncorrectParent Name
parent
                        (GlobalRdrElt -> Name
gre_name GlobalRdrElt
g)
                        (FastString -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (FastString -> MsgDoc) -> FastString -> MsgDoc
forall a b. (a -> b) -> a -> b
$ String -> Maybe FastString -> FastString
forall a. HasCallStack => String -> Maybe a -> a
expectJust "noMatchingParentErr" (GlobalRdrElt -> Maybe FastString
greLabel GlobalRdrElt
g))
                        [Name
p | GlobalRdrElt
x <- [GlobalRdrElt]
gss, Just p :: Name
p <- [GlobalRdrElt -> Maybe Name
getParent GlobalRdrElt
x]]
                else [GlobalRdrElt] -> RnM ChildLookupResult
mkNameClashErr [GlobalRdrElt]
gss
        mkNameClashErr :: [GlobalRdrElt] -> RnM ChildLookupResult
        mkNameClashErr :: [GlobalRdrElt] -> RnM ChildLookupResult
mkNameClashErr gres :: [GlobalRdrElt]
gres = do
          RdrName -> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name [GlobalRdrElt]
gres
          ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (Parent -> Name -> ChildLookupResult
FoundName (GlobalRdrElt -> Parent
gre_par ([GlobalRdrElt] -> GlobalRdrElt
forall a. [a] -> a
head [GlobalRdrElt]
gres)) (GlobalRdrElt -> Name
gre_name ([GlobalRdrElt] -> GlobalRdrElt
forall a. [a] -> a
head [GlobalRdrElt]
gres)))
        getParent :: GlobalRdrElt -> Maybe Name
        getParent :: GlobalRdrElt -> Maybe Name
getParent (GRE { gre_par :: GlobalRdrElt -> Parent
gre_par = Parent
p } ) =
          case Parent
p of
            ParentIs cur_parent :: Name
cur_parent -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
cur_parent
            FldParent { par_is :: Parent -> Name
par_is = Name
cur_parent } -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
cur_parent
            NoParent -> Maybe Name
forall a. Maybe a
Nothing
        picked_gres :: [GlobalRdrElt] -> DisambigInfo
        
        
        picked_gres :: [GlobalRdrElt] -> DisambigInfo
picked_gres 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]
pickGREs RdrName
rdr_name [GlobalRdrElt]
gres))
        right_parent :: GlobalRdrElt -> DisambigInfo
        right_parent :: GlobalRdrElt -> DisambigInfo
right_parent p :: GlobalRdrElt
p
          = case GlobalRdrElt -> Maybe Name
getParent GlobalRdrElt
p of
               Just cur_parent :: Name
cur_parent
                  | Name
parent Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
cur_parent -> GlobalRdrElt -> DisambigInfo
DisambiguatedOccurrence GlobalRdrElt
p
                  | Bool
otherwise            -> DisambigInfo
NoOccurrence
               Nothing                   -> GlobalRdrElt -> DisambigInfo
UniqueOccurrence GlobalRdrElt
p
data DisambigInfo
       = NoOccurrence
          
       | UniqueOccurrence GlobalRdrElt
          
       | DisambiguatedOccurrence GlobalRdrElt
          
       | AmbiguousOccurrence [GlobalRdrElt]
          
          
          
instance Outputable DisambigInfo where
  ppr :: DisambigInfo -> MsgDoc
ppr NoOccurrence = String -> MsgDoc
text "NoOccurence"
  ppr (UniqueOccurrence gre :: GlobalRdrElt
gre) = String -> MsgDoc
text "UniqueOccurrence:" MsgDoc -> MsgDoc -> MsgDoc
<+> GlobalRdrElt -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr GlobalRdrElt
gre
  ppr (DisambiguatedOccurrence gre :: GlobalRdrElt
gre) = String -> MsgDoc
text "DiambiguatedOccurrence:" MsgDoc -> MsgDoc -> MsgDoc
<+> GlobalRdrElt -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr GlobalRdrElt
gre
  ppr (AmbiguousOccurrence gres :: [GlobalRdrElt]
gres)    = String -> MsgDoc
text "Ambiguous:" MsgDoc -> MsgDoc -> MsgDoc
<+> [GlobalRdrElt] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [GlobalRdrElt]
gres
instance Semi.Semigroup DisambigInfo where
  
  
  _ <> :: DisambigInfo -> DisambigInfo -> DisambigInfo
<> DisambiguatedOccurrence g' :: GlobalRdrElt
g' = GlobalRdrElt -> DisambigInfo
DisambiguatedOccurrence GlobalRdrElt
g'
  DisambiguatedOccurrence g' :: GlobalRdrElt
g' <> _ = GlobalRdrElt -> DisambigInfo
DisambiguatedOccurrence GlobalRdrElt
g'
  NoOccurrence <> m :: DisambigInfo
m = DisambigInfo
m
  m :: DisambigInfo
m <> NoOccurrence = DisambigInfo
m
  UniqueOccurrence g :: GlobalRdrElt
g <> UniqueOccurrence g' :: GlobalRdrElt
g'
    = [GlobalRdrElt] -> DisambigInfo
AmbiguousOccurrence [GlobalRdrElt
g, GlobalRdrElt
g']
  UniqueOccurrence g :: GlobalRdrElt
g <> AmbiguousOccurrence gs :: [GlobalRdrElt]
gs
    = [GlobalRdrElt] -> DisambigInfo
AmbiguousOccurrence (GlobalRdrElt
gGlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
:[GlobalRdrElt]
gs)
  AmbiguousOccurrence gs :: [GlobalRdrElt]
gs <> UniqueOccurrence g' :: GlobalRdrElt
g'
    = [GlobalRdrElt] -> DisambigInfo
AmbiguousOccurrence (GlobalRdrElt
g'GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
:[GlobalRdrElt]
gs)
  AmbiguousOccurrence gs :: [GlobalRdrElt]
gs <> AmbiguousOccurrence gs' :: [GlobalRdrElt]
gs'
    = [GlobalRdrElt] -> DisambigInfo
AmbiguousOccurrence ([GlobalRdrElt]
gs [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++ [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.<>)
data ChildLookupResult
      = NameNotFound                
      | IncorrectParent Name        
                        Name        
                        SDoc        
                        [Name]      
      | FoundName Parent Name       
      | FoundFL FieldLabel          
combineChildLookupResult :: [RnM ChildLookupResult] -> RnM ChildLookupResult
combineChildLookupResult :: [RnM ChildLookupResult] -> RnM ChildLookupResult
combineChildLookupResult [] = ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return ChildLookupResult
NameNotFound
combineChildLookupResult (x :: RnM ChildLookupResult
x:xs :: [RnM ChildLookupResult]
xs) = do
  ChildLookupResult
res <- RnM ChildLookupResult
x
  case ChildLookupResult
res of
    NameNotFound -> [RnM ChildLookupResult] -> RnM ChildLookupResult
combineChildLookupResult [RnM ChildLookupResult]
xs
    _ -> ChildLookupResult -> RnM ChildLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return ChildLookupResult
res
instance Outputable ChildLookupResult where
  ppr :: ChildLookupResult -> MsgDoc
ppr NameNotFound = String -> MsgDoc
text "NameNotFound"
  ppr (FoundName p :: Parent
p n :: Name
n) = String -> MsgDoc
text "Found:" MsgDoc -> MsgDoc -> MsgDoc
<+> Parent -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Parent
p MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
n
  ppr (FoundFL fls :: FieldLabel
fls) = String -> MsgDoc
text "FoundFL:" MsgDoc -> MsgDoc -> MsgDoc
<+> FieldLabel -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr FieldLabel
fls
  ppr (IncorrectParent p :: Name
p n :: Name
n td :: MsgDoc
td ns :: [Name]
ns) = String -> MsgDoc
text "IncorrectParent"
                                  MsgDoc -> MsgDoc -> MsgDoc
<+> [MsgDoc] -> MsgDoc
hsep [Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
p, Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
n, MsgDoc
td, [Name] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [Name]
ns]
lookupSubBndrOcc :: Bool
                 -> Name     
                 -> SDoc
                 -> RdrName
                 -> RnM (Either MsgDoc Name)
lookupSubBndrOcc :: Bool -> Name -> MsgDoc -> RdrName -> RnM (Either MsgDoc Name)
lookupSubBndrOcc warn_if_deprec :: Bool
warn_if_deprec the_parent :: Name
the_parent doc :: MsgDoc
doc rdr_name :: RdrName
rdr_name = do
  ChildLookupResult
res <-
    RdrName
-> (Name -> ChildLookupResult)
-> RnM ChildLookupResult
-> RnM ChildLookupResult
forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name (Parent -> Name -> ChildLookupResult
FoundName Parent
NoParent) (RnM ChildLookupResult -> RnM ChildLookupResult)
-> RnM ChildLookupResult -> RnM ChildLookupResult
forall a b. (a -> b) -> a -> b
$
      
      Bool -> Bool -> Name -> RdrName -> RnM ChildLookupResult
lookupSubBndrOcc_helper Bool
True Bool
warn_if_deprec Name
the_parent RdrName
rdr_name
  case ChildLookupResult
res of
    NameNotFound -> Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> Either MsgDoc Name
forall a b. a -> Either a b
Left (MsgDoc -> RdrName -> MsgDoc
unknownSubordinateErr MsgDoc
doc RdrName
rdr_name))
    FoundName _p :: Parent
_p n :: Name
n -> Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right Name
n)
    FoundFL fl :: FieldLabel
fl  ->  Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right (FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector FieldLabel
fl))
    IncorrectParent {}
         
         
      -> Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MsgDoc Name -> RnM (Either MsgDoc Name))
-> Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall a b. (a -> b) -> a -> b
$ MsgDoc -> Either MsgDoc Name
forall a b. a -> Either a b
Left (MsgDoc -> RdrName -> MsgDoc
unknownSubordinateErr MsgDoc
doc RdrName
rdr_name)
lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
lookupLocatedOccRn = (SrcSpanLess (Located RdrName) -> TcM (SrcSpanLess (Located Name)))
-> Located RdrName -> RnM (Located Name)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM SrcSpanLess (Located RdrName) -> TcM (SrcSpanLess (Located Name))
RdrName -> RnM Name
lookupOccRn
lookupLocalOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe rdr_name :: RdrName
rdr_name
  = do { LocalRdrEnv
local_env <- RnM LocalRdrEnv
getLocalRdrEnv
       ; Maybe Name -> RnM (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalRdrEnv -> RdrName -> Maybe Name
lookupLocalRdrEnv LocalRdrEnv
local_env RdrName
rdr_name) }
lookupLocalOccThLvl_maybe :: Name -> RnM (Maybe (TopLevelFlag, ThLevel))
lookupLocalOccThLvl_maybe :: Name -> RnM (Maybe (TopLevelFlag, Int))
lookupLocalOccThLvl_maybe name :: Name
name
  = do { TcLclEnv
lcl_env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
forall gbl lcl. TcRnIf gbl lcl lcl
getLclEnv
       ; Maybe (TopLevelFlag, Int) -> RnM (Maybe (TopLevelFlag, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (NameEnv (TopLevelFlag, Int) -> Name -> Maybe (TopLevelFlag, Int)
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv (TcLclEnv -> NameEnv (TopLevelFlag, Int)
tcl_th_bndrs TcLclEnv
lcl_env) Name
name) }
lookupOccRn :: RdrName -> RnM Name
lookupOccRn :: RdrName -> RnM Name
lookupOccRn rdr_name :: RdrName
rdr_name
  = do { Maybe Name
mb_name <- RdrName -> RnM (Maybe Name)
lookupOccRn_maybe RdrName
rdr_name
       ; case Maybe Name
mb_name of
           Just name :: Name
name -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name
           Nothing   -> RdrName -> RnM Name
reportUnboundName RdrName
rdr_name }
lookupLocalOccRn :: RdrName -> RnM Name
lookupLocalOccRn :: RdrName -> RnM Name
lookupLocalOccRn rdr_name :: RdrName
rdr_name
  = do { Maybe Name
mb_name <- RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
       ; case Maybe Name
mb_name of
           Just name :: Name
name -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name
           Nothing   -> WhereLooking -> RdrName -> RnM Name
unboundName WhereLooking
WL_LocalOnly RdrName
rdr_name }
lookupTypeOccRn :: RdrName -> RnM Name
lookupTypeOccRn :: RdrName -> RnM Name
lookupTypeOccRn rdr_name :: RdrName
rdr_name
  | OccName -> Bool
isVarOcc (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)  
  = RdrName -> RnM Name
badVarInType RdrName
rdr_name
  | Bool
otherwise
  = do { Maybe Name
mb_name <- RdrName -> RnM (Maybe Name)
lookupOccRn_maybe RdrName
rdr_name
       ; case Maybe Name
mb_name of
             Just name :: Name
name -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name
             Nothing   -> RdrName -> RnM Name
lookup_demoted RdrName
rdr_name }
lookup_demoted :: RdrName -> RnM Name
lookup_demoted :: RdrName -> RnM Name
lookup_demoted rdr_name :: RdrName
rdr_name
  | Just demoted_rdr :: RdrName
demoted_rdr <- RdrName -> Maybe RdrName
demoteRdrName RdrName
rdr_name
    
  = do { Bool
data_kinds <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DataKinds
       ; Bool
star_is_type <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.StarIsType
       ; let star_info :: MsgDoc
star_info = Bool -> RdrName -> MsgDoc
starInfo Bool
star_is_type RdrName
rdr_name
       ; if Bool
data_kinds
            then do { Maybe Name
mb_demoted_name <- RdrName -> RnM (Maybe Name)
lookupOccRn_maybe RdrName
demoted_rdr
                    ; case Maybe Name
mb_demoted_name of
                        Nothing -> WhereLooking -> RdrName -> MsgDoc -> RnM Name
unboundNameX WhereLooking
WL_Any RdrName
rdr_name MsgDoc
star_info
                        Just demoted_name :: Name
demoted_name ->
                          do { WarningFlag
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl.
WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
whenWOptM WarningFlag
Opt_WarnUntickedPromotedConstructors (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
                               WarnReason -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarn
                                 (WarningFlag -> WarnReason
Reason WarningFlag
Opt_WarnUntickedPromotedConstructors)
                                 (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
untickedPromConstrWarn Name
demoted_name)
                             ; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
demoted_name } }
            else do { 
                      
                      
                      
                      Maybe Name
mb_demoted_name <- RnM (Maybe Name) -> RnM (Maybe Name)
forall a. TcRn a -> TcRn a
discardErrs (RnM (Maybe Name) -> RnM (Maybe Name))
-> RnM (Maybe Name) -> RnM (Maybe Name)
forall a b. (a -> b) -> a -> b
$
                                         RdrName -> RnM (Maybe Name)
lookupOccRn_maybe RdrName
demoted_rdr
                    ; let suggestion :: MsgDoc
suggestion | Maybe Name -> Bool
forall a. Maybe a -> Bool
isJust Maybe Name
mb_demoted_name = MsgDoc
suggest_dk
                                     | Bool
otherwise = MsgDoc
star_info
                    ; WhereLooking -> RdrName -> MsgDoc -> RnM Name
unboundNameX WhereLooking
WL_Any RdrName
rdr_name MsgDoc
suggestion } }
  | Bool
otherwise
  = RdrName -> RnM Name
reportUnboundName RdrName
rdr_name
  where
    suggest_dk :: MsgDoc
suggest_dk = String -> MsgDoc
text "A data constructor of that name is in scope; did you mean DataKinds?"
    untickedPromConstrWarn :: a -> MsgDoc
untickedPromConstrWarn name :: a
name =
      String -> MsgDoc
text "Unticked promoted constructor" MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
colon MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
name) MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
dot
      MsgDoc -> MsgDoc -> MsgDoc
$$
      [MsgDoc] -> MsgDoc
hsep [ String -> MsgDoc
text "Use"
           , MsgDoc -> MsgDoc
quotes (Char -> MsgDoc
char '\'' MsgDoc -> MsgDoc -> MsgDoc
<> a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
name)
           , String -> MsgDoc
text "instead of"
           , MsgDoc -> MsgDoc
quotes (a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
name) MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
dot ]
badVarInType :: RdrName -> RnM Name
badVarInType :: RdrName -> RnM Name
badVarInType rdr_name :: RdrName
rdr_name
  = do { MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (String -> MsgDoc
text "Illegal promoted term variable in a type:"
                 MsgDoc -> MsgDoc -> MsgDoc
<+> RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name)
       ; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name) }
lookupOccRnX_maybe :: (RdrName -> RnM (Maybe r)) -> (Name -> r) -> RdrName
                   -> RnM (Maybe r)
lookupOccRnX_maybe :: (RdrName -> RnM (Maybe r))
-> (Name -> r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe globalLookup :: RdrName -> RnM (Maybe r)
globalLookup wrapper :: Name -> r
wrapper rdr_name :: 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
$
      [ (Name -> r) -> Maybe Name -> Maybe r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> r
wrapper (Maybe Name -> Maybe r) -> RnM (Maybe Name) -> RnM (Maybe r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
      , RdrName -> RnM (Maybe r)
globalLookup RdrName
rdr_name ]
lookupOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupOccRn_maybe = (RdrName -> RnM (Maybe Name))
-> (Name -> Name) -> RdrName -> RnM (Maybe Name)
forall r.
(RdrName -> RnM (Maybe r))
-> (Name -> r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_maybe Name -> Name
forall a. a -> a
id
lookupOccRn_overloaded :: Bool -> RdrName
                       -> RnM (Maybe (Either Name [Name]))
lookupOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name]))
lookupOccRn_overloaded overload_ok :: Bool
overload_ok
  = (RdrName -> RnM (Maybe (Either Name [Name])))
-> (Name -> Either Name [Name])
-> RdrName
-> RnM (Maybe (Either Name [Name]))
forall r.
(RdrName -> RnM (Maybe r))
-> (Name -> r) -> RdrName -> RnM (Maybe r)
lookupOccRnX_maybe RdrName -> RnM (Maybe (Either Name [Name]))
global_lookup Name -> Either Name [Name]
forall a b. a -> Either a b
Left
      where
        global_lookup :: RdrName -> RnM (Maybe (Either Name [Name]))
        global_lookup :: RdrName -> RnM (Maybe (Either Name [Name]))
global_lookup n :: RdrName
n =
          MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])
-> RnM (Maybe (Either Name [Name]))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])
 -> RnM (Maybe (Either Name [Name])))
-> ([RnM (Maybe (Either Name [Name]))]
    -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name]))
-> [RnM (Maybe (Either Name [Name]))]
-> RnM (Maybe (Either Name [Name]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])]
 -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name]))
-> ([RnM (Maybe (Either Name [Name]))]
    -> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])])
-> [RnM (Maybe (Either Name [Name]))]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RnM (Maybe (Either Name [Name]))
 -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name]))
-> [RnM (Maybe (Either Name [Name]))]
-> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])]
forall a b. (a -> b) -> [a] -> [b]
map RnM (Maybe (Either Name [Name]))
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) (Either Name [Name])
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ([RnM (Maybe (Either Name [Name]))]
 -> RnM (Maybe (Either Name [Name])))
-> [RnM (Maybe (Either Name [Name]))]
-> RnM (Maybe (Either Name [Name]))
forall a b. (a -> b) -> a -> b
$
            [ Bool -> RdrName -> RnM (Maybe (Either Name [Name]))
lookupGlobalOccRn_overloaded Bool
overload_ok RdrName
n
            , (Name -> Either Name [Name])
-> Maybe Name -> Maybe (Either Name [Name])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Either Name [Name]
forall a b. a -> Either a b
Left (Maybe Name -> Maybe (Either Name [Name]))
-> ([Name] -> Maybe Name) -> [Name] -> Maybe (Either Name [Name])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> Maybe Name
forall a. [a] -> Maybe a
listToMaybe ([Name] -> Maybe (Either Name [Name]))
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
-> RnM (Maybe (Either Name [Name]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
lookupQualifiedNameGHCi RdrName
n ]
lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_maybe :: RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_maybe rdr_name :: RdrName
rdr_name =
  RdrName
-> (Name -> Maybe Name) -> RnM (Maybe Name) -> RnM (Maybe Name)
forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name Name -> Maybe Name
forall a. a -> Maybe a
Just (RnM (Maybe Name) -> RnM (Maybe Name))
-> RnM (Maybe Name) -> RnM (Maybe Name)
forall a b. (a -> b) -> a -> b
$
    MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name -> RnM (Maybe Name)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name -> RnM (Maybe Name))
-> ([RnM (Maybe Name)]
    -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name)
-> [RnM (Maybe Name)]
-> RnM (Maybe Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name]
 -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name)
-> ([RnM (Maybe Name)]
    -> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name])
-> [RnM (Maybe Name)]
-> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RnM (Maybe Name) -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name)
-> [RnM (Maybe Name)]
-> [MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name]
forall a b. (a -> b) -> [a] -> [b]
map RnM (Maybe Name) -> MaybeT (IOEnv (Env TcGblEnv TcLclEnv)) Name
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ([RnM (Maybe Name)] -> RnM (Maybe Name))
-> [RnM (Maybe Name)] -> RnM (Maybe Name)
forall a b. (a -> b) -> a -> b
$
      [ (GlobalRdrElt -> Name) -> Maybe GlobalRdrElt -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GlobalRdrElt -> Name
gre_name (Maybe GlobalRdrElt -> Maybe Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
-> RnM (Maybe Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
lookupGreRn_maybe RdrName
rdr_name
      , [Name] -> Maybe Name
forall a. [a] -> Maybe a
listToMaybe ([Name] -> Maybe Name)
-> IOEnv (Env TcGblEnv TcLclEnv) [Name] -> RnM (Maybe Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
lookupQualifiedNameGHCi RdrName
rdr_name ]
                      
                      
lookupGlobalOccRn :: RdrName -> RnM Name
lookupGlobalOccRn :: RdrName -> RnM Name
lookupGlobalOccRn rdr_name :: RdrName
rdr_name
  = do { Maybe Name
mb_name <- RdrName -> RnM (Maybe Name)
lookupGlobalOccRn_maybe RdrName
rdr_name
       ; case Maybe Name
mb_name of
           Just n :: Name
n  -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
n
           Nothing -> do { String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn "lookupGlobalOccRn" (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name)
                         ; WhereLooking -> RdrName -> RnM Name
unboundName WhereLooking
WL_Global RdrName
rdr_name } }
lookupInfoOccRn :: RdrName -> RnM [Name]
lookupInfoOccRn :: RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
lookupInfoOccRn rdr_name :: RdrName
rdr_name =
  RdrName
-> (Name -> [Name])
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name (Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[]) (IOEnv (Env TcGblEnv TcLclEnv) [Name]
 -> IOEnv (Env TcGblEnv TcLclEnv) [Name])
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
-> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall a b. (a -> b) -> a -> b
$
    do { GlobalRdrEnv
rdr_env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
       ; let ns :: [Name]
ns = (GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
gre_name (RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName RdrName
rdr_name GlobalRdrEnv
rdr_env)
       ; [Name]
qual_ns <- RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
lookupQualifiedNameGHCi RdrName
rdr_name
       ; [Name] -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ ([Name]
qual_ns [Name] -> [Name] -> [Name]
forall a. Ord a => [a] -> [a] -> [a]
`minusList` [Name]
ns)) }
lookupGlobalOccRn_overloaded :: Bool -> RdrName
                             -> RnM (Maybe (Either Name [Name]))
lookupGlobalOccRn_overloaded :: Bool -> RdrName -> RnM (Maybe (Either Name [Name]))
lookupGlobalOccRn_overloaded overload_ok :: Bool
overload_ok rdr_name :: RdrName
rdr_name =
  RdrName
-> (Name -> Maybe (Either Name [Name]))
-> RnM (Maybe (Either Name [Name]))
-> RnM (Maybe (Either Name [Name]))
forall r. RdrName -> (Name -> r) -> RnM r -> RnM r
lookupExactOrOrig RdrName
rdr_name (Either Name [Name] -> Maybe (Either Name [Name])
forall a. a -> Maybe a
Just (Either Name [Name] -> Maybe (Either Name [Name]))
-> (Name -> Either Name [Name])
-> Name
-> Maybe (Either Name [Name])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Either Name [Name]
forall a b. a -> Either a b
Left) (RnM (Maybe (Either Name [Name]))
 -> RnM (Maybe (Either Name [Name])))
-> RnM (Maybe (Either Name [Name]))
-> RnM (Maybe (Either Name [Name]))
forall a b. (a -> b) -> a -> b
$
     do  { GreLookupResult
res <- RdrName -> RnM GreLookupResult
lookupGreRn_helper RdrName
rdr_name
         ; case GreLookupResult
res of
                GreNotFound  -> Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either Name [Name])
forall a. Maybe a
Nothing
                OneNameMatch gre :: GlobalRdrElt
gre -> do
                  let wrapper :: a -> Either a [a]
wrapper = if GlobalRdrElt -> Bool
isRecFldGRE GlobalRdrElt
gre then [a] -> Either a [a]
forall a b. b -> Either a b
Right ([a] -> Either a [a]) -> (a -> [a]) -> a -> Either a [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[]) else a -> Either a [a]
forall a b. a -> Either a b
Left
                  Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name])))
-> Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name]))
forall a b. (a -> b) -> a -> b
$ Either Name [Name] -> Maybe (Either Name [Name])
forall a. a -> Maybe a
Just (Name -> Either Name [Name]
forall a. a -> Either a [a]
wrapper (GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre))
                MultipleNames gres :: [GlobalRdrElt]
gres  | (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GlobalRdrElt -> Bool
isRecFldGRE [GlobalRdrElt]
gres Bool -> Bool -> Bool
&& Bool
overload_ok ->
                  
                  
                  Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name])))
-> Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name]))
forall a b. (a -> b) -> a -> b
$ Either Name [Name] -> Maybe (Either Name [Name])
forall a. a -> Maybe a
Just ([Name] -> Either Name [Name]
forall a b. b -> Either a b
Right ((GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
gre_name [GlobalRdrElt]
gres))
                MultipleNames gres :: [GlobalRdrElt]
gres  -> do
                  RdrName -> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name [GlobalRdrElt]
gres
                  Maybe (Either Name [Name]) -> RnM (Maybe (Either Name [Name]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Name [Name] -> Maybe (Either Name [Name])
forall a. a -> Maybe a
Just (Name -> Either Name [Name]
forall a b. a -> Either a b
Left (GlobalRdrElt -> Name
gre_name ([GlobalRdrElt] -> GlobalRdrElt
forall a. [a] -> a
head [GlobalRdrElt]
gres)))) }
data GreLookupResult = GreNotFound
                     | OneNameMatch GlobalRdrElt
                     | MultipleNames [GlobalRdrElt]
lookupGreRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt)
lookupGreRn_maybe :: RdrName -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
lookupGreRn_maybe rdr_name :: RdrName
rdr_name
  = do
      GreLookupResult
res <- RdrName -> RnM GreLookupResult
lookupGreRn_helper RdrName
rdr_name
      case GreLookupResult
res of
        OneNameMatch gre :: GlobalRdrElt
gre ->  Maybe GlobalRdrElt
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt
 -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt))
-> Maybe GlobalRdrElt
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just GlobalRdrElt
gre
        MultipleNames gres :: [GlobalRdrElt]
gres -> do
          String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn "lookupGreRn_maybe:NameClash" ([GlobalRdrElt] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [GlobalRdrElt]
gres)
          RdrName -> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name [GlobalRdrElt]
gres
          Maybe GlobalRdrElt
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GlobalRdrElt
 -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt))
-> Maybe GlobalRdrElt
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
forall a b. (a -> b) -> a -> b
$ GlobalRdrElt -> Maybe GlobalRdrElt
forall a. a -> Maybe a
Just ([GlobalRdrElt] -> GlobalRdrElt
forall a. [a] -> a
head [GlobalRdrElt]
gres)
        GreNotFound -> Maybe GlobalRdrElt
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalRdrElt)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GlobalRdrElt
forall a. Maybe a
Nothing
lookupGreRn_helper :: RdrName -> RnM GreLookupResult
lookupGreRn_helper :: RdrName -> RnM GreLookupResult
lookupGreRn_helper rdr_name :: RdrName
rdr_name
  = do  { GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
        ; case RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName RdrName
rdr_name GlobalRdrEnv
env of
            []    -> GreLookupResult -> RnM GreLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return GreLookupResult
GreNotFound
            [gre :: GlobalRdrElt
gre] -> do { Bool -> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGRE Bool
True GlobalRdrElt
gre
                        ; GreLookupResult -> RnM GreLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> GreLookupResult
OneNameMatch GlobalRdrElt
gre) }
            gres :: [GlobalRdrElt]
gres  -> GreLookupResult -> RnM GreLookupResult
forall (m :: * -> *) a. Monad m => a -> m a
return ([GlobalRdrElt] -> GreLookupResult
MultipleNames [GlobalRdrElt]
gres) }
lookupGreAvailRn :: RdrName -> RnM (Name, AvailInfo)
lookupGreAvailRn :: RdrName -> RnM (Name, AvailInfo)
lookupGreAvailRn rdr_name :: RdrName
rdr_name
  = do
      GreLookupResult
mb_gre <- RdrName -> RnM GreLookupResult
lookupGreRn_helper RdrName
rdr_name
      case GreLookupResult
mb_gre of
        GreNotFound ->
          do
            String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn "lookupGreAvailRn" (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name)
            Name
name <- WhereLooking -> RdrName -> RnM Name
unboundName WhereLooking
WL_Global RdrName
rdr_name
            (Name, AvailInfo) -> RnM (Name, AvailInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
name, Name -> AvailInfo
avail Name
name)
        MultipleNames gres :: [GlobalRdrElt]
gres ->
          do
            RdrName -> [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addNameClashErrRn RdrName
rdr_name [GlobalRdrElt]
gres
            let unbound_name :: Name
unbound_name = RdrName -> Name
mkUnboundNameRdr RdrName
rdr_name
            (Name, AvailInfo) -> RnM (Name, AvailInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
unbound_name, Name -> AvailInfo
avail Name
unbound_name)
                        
                        
        OneNameMatch gre :: GlobalRdrElt
gre ->
          (Name, AvailInfo) -> RnM (Name, AvailInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre, GlobalRdrElt -> AvailInfo
availFromGRE GlobalRdrElt
gre)
addUsedDataCons :: GlobalRdrEnv -> TyCon -> RnM ()
addUsedDataCons :: GlobalRdrEnv -> TyCon -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedDataCons rdr_env :: GlobalRdrEnv
rdr_env tycon :: TyCon
tycon
  = [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGREs [ GlobalRdrElt
gre
                | DataCon
dc <- TyCon -> [DataCon]
tyConDataCons TyCon
tycon
                , Just gre :: GlobalRdrElt
gre <- [GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
lookupGRE_Name GlobalRdrEnv
rdr_env (DataCon -> Name
dataConName DataCon
dc)] ]
addUsedGRE :: Bool -> GlobalRdrElt -> RnM ()
addUsedGRE :: Bool -> GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGRE warn_if_deprec :: Bool
warn_if_deprec gre :: GlobalRdrElt
gre
  = do { Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
warn_if_deprec (GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIfDeprecated GlobalRdrElt
gre)
       ; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (GlobalRdrElt -> Bool
isLocalGRE 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
$
         do { TcGblEnv
env <- IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
            ; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn "addUsedGRE" (GlobalRdrElt -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr GlobalRdrElt
gre)
            ; IORef [GlobalRdrElt]
-> ([GlobalRdrElt] -> [GlobalRdrElt])
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a env. IORef a -> (a -> a) -> IOEnv env ()
updMutVar (TcGblEnv -> IORef [GlobalRdrElt]
tcg_used_gres TcGblEnv
env) (GlobalRdrElt
gre GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
:) } }
addUsedGREs :: [GlobalRdrElt] -> RnM ()
addUsedGREs :: [GlobalRdrElt] -> IOEnv (Env TcGblEnv TcLclEnv) ()
addUsedGREs gres :: [GlobalRdrElt]
gres
  | [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
imp_gres = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise     = do { TcGblEnv
env <- IOEnv (Env TcGblEnv TcLclEnv) TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
                       ; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn "addUsedGREs" ([GlobalRdrElt] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [GlobalRdrElt]
imp_gres)
                       ; IORef [GlobalRdrElt]
-> ([GlobalRdrElt] -> [GlobalRdrElt])
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a env. IORef a -> (a -> a) -> IOEnv env ()
updMutVar (TcGblEnv -> IORef [GlobalRdrElt]
tcg_used_gres TcGblEnv
env) ([GlobalRdrElt]
imp_gres [GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++) }
  where
    imp_gres :: [GlobalRdrElt]
imp_gres = (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filterOut GlobalRdrElt -> Bool
isLocalGRE [GlobalRdrElt]
gres
warnIfDeprecated :: GlobalRdrElt -> RnM ()
warnIfDeprecated :: GlobalRdrElt -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnIfDeprecated gre :: GlobalRdrElt
gre@(GRE { gre_name :: GlobalRdrElt -> Name
gre_name = Name
name, gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_imp = [ImportSpec]
iss })
  | (imp_spec :: ImportSpec
imp_spec : _) <- [ImportSpec]
iss
  = do { DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
       ; Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
       ; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WarningFlag -> DynFlags -> Bool
wopt WarningFlag
Opt_WarnWarningsDeprecations DynFlags
dflags Bool -> Bool -> Bool
&&
               Bool -> Bool
not (Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod Name
name)) (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
                   
         do { ModIface
iface <- MsgDoc -> Name -> TcRn ModIface
loadInterfaceForName MsgDoc
doc Name
name
            ; case ModIface -> GlobalRdrElt -> Maybe WarningTxt
lookupImpDeprec ModIface
iface GlobalRdrElt
gre of
                Just txt :: WarningTxt
txt -> WarnReason -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addWarn (WarningFlag -> WarnReason
Reason WarningFlag
Opt_WarnWarningsDeprecations)
                                   (ImportSpec -> WarningTxt -> MsgDoc
mk_msg ImportSpec
imp_spec WarningTxt
txt)
                Nothing  -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return () } }
  | Bool
otherwise
  = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    occ :: OccName
occ = GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre
    name_mod :: Module
name_mod = ASSERT2( isExternalName name, ppr name ) nameModule name
    doc :: MsgDoc
doc = String -> MsgDoc
text "The name" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (OccName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr OccName
occ) MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit "is mentioned explicitly")
    mk_msg :: ImportSpec -> WarningTxt -> MsgDoc
mk_msg imp_spec :: ImportSpec
imp_spec txt :: WarningTxt
txt
      = [MsgDoc] -> MsgDoc
sep [ [MsgDoc] -> MsgDoc
sep [ String -> MsgDoc
text "In the use of"
                    MsgDoc -> MsgDoc -> MsgDoc
<+> NameSpace -> MsgDoc
pprNonVarNameSpace (OccName -> NameSpace
occNameSpace OccName
occ)
                    MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (OccName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr OccName
occ)
                  , MsgDoc -> MsgDoc
parens MsgDoc
imp_msg MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
colon ]
            , WarningTxt -> MsgDoc
pprWarningTxtForMsg WarningTxt
txt ]
      where
        imp_mod :: ModuleName
imp_mod  = ImportSpec -> ModuleName
importSpecModule ImportSpec
imp_spec
        imp_msg :: MsgDoc
imp_msg  = String -> MsgDoc
text "imported from" MsgDoc -> MsgDoc -> MsgDoc
<+> ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ModuleName
imp_mod MsgDoc -> MsgDoc -> MsgDoc
<> MsgDoc
extra
        extra :: MsgDoc
extra | ModuleName
imp_mod ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> ModuleName
moduleName Module
name_mod = MsgDoc
Outputable.empty
              | Bool
otherwise = String -> MsgDoc
text ", but defined in" MsgDoc -> MsgDoc -> MsgDoc
<+> Module -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Module
name_mod
lookupImpDeprec :: ModIface -> GlobalRdrElt -> Maybe WarningTxt
lookupImpDeprec :: ModIface -> GlobalRdrElt -> Maybe WarningTxt
lookupImpDeprec iface :: ModIface
iface gre :: GlobalRdrElt
gre
  = ModIface -> OccName -> Maybe WarningTxt
mi_warn_fn ModIface
iface (GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre) Maybe WarningTxt -> Maybe WarningTxt -> Maybe WarningTxt
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`  
    case GlobalRdrElt -> Parent
gre_par GlobalRdrElt
gre of                      
       ParentIs  p :: Name
p              -> ModIface -> OccName -> Maybe WarningTxt
mi_warn_fn ModIface
iface (Name -> OccName
nameOccName Name
p)
       FldParent { par_is :: Parent -> Name
par_is = Name
p } -> ModIface -> OccName -> Maybe WarningTxt
mi_warn_fn ModIface
iface (Name -> OccName
nameOccName Name
p)
       NoParent                 -> Maybe WarningTxt
forall a. Maybe a
Nothing
lookupQualifiedNameGHCi :: RdrName -> RnM [Name]
lookupQualifiedNameGHCi :: RdrName -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
lookupQualifiedNameGHCi rdr_name :: RdrName
rdr_name
  = 
    
    do { DynFlags
dflags  <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
       ; Bool
is_ghci <- TcRnIf TcGblEnv TcLclEnv Bool
getIsGHCi
       ; DynFlags -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
go_for_it DynFlags
dflags Bool
is_ghci }
  where
    go_for_it :: DynFlags -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
go_for_it dflags :: DynFlags
dflags is_ghci :: Bool
is_ghci
      | Just (mod :: ModuleName
mod,occ :: OccName
occ) <- RdrName -> Maybe (ModuleName, OccName)
isQual_maybe RdrName
rdr_name
      , Bool
is_ghci
      , GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ImplicitImportQualified DynFlags
dflags   
      , Bool -> Bool
not (DynFlags -> Bool
safeDirectImpsReq DynFlags
dflags)            
      = do { MaybeErr MsgDoc ModIface
res <- MsgDoc
-> ModuleName
-> Bool
-> Maybe FastString
-> RnM (MaybeErr MsgDoc ModIface)
loadSrcInterface_maybe MsgDoc
doc ModuleName
mod Bool
False Maybe FastString
forall a. Maybe a
Nothing
           ; case MaybeErr MsgDoc ModIface
res of
                Succeeded iface :: ModIface
iface
                  -> [Name] -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Name
name
                            | AvailInfo
avail <- ModIface -> [AvailInfo]
mi_exports ModIface
iface
                            , Name
name  <- AvailInfo -> [Name]
availNames AvailInfo
avail
                            , Name -> OccName
nameOccName Name
name OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== OccName
occ ]
                _ -> 
                     
                     do { String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn "lookupQualifiedNameGHCi" (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name)
                        ; [Name] -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [] } }
      | Bool
otherwise
      = do { String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn "lookupQualifiedNameGHCi: off" (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name)
           ; [Name] -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [] }
    doc :: MsgDoc
doc = String -> MsgDoc
text "Need to find" MsgDoc -> MsgDoc -> MsgDoc
<+> RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name
data HsSigCtxt
  = TopSigCtxt NameSet       
                             
  | LocalBindCtxt NameSet    
  | ClsDeclCtxt   Name       
  | InstDeclCtxt  NameSet    
                             
  | HsBootCtxt NameSet       
  | RoleAnnotCtxt NameSet    
                             
instance Outputable HsSigCtxt where
    ppr :: HsSigCtxt -> MsgDoc
ppr (TopSigCtxt ns :: NameSet
ns) = String -> MsgDoc
text "TopSigCtxt" MsgDoc -> MsgDoc -> MsgDoc
<+> NameSet -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr NameSet
ns
    ppr (LocalBindCtxt ns :: NameSet
ns) = String -> MsgDoc
text "LocalBindCtxt" MsgDoc -> MsgDoc -> MsgDoc
<+> NameSet -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr NameSet
ns
    ppr (ClsDeclCtxt n :: Name
n) = String -> MsgDoc
text "ClsDeclCtxt" MsgDoc -> MsgDoc -> MsgDoc
<+> Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
n
    ppr (InstDeclCtxt ns :: NameSet
ns) = String -> MsgDoc
text "InstDeclCtxt" MsgDoc -> MsgDoc -> MsgDoc
<+> NameSet -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr NameSet
ns
    ppr (HsBootCtxt ns :: NameSet
ns) = String -> MsgDoc
text "HsBootCtxt" MsgDoc -> MsgDoc -> MsgDoc
<+> NameSet -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr NameSet
ns
    ppr (RoleAnnotCtxt ns :: NameSet
ns) = String -> MsgDoc
text "RoleAnnotCtxt" MsgDoc -> MsgDoc -> MsgDoc
<+> NameSet -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr NameSet
ns
lookupSigOccRn :: HsSigCtxt
               -> Sig GhcPs
               -> Located RdrName -> RnM (Located Name)
lookupSigOccRn :: HsSigCtxt -> Sig GhcPs -> Located RdrName -> RnM (Located Name)
lookupSigOccRn ctxt :: HsSigCtxt
ctxt sig :: Sig GhcPs
sig = HsSigCtxt -> MsgDoc -> Located RdrName -> RnM (Located Name)
lookupSigCtxtOccRn HsSigCtxt
ctxt (Sig GhcPs -> MsgDoc
forall name. Sig name -> MsgDoc
hsSigDoc Sig GhcPs
sig)
lookupSigCtxtOccRn :: HsSigCtxt
                   -> SDoc         
                                   
                   -> Located RdrName -> RnM (Located Name)
lookupSigCtxtOccRn :: HsSigCtxt -> MsgDoc -> Located RdrName -> RnM (Located Name)
lookupSigCtxtOccRn ctxt :: HsSigCtxt
ctxt what :: MsgDoc
what
  = (SrcSpanLess (Located RdrName) -> TcM (SrcSpanLess (Located Name)))
-> Located RdrName -> RnM (Located Name)
forall a b.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b)) -> a -> TcM b
wrapLocM ((SrcSpanLess (Located RdrName)
  -> TcM (SrcSpanLess (Located Name)))
 -> Located RdrName -> RnM (Located Name))
-> (SrcSpanLess (Located RdrName)
    -> TcM (SrcSpanLess (Located Name)))
-> Located RdrName
-> RnM (Located Name)
forall a b. (a -> b) -> a -> b
$ \ rdr_name :: SrcSpanLess (Located RdrName)
rdr_name ->
    do { Either MsgDoc Name
mb_name <- HsSigCtxt -> MsgDoc -> RdrName -> RnM (Either MsgDoc Name)
lookupBindGroupOcc HsSigCtxt
ctxt MsgDoc
what SrcSpanLess (Located RdrName)
RdrName
rdr_name
       ; case Either MsgDoc Name
mb_name of
           Left err :: MsgDoc
err   -> do { MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr MsgDoc
err; Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return (RdrName -> Name
mkUnboundNameRdr SrcSpanLess (Located RdrName)
RdrName
rdr_name) }
           Right name :: Name
name -> Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
name }
lookupBindGroupOcc :: HsSigCtxt
                   -> SDoc
                   -> RdrName -> RnM (Either MsgDoc Name)
lookupBindGroupOcc :: HsSigCtxt -> MsgDoc -> RdrName -> RnM (Either MsgDoc Name)
lookupBindGroupOcc ctxt :: HsSigCtxt
ctxt what :: MsgDoc
what rdr_name :: RdrName
rdr_name
  | Just n :: Name
n <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr_name
  = Name -> RnM (Either MsgDoc Name)
lookupExactOcc_either Name
n   
                              
      
      
      
  | Just (rdr_mod :: Module
rdr_mod, rdr_occ :: OccName
rdr_occ) <- RdrName -> Maybe (Module, OccName)
isOrig_maybe RdrName
rdr_name
  = do { Name
n' <- Module -> OccName -> RnM Name
forall a b. Module -> OccName -> TcRnIf a b Name
lookupOrig Module
rdr_mod OccName
rdr_occ
       ; Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right Name
n') }
  | Bool
otherwise
  = case HsSigCtxt
ctxt of
      HsBootCtxt ns :: NameSet
ns    -> (Name -> Bool) -> RnM (Either MsgDoc Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
      TopSigCtxt ns :: NameSet
ns    -> (Name -> Bool) -> RnM (Either MsgDoc Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
      RoleAnnotCtxt ns :: NameSet
ns -> (Name -> Bool) -> RnM (Either MsgDoc Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
      LocalBindCtxt ns :: NameSet
ns -> NameSet -> RnM (Either MsgDoc Name)
lookup_group NameSet
ns
      ClsDeclCtxt  cls :: Name
cls -> Name -> RnM (Either MsgDoc Name)
lookup_cls_op Name
cls
      InstDeclCtxt ns :: NameSet
ns  -> (Name -> Bool) -> RnM (Either MsgDoc Name)
lookup_top (Name -> NameSet -> Bool
`elemNameSet` NameSet
ns)
  where
    lookup_cls_op :: Name -> RnM (Either MsgDoc Name)
lookup_cls_op cls :: Name
cls
      = Bool -> Name -> MsgDoc -> RdrName -> RnM (Either MsgDoc Name)
lookupSubBndrOcc Bool
True Name
cls MsgDoc
doc RdrName
rdr_name
      where
        doc :: MsgDoc
doc = String -> MsgDoc
text "method of class" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
cls)
    lookup_top :: (Name -> Bool) -> RnM (Either MsgDoc Name)
lookup_top keep_me :: Name -> Bool
keep_me
      = do { GlobalRdrEnv
env <- TcRn GlobalRdrEnv
getGlobalRdrEnv
           ; let all_gres :: [GlobalRdrElt]
all_gres = GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
env (RdrName -> OccName
rdrNameOcc RdrName
rdr_name)
           ; case (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> Bool
keep_me (Name -> Bool) -> (GlobalRdrElt -> Name) -> GlobalRdrElt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Name
gre_name) [GlobalRdrElt]
all_gres of
               [] | [GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
all_gres -> MsgDoc -> RnM (Either MsgDoc Name)
forall (m :: * -> *) b. Monad m => MsgDoc -> m (Either MsgDoc b)
bale_out_with MsgDoc
Outputable.empty
                  | Bool
otherwise     -> MsgDoc -> RnM (Either MsgDoc Name)
forall (m :: * -> *) b. Monad m => MsgDoc -> m (Either MsgDoc b)
bale_out_with MsgDoc
local_msg
               (gre :: GlobalRdrElt
gre:_)            -> Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right (GlobalRdrElt -> Name
gre_name GlobalRdrElt
gre)) }
    lookup_group :: NameSet -> RnM (Either MsgDoc Name)
lookup_group bound_names :: NameSet
bound_names  
      = do { Maybe Name
mname <- RdrName -> RnM (Maybe Name)
lookupLocalOccRn_maybe RdrName
rdr_name
           ; case Maybe Name
mname of
               Just n :: Name
n
                 | Name
n Name -> NameSet -> Bool
`elemNameSet` NameSet
bound_names -> Either MsgDoc Name -> RnM (Either MsgDoc Name)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> Either MsgDoc Name
forall a b. b -> Either a b
Right Name
n)
                 | Bool
otherwise                   -> MsgDoc -> RnM (Either MsgDoc Name)
forall (m :: * -> *) b. Monad m => MsgDoc -> m (Either MsgDoc b)
bale_out_with MsgDoc
local_msg
               Nothing                         -> MsgDoc -> RnM (Either MsgDoc Name)
forall (m :: * -> *) b. Monad m => MsgDoc -> m (Either MsgDoc b)
bale_out_with MsgDoc
Outputable.empty }
    bale_out_with :: MsgDoc -> m (Either MsgDoc b)
bale_out_with msg :: MsgDoc
msg
        = Either MsgDoc b -> m (Either MsgDoc b)
forall (m :: * -> *) a. Monad m => a -> m a
return (MsgDoc -> Either MsgDoc b
forall a b. a -> Either a b
Left ([MsgDoc] -> MsgDoc
sep [ String -> MsgDoc
text "The" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
what
                                MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text "for" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name)
                           , Int -> MsgDoc -> MsgDoc
nest 2 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$ String -> MsgDoc
text "lacks an accompanying binding"]
                       MsgDoc -> MsgDoc -> MsgDoc
$$ Int -> MsgDoc -> MsgDoc
nest 2 MsgDoc
msg))
    local_msg :: MsgDoc
local_msg = MsgDoc -> MsgDoc
parens (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$ String -> MsgDoc
text "The"  MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
what MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit "must be given where")
                           MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
rdr_name) MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text "is declared"
lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)]
lookupLocalTcNames :: HsSigCtxt -> MsgDoc -> RdrName -> RnM [(RdrName, Name)]
lookupLocalTcNames ctxt :: HsSigCtxt
ctxt what :: MsgDoc
what rdr_name :: RdrName
rdr_name
  = do { [Either MsgDoc (RdrName, Name)]
mb_gres <- (RdrName
 -> IOEnv (Env TcGblEnv TcLclEnv) (Either MsgDoc (RdrName, Name)))
-> [RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) [Either MsgDoc (RdrName, Name)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) (Either MsgDoc (RdrName, Name))
lookup (RdrName -> [RdrName]
dataTcOccs RdrName
rdr_name)
       ; let (errs :: [MsgDoc]
errs, names :: [(RdrName, Name)]
names) = [Either MsgDoc (RdrName, Name)] -> ([MsgDoc], [(RdrName, Name)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either MsgDoc (RdrName, Name)]
mb_gres
       ; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(RdrName, Name)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RdrName, Name)]
names) (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr ([MsgDoc] -> MsgDoc
forall a. [a] -> a
head [MsgDoc]
errs) 
       ; [(RdrName, Name)] -> RnM [(RdrName, Name)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(RdrName, Name)]
names }
  where
    lookup :: RdrName
-> IOEnv (Env TcGblEnv TcLclEnv) (Either MsgDoc (RdrName, Name))
lookup rdr :: RdrName
rdr = do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
                    ; Either MsgDoc Name
nameEither <- HsSigCtxt -> MsgDoc -> RdrName -> RnM (Either MsgDoc Name)
lookupBindGroupOcc HsSigCtxt
ctxt MsgDoc
what RdrName
rdr
                    ; Either MsgDoc (RdrName, Name)
-> IOEnv (Env TcGblEnv TcLclEnv) (Either MsgDoc (RdrName, Name))
forall (m :: * -> *) a. Monad m => a -> m a
return (Module
-> RdrName -> Either MsgDoc Name -> Either MsgDoc (RdrName, Name)
forall a.
(HasOccName a, Outputable a) =>
Module -> a -> Either MsgDoc Name -> Either MsgDoc (a, Name)
guard_builtin_syntax Module
this_mod RdrName
rdr Either MsgDoc Name
nameEither) }
    
    guard_builtin_syntax :: Module -> a -> Either MsgDoc Name -> Either MsgDoc (a, Name)
guard_builtin_syntax this_mod :: Module
this_mod rdr :: a
rdr (Right name :: Name
name)
      | Just _ <- OccName -> Maybe Name
isBuiltInOcc_maybe (a -> OccName
forall name. HasOccName name => name -> OccName
occName a
rdr)
      , Module
this_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name
      = MsgDoc -> Either MsgDoc (a, Name)
forall a b. a -> Either a b
Left ([MsgDoc] -> MsgDoc
hsep [String -> MsgDoc
text "Illegal", MsgDoc
what, String -> MsgDoc
text "of built-in syntax:", a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
rdr])
      | Bool
otherwise
      = (a, Name) -> Either MsgDoc (a, Name)
forall a b. b -> Either a b
Right (a
rdr, Name
name)
    guard_builtin_syntax _ _ (Left err :: MsgDoc
err) = MsgDoc -> Either MsgDoc (a, Name)
forall a b. a -> Either a b
Left MsgDoc
err
dataTcOccs :: RdrName -> [RdrName]
dataTcOccs :: RdrName -> [RdrName]
dataTcOccs rdr_name :: 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
lookupIfThenElse :: RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
lookupIfThenElse :: RnM (Maybe (SyntaxExpr GhcRn), NameSet)
lookupIfThenElse
  = do { Bool
rebindable_on <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
       ; if Bool -> Bool
not Bool
rebindable_on
         then (Maybe (SyntaxExpr GhcRn), NameSet)
-> RnM (Maybe (SyntaxExpr GhcRn), NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SyntaxExpr GhcRn)
forall a. Maybe a
Nothing, NameSet
emptyFVs)
         else do { Name
ite <- RdrName -> RnM Name
lookupOccRn (FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit "ifThenElse"))
                 ; (Maybe (SyntaxExpr GhcRn), NameSet)
-> RnM (Maybe (SyntaxExpr GhcRn), NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return ( SyntaxExpr GhcRn -> Maybe (SyntaxExpr GhcRn)
forall a. a -> Maybe a
Just (Name -> SyntaxExpr GhcRn
mkRnSyntaxExpr Name
ite)
                          , Name -> NameSet
unitFV Name
ite ) } }
lookupSyntaxName' :: Name          
                  -> RnM Name      
lookupSyntaxName' :: Name -> RnM Name
lookupSyntaxName' std_name :: Name
std_name
  = do { Bool
rebindable_on <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
       ; if Bool -> Bool
not Bool
rebindable_on then
           Name -> RnM Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
std_name
         else
            
           RdrName -> RnM Name
lookupOccRn (OccName -> RdrName
mkRdrUnqual (Name -> OccName
nameOccName Name
std_name)) }
lookupSyntaxName :: Name                             
                 -> RnM (SyntaxExpr GhcRn, FreeVars) 
                                                     
lookupSyntaxName :: Name -> RnM (SyntaxExpr GhcRn, NameSet)
lookupSyntaxName std_name :: Name
std_name
  = do { Bool
rebindable_on <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
       ; if Bool -> Bool
not Bool
rebindable_on then
           (SyntaxExpr GhcRn, NameSet) -> RnM (SyntaxExpr GhcRn, NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> SyntaxExpr GhcRn
mkRnSyntaxExpr Name
std_name, NameSet
emptyFVs)
         else
            
           do { Name
usr_name <- RdrName -> RnM Name
lookupOccRn (OccName -> RdrName
mkRdrUnqual (Name -> OccName
nameOccName Name
std_name))
              ; (SyntaxExpr GhcRn, NameSet) -> RnM (SyntaxExpr GhcRn, NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> SyntaxExpr GhcRn
mkRnSyntaxExpr Name
usr_name, Name -> NameSet
unitFV Name
usr_name) } }
lookupSyntaxNames :: [Name]                         
     -> RnM ([HsExpr GhcRn], FreeVars) 
   
lookupSyntaxNames :: [Name] -> RnM ([HsExpr GhcRn], NameSet)
lookupSyntaxNames std_names :: [Name]
std_names
  = do { Bool
rebindable_on <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
       ; if Bool -> Bool
not Bool
rebindable_on then
             ([HsExpr GhcRn], NameSet) -> RnM ([HsExpr GhcRn], NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Name -> HsExpr GhcRn) -> [Name] -> [HsExpr GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (XVar GhcRn -> Located (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar GhcRn
NoExt
noExt (Located Name -> HsExpr GhcRn)
-> (Name -> Located Name) -> Name -> HsExpr GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc) [Name]
std_names, NameSet
emptyFVs)
        else
          do { [Name]
usr_names <- (Name -> RnM Name)
-> [Name] -> IOEnv (Env TcGblEnv TcLclEnv) [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (RdrName -> RnM Name
lookupOccRn (RdrName -> RnM Name) -> (Name -> RdrName) -> Name -> RnM Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> (Name -> OccName) -> Name -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName) [Name]
std_names
             ; ([HsExpr GhcRn], NameSet) -> RnM ([HsExpr GhcRn], NameSet)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Name -> HsExpr GhcRn) -> [Name] -> [HsExpr GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (XVar GhcRn -> Located (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar GhcRn
NoExt
noExt (Located Name -> HsExpr GhcRn)
-> (Name -> Located Name) -> Name -> HsExpr GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc) [Name]
usr_names, [Name] -> NameSet
mkFVs [Name]
usr_names) } }
opDeclErr :: RdrName -> SDoc
opDeclErr :: RdrName -> MsgDoc
opDeclErr n :: RdrName
n
  = MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text "Illegal declaration of a type or class operator" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
n))
       2 (String -> MsgDoc
text "Use TypeOperators to declare operators in type and declarations")
badOrigBinding :: RdrName -> SDoc
badOrigBinding :: RdrName -> MsgDoc
badOrigBinding name :: RdrName
name
  | Just _ <- OccName -> Maybe Name
isBuiltInOcc_maybe OccName
occ
  = String -> MsgDoc
text "Illegal binding of built-in syntax:" MsgDoc -> MsgDoc -> MsgDoc
<+> OccName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr OccName
occ
    
  | Bool
otherwise
  = String -> MsgDoc
text "Cannot redefine a Name retrieved by a Template Haskell quote:"
    MsgDoc -> MsgDoc -> MsgDoc
<+> RdrName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr RdrName
name
    
    
    
    
    
    
  where
    occ :: OccName
occ = RdrName -> OccName
rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ RdrName -> RdrName
filterCTuple RdrName
name