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

{-# LANGUAGE CPP, DeriveDataTypeable #-}

-- |
-- #name_types#
-- GHC uses several kinds of name internally:
--
-- * 'GHC.Types.Name.Occurrence.OccName': see "GHC.Types.Name.Occurrence#name_types"
--
-- * 'GHC.Types.Name.Reader.RdrName' is the type of names that come directly from the parser. They
--   have not yet had their scoping and binding resolved by the renamer and can be
--   thought of to a first approximation as an 'GHC.Types.Name.Occurrence.OccName' with an optional module
--   qualifier
--
-- * 'GHC.Types.Name.Name': see "GHC.Types.Name#name_types"
--
-- * 'GHC.Types.Id.Id': see "GHC.Types.Id#name_types"
--
-- * 'GHC.Types.Var.Var': see "GHC.Types.Var#name_types"

module GHC.Types.Name.Reader (
        -- * The main type
        RdrName(..),    -- Constructors exported only to GHC.Iface.Binary

        -- ** Construction
        mkRdrUnqual, mkRdrQual,
        mkUnqual, mkVarUnqual, mkQual, mkOrig,
        nameRdrName, getRdrName,

        -- ** Destruction
        rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName,
        isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual,
        isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,

        -- * Local mapping of 'RdrName' to 'Name.Name'
        LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,
        lookupLocalRdrEnv, lookupLocalRdrOcc,
        elemLocalRdrEnv, inLocalRdrEnvScope,
        localRdrEnvElts, delLocalRdrEnvList,

        -- * Global mapping of 'RdrName' to 'GlobalRdrElt's
        GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
        lookupGlobalRdrEnv, extendGlobalRdrEnv, greOccName, shadowNames,
        pprGlobalRdrEnv, globalRdrEnvElts,
        lookupGRE_RdrName, lookupGRE_RdrName', lookupGRE_Name,
        lookupGRE_GreName, lookupGRE_FieldLabel,
        lookupGRE_Name_OccName,
        getGRE_NameQualifier_maybes,
        transformGREs, pickGREs, pickGREsModExp,

        -- * GlobalRdrElts
        gresFromAvails, gresFromAvail, localGREsFromAvail, availFromGRE,
        greRdrNames, greSrcSpan, greQualModName,
        gresToAvailInfo,
        greDefinitionModule, greDefinitionSrcSpan,
        greMangledName, grePrintableName,
        greFieldLabel,

        -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
        GlobalRdrElt(..), isLocalGRE, isRecFldGRE,
        isDuplicateRecFldGRE, isNoFieldSelectorGRE, isFieldSelectorGRE,
        unQualOK, qualSpecOK, unQualSpecOK,
        pprNameProvenance,
        GreName(..), greNameSrcSpan,
        Parent(..), greParent_maybe,
        ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
        importSpecLoc, importSpecModule, isExplicitItem, bestImport,

        -- * Utils for StarIsType
        starInfo,

        -- * Utils
        opIsAt,
  ) where

#include "HsVersions.h"

import GHC.Prelude

import GHC.Unit.Module
import GHC.Types.Name
import GHC.Types.Avail
import GHC.Types.Name.Set
import GHC.Data.Maybe
import GHC.Types.SrcLoc as SrcLoc
import GHC.Data.FastString
import GHC.Types.FieldLabel
import GHC.Utils.Outputable
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.Unique.Set
import GHC.Utils.Misc as Utils
import GHC.Utils.Panic
import GHC.Types.Name.Env

import Data.Data
import Data.List( sortBy )

{-
************************************************************************
*                                                                      *
\subsection{The main data type}
*                                                                      *
************************************************************************
-}

-- | Reader Name
--
-- Do not use the data constructors of RdrName directly: prefer the family
-- of functions that creates them, such as 'mkRdrUnqual'
--
-- - Note: A Located RdrName will only have API Annotations if it is a
--         compound one,
--   e.g.
--
-- > `bar`
-- > ( ~ )
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',
--           'GHC.Parser.Annotation.AnnOpen'  @'('@ or @'['@ or @'[:'@,
--           'GHC.Parser.Annotation.AnnClose' @')'@ or @']'@ or @':]'@,,
--           'GHC.Parser.Annotation.AnnBackquote' @'`'@,
--           'GHC.Parser.Annotation.AnnVal'
--           'GHC.Parser.Annotation.AnnTilde',

-- For details on above see note [exact print annotations] in "GHC.Parser.Annotation"
data RdrName
  = Unqual OccName
        -- ^ Unqualified  name
        --
        -- Used for ordinary, unqualified occurrences, e.g. @x@, @y@ or @Foo@.
        -- Create such a 'RdrName' with 'mkRdrUnqual'

  | Qual ModuleName OccName
        -- ^ Qualified name
        --
        -- A qualified name written by the user in
        -- /source/ code.  The module isn't necessarily
        -- the module where the thing is defined;
        -- just the one from which it is imported.
        -- Examples are @Bar.x@, @Bar.y@ or @Bar.Foo@.
        -- Create such a 'RdrName' with 'mkRdrQual'

  | Orig Module OccName
        -- ^ Original name
        --
        -- An original name; the module is the /defining/ module.
        -- This is used when GHC generates code that will be fed
        -- into the renamer (e.g. from deriving clauses), but where
        -- we want to say \"Use Prelude.map dammit\". One of these
        -- can be created with 'mkOrig'

  | Exact Name
        -- ^ Exact name
        --
        -- We know exactly the 'Name'. This is used:
        --
        --  (1) When the parser parses built-in syntax like @[]@
        --      and @(,)@, but wants a 'RdrName' from it
        --
        --  (2) By Template Haskell, when TH has generated a unique name
        --
        -- Such a 'RdrName' can be created by using 'getRdrName' on a 'Name'
  deriving Typeable RdrName
RdrName -> DataType
RdrName -> Constr
(forall b. Data b => b -> b) -> RdrName -> RdrName
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RdrName -> u
forall u. (forall d. Data d => d -> u) -> RdrName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RdrName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RdrName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RdrName -> m RdrName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RdrName -> m RdrName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RdrName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RdrName -> c RdrName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RdrName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RdrName)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RdrName -> m RdrName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RdrName -> m RdrName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RdrName -> m RdrName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RdrName -> m RdrName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RdrName -> m RdrName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RdrName -> m RdrName
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RdrName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RdrName -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> RdrName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RdrName -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RdrName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RdrName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RdrName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RdrName -> r
gmapT :: (forall b. Data b => b -> b) -> RdrName -> RdrName
$cgmapT :: (forall b. Data b => b -> b) -> RdrName -> RdrName
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RdrName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RdrName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RdrName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RdrName)
dataTypeOf :: RdrName -> DataType
$cdataTypeOf :: RdrName -> DataType
toConstr :: RdrName -> Constr
$ctoConstr :: RdrName -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RdrName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RdrName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RdrName -> c RdrName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RdrName -> c RdrName
Data

{-
************************************************************************
*                                                                      *
\subsection{Simple functions}
*                                                                      *
************************************************************************
-}

instance HasOccName RdrName where
  occName :: RdrName -> OccName
occName = RdrName -> OccName
rdrNameOcc

rdrNameOcc :: RdrName -> OccName
rdrNameOcc :: RdrName -> OccName
rdrNameOcc (Qual ModuleName
_ OccName
occ) = OccName
occ
rdrNameOcc (Unqual OccName
occ) = OccName
occ
rdrNameOcc (Orig Module
_ OccName
occ) = OccName
occ
rdrNameOcc (Exact Name
name) = Name -> OccName
nameOccName Name
name

rdrNameSpace :: RdrName -> NameSpace
rdrNameSpace :: RdrName -> NameSpace
rdrNameSpace = OccName -> NameSpace
occNameSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc

-- demoteRdrName lowers the NameSpace of RdrName.
-- See Note [Demotion] in GHC.Rename.Env
demoteRdrName :: RdrName -> Maybe RdrName
demoteRdrName :: RdrName -> Maybe RdrName
demoteRdrName (Unqual OccName
occ) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OccName -> RdrName
Unqual (OccName -> Maybe OccName
demoteOccName OccName
occ)
demoteRdrName (Qual ModuleName
m OccName
occ) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModuleName -> OccName -> RdrName
Qual ModuleName
m) (OccName -> Maybe OccName
demoteOccName OccName
occ)
demoteRdrName (Orig Module
_ OccName
_) = forall a. Maybe a
Nothing
demoteRdrName (Exact Name
_) = forall a. Maybe a
Nothing

-- promoteRdrName promotes the NameSpace of RdrName.
-- See Note [Promotion] in GHC.Rename.Env.
promoteRdrName :: RdrName -> Maybe RdrName
promoteRdrName :: RdrName -> Maybe RdrName
promoteRdrName (Unqual OccName
occ) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OccName -> RdrName
Unqual (OccName -> Maybe OccName
promoteOccName OccName
occ)
promoteRdrName (Qual ModuleName
m OccName
occ) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModuleName -> OccName -> RdrName
Qual ModuleName
m) (OccName -> Maybe OccName
promoteOccName OccName
occ)
promoteRdrName (Orig Module
_ OccName
_) = forall a. Maybe a
Nothing
promoteRdrName (Exact Name
_)  = forall a. Maybe a
Nothing

        -- These two are the basic constructors
mkRdrUnqual :: OccName -> RdrName
mkRdrUnqual :: OccName -> RdrName
mkRdrUnqual OccName
occ = OccName -> RdrName
Unqual OccName
occ

mkRdrQual :: ModuleName -> OccName -> RdrName
mkRdrQual :: ModuleName -> OccName -> RdrName
mkRdrQual ModuleName
mod OccName
occ = ModuleName -> OccName -> RdrName
Qual ModuleName
mod OccName
occ

mkOrig :: Module -> OccName -> RdrName
mkOrig :: Module -> OccName -> RdrName
mkOrig Module
mod OccName
occ = Module -> OccName -> RdrName
Orig Module
mod OccName
occ

---------------
        -- These two are used when parsing source files
        -- They do encode the module and occurrence names
mkUnqual :: NameSpace -> FastString -> RdrName
mkUnqual :: NameSpace -> FastString -> RdrName
mkUnqual NameSpace
sp FastString
n = OccName -> RdrName
Unqual (NameSpace -> FastString -> OccName
mkOccNameFS NameSpace
sp FastString
n)

mkVarUnqual :: FastString -> RdrName
mkVarUnqual :: FastString -> RdrName
mkVarUnqual FastString
n = OccName -> RdrName
Unqual (FastString -> OccName
mkVarOccFS FastString
n)

-- | Make a qualified 'RdrName' in the given namespace and where the 'ModuleName' and
-- the 'OccName' are taken from the first and second elements of the tuple respectively
mkQual :: NameSpace -> (FastString, FastString) -> RdrName
mkQual :: NameSpace -> (FastString, FastString) -> RdrName
mkQual NameSpace
sp (FastString
m, FastString
n) = ModuleName -> OccName -> RdrName
Qual (FastString -> ModuleName
mkModuleNameFS FastString
m) (NameSpace -> FastString -> OccName
mkOccNameFS NameSpace
sp FastString
n)

getRdrName :: NamedThing thing => thing -> RdrName
getRdrName :: forall thing. NamedThing thing => thing -> RdrName
getRdrName thing
name = Name -> RdrName
nameRdrName (forall a. NamedThing a => a -> Name
getName thing
name)

nameRdrName :: Name -> RdrName
nameRdrName :: Name -> RdrName
nameRdrName Name
name = Name -> RdrName
Exact Name
name
-- Keep the Name even for Internal names, so that the
-- unique is still there for debug printing, particularly
-- of Types (which are converted to IfaceTypes before printing)

nukeExact :: Name -> RdrName
nukeExact :: Name -> RdrName
nukeExact Name
n
  | Name -> Bool
isExternalName Name
n = Module -> OccName -> RdrName
Orig (HasDebugCallStack => Name -> Module
nameModule Name
n) (Name -> OccName
nameOccName Name
n)
  | Bool
otherwise        = OccName -> RdrName
Unqual (Name -> OccName
nameOccName Name
n)

isRdrDataCon :: RdrName -> Bool
isRdrTyVar   :: RdrName -> Bool
isRdrTc      :: RdrName -> Bool

isRdrDataCon :: RdrName -> Bool
isRdrDataCon RdrName
rn = OccName -> Bool
isDataOcc (RdrName -> OccName
rdrNameOcc RdrName
rn)
isRdrTyVar :: RdrName -> Bool
isRdrTyVar   RdrName
rn = OccName -> Bool
isTvOcc   (RdrName -> OccName
rdrNameOcc RdrName
rn)
isRdrTc :: RdrName -> Bool
isRdrTc      RdrName
rn = OccName -> Bool
isTcOcc   (RdrName -> OccName
rdrNameOcc RdrName
rn)

isSrcRdrName :: RdrName -> Bool
isSrcRdrName :: RdrName -> Bool
isSrcRdrName (Unqual OccName
_) = Bool
True
isSrcRdrName (Qual ModuleName
_ OccName
_) = Bool
True
isSrcRdrName RdrName
_          = Bool
False

isUnqual :: RdrName -> Bool
isUnqual :: RdrName -> Bool
isUnqual (Unqual OccName
_) = Bool
True
isUnqual RdrName
_          = Bool
False

isQual :: RdrName -> Bool
isQual :: RdrName -> Bool
isQual (Qual ModuleName
_ OccName
_) = Bool
True
isQual RdrName
_          = Bool
False

isQual_maybe :: RdrName -> Maybe (ModuleName, OccName)
isQual_maybe :: RdrName -> Maybe (ModuleName, OccName)
isQual_maybe (Qual ModuleName
m OccName
n) = forall a. a -> Maybe a
Just (ModuleName
m,OccName
n)
isQual_maybe RdrName
_          = forall a. Maybe a
Nothing

isOrig :: RdrName -> Bool
isOrig :: RdrName -> Bool
isOrig (Orig Module
_ OccName
_) = Bool
True
isOrig RdrName
_          = Bool
False

isOrig_maybe :: RdrName -> Maybe (Module, OccName)
isOrig_maybe :: RdrName -> Maybe (Module, OccName)
isOrig_maybe (Orig Module
m OccName
n) = forall a. a -> Maybe a
Just (Module
m,OccName
n)
isOrig_maybe RdrName
_          = forall a. Maybe a
Nothing

isExact :: RdrName -> Bool
isExact :: RdrName -> Bool
isExact (Exact Name
_) = Bool
True
isExact RdrName
_         = Bool
False

isExact_maybe :: RdrName -> Maybe Name
isExact_maybe :: RdrName -> Maybe Name
isExact_maybe (Exact Name
n) = forall a. a -> Maybe a
Just Name
n
isExact_maybe RdrName
_         = forall a. Maybe a
Nothing

{-
************************************************************************
*                                                                      *
\subsection{Instances}
*                                                                      *
************************************************************************
-}

instance Outputable RdrName where
    ppr :: RdrName -> SDoc
ppr (Exact Name
name)   = forall a. Outputable a => a -> SDoc
ppr Name
name
    ppr (Unqual OccName
occ)   = forall a. Outputable a => a -> SDoc
ppr OccName
occ
    ppr (Qual ModuleName
mod OccName
occ) = forall a. Outputable a => a -> SDoc
ppr ModuleName
mod SDoc -> SDoc -> SDoc
<> SDoc
dot SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr OccName
occ
    ppr (Orig Module
mod OccName
occ) = (PprStyle -> SDoc) -> SDoc
getPprStyle (\PprStyle
sty -> PprStyle -> Module -> OccName -> SDoc
pprModulePrefix PprStyle
sty Module
mod OccName
occ SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr OccName
occ)

instance OutputableBndr RdrName where
    pprBndr :: BindingSite -> RdrName -> SDoc
pprBndr BindingSite
_ RdrName
n
        | OccName -> Bool
isTvOcc (RdrName -> OccName
rdrNameOcc RdrName
n) = Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr RdrName
n
        | Bool
otherwise              = forall a. Outputable a => a -> SDoc
ppr RdrName
n

    pprInfixOcc :: RdrName -> SDoc
pprInfixOcc  RdrName
rdr = Bool -> SDoc -> SDoc
pprInfixVar  (OccName -> Bool
isSymOcc (RdrName -> OccName
rdrNameOcc RdrName
rdr)) (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr)
    pprPrefixOcc :: RdrName -> SDoc
pprPrefixOcc RdrName
rdr
      | Just Name
name <- RdrName -> Maybe Name
isExact_maybe RdrName
rdr = forall a. NamedThing a => a -> SDoc
pprPrefixName Name
name
             -- pprPrefixName has some special cases, so
             -- we delegate to them rather than reproduce them
      | Bool
otherwise = Bool -> SDoc -> SDoc
pprPrefixVar (OccName -> Bool
isSymOcc (RdrName -> OccName
rdrNameOcc RdrName
rdr)) (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr)

instance Eq RdrName where
    (Exact Name
n1)    == :: RdrName -> RdrName -> Bool
== (Exact Name
n2)    = Name
n1forall a. Eq a => a -> a -> Bool
==Name
n2
        -- Convert exact to orig
    (Exact Name
n1)    == r2 :: RdrName
r2@(Orig Module
_ OccName
_) = Name -> RdrName
nukeExact Name
n1 forall a. Eq a => a -> a -> Bool
== RdrName
r2
    r1 :: RdrName
r1@(Orig Module
_ OccName
_) == (Exact Name
n2)    = RdrName
r1 forall a. Eq a => a -> a -> Bool
== Name -> RdrName
nukeExact Name
n2

    (Orig Module
m1 OccName
o1)  == (Orig Module
m2 OccName
o2)  = Module
m1forall a. Eq a => a -> a -> Bool
==Module
m2 Bool -> Bool -> Bool
&& OccName
o1forall a. Eq a => a -> a -> Bool
==OccName
o2
    (Qual ModuleName
m1 OccName
o1)  == (Qual ModuleName
m2 OccName
o2)  = ModuleName
m1forall a. Eq a => a -> a -> Bool
==ModuleName
m2 Bool -> Bool -> Bool
&& OccName
o1forall a. Eq a => a -> a -> Bool
==OccName
o2
    (Unqual OccName
o1)   == (Unqual OccName
o2)   = OccName
o1forall a. Eq a => a -> a -> Bool
==OccName
o2
    RdrName
_             == RdrName
_             = Bool
False

instance Ord RdrName where
    RdrName
a <= :: RdrName -> RdrName -> Bool
<= RdrName
b = case (RdrName
a forall a. Ord a => a -> a -> Ordering
`compare` RdrName
b) of { Ordering
LT -> Bool
True;  Ordering
EQ -> Bool
True;  Ordering
GT -> Bool
False }
    RdrName
a < :: RdrName -> RdrName -> Bool
<  RdrName
b = case (RdrName
a forall a. Ord a => a -> a -> Ordering
`compare` RdrName
b) of { Ordering
LT -> Bool
True;  Ordering
EQ -> Bool
False; Ordering
GT -> Bool
False }
    RdrName
a >= :: RdrName -> RdrName -> Bool
>= RdrName
b = case (RdrName
a forall a. Ord a => a -> a -> Ordering
`compare` RdrName
b) of { Ordering
LT -> Bool
False; Ordering
EQ -> Bool
True;  Ordering
GT -> Bool
True  }
    RdrName
a > :: RdrName -> RdrName -> Bool
>  RdrName
b = case (RdrName
a forall a. Ord a => a -> a -> Ordering
`compare` RdrName
b) of { Ordering
LT -> Bool
False; Ordering
EQ -> Bool
False; Ordering
GT -> Bool
True  }

        -- Exact < Unqual < Qual < Orig
        -- [Note: Apr 2004] We used to use nukeExact to convert Exact to Orig
        --      before comparing so that Prelude.map == the exact Prelude.map, but
        --      that meant that we reported duplicates when renaming bindings
        --      generated by Template Haskell; e.g
        --      do { n1 <- newName "foo"; n2 <- newName "foo";
        --           <decl involving n1,n2> }
        --      I think we can do without this conversion
    compare :: RdrName -> RdrName -> Ordering
compare (Exact Name
n1) (Exact Name
n2) = Name
n1 forall a. Ord a => a -> a -> Ordering
`compare` Name
n2
    compare (Exact Name
_)  RdrName
_          = Ordering
LT

    compare (Unqual OccName
_)   (Exact Name
_)    = Ordering
GT
    compare (Unqual OccName
o1)  (Unqual  OccName
o2) = OccName
o1 forall a. Ord a => a -> a -> Ordering
`compare` OccName
o2
    compare (Unqual OccName
_)   RdrName
_            = Ordering
LT

    compare (Qual ModuleName
_ OccName
_)   (Exact Name
_)    = Ordering
GT
    compare (Qual ModuleName
_ OccName
_)   (Unqual OccName
_)   = Ordering
GT
    compare (Qual ModuleName
m1 OccName
o1) (Qual ModuleName
m2 OccName
o2) = (OccName
o1 forall a. Ord a => a -> a -> Ordering
`compare` OccName
o2) Ordering -> Ordering -> Ordering
`thenCmp` (ModuleName
m1 forall a. Ord a => a -> a -> Ordering
`compare` ModuleName
m2)
    compare (Qual ModuleName
_ OccName
_)   (Orig Module
_ OccName
_)   = Ordering
LT

    compare (Orig Module
m1 OccName
o1) (Orig Module
m2 OccName
o2) = (OccName
o1 forall a. Ord a => a -> a -> Ordering
`compare` OccName
o2) Ordering -> Ordering -> Ordering
`thenCmp` (Module
m1 forall a. Ord a => a -> a -> Ordering
`compare` Module
m2)
    compare (Orig Module
_ OccName
_)   RdrName
_            = Ordering
GT

{-
************************************************************************
*                                                                      *
                        LocalRdrEnv
*                                                                      *
************************************************************************
-}

{- Note [LocalRdrEnv]
~~~~~~~~~~~~~~~~~~~~~
The LocalRdrEnv is used to store local bindings (let, where, lambda, case).

* It is keyed by OccName, because we never use it for qualified names.

* It maps the OccName to a Name.  That Name is almost always an
  Internal Name, but (hackily) it can be External too for top-level
  pattern bindings.  See Note [bindLocalNames for an External name]
  in GHC.Rename.Pat

* We keep the current mapping (lre_env), *and* the set of all Names in
  scope (lre_in_scope).  Reason: see Note [Splicing Exact names] in
  GHC.Rename.Env.
-}

-- | Local Reader Environment
-- See Note [LocalRdrEnv]
data LocalRdrEnv = LRE { LocalRdrEnv -> OccEnv Name
lre_env      :: OccEnv Name
                       , LocalRdrEnv -> NameSet
lre_in_scope :: NameSet }

instance Outputable LocalRdrEnv where
  ppr :: LocalRdrEnv -> SDoc
ppr (LRE {lre_env :: LocalRdrEnv -> OccEnv Name
lre_env = OccEnv Name
env, lre_in_scope :: LocalRdrEnv -> NameSet
lre_in_scope = NameSet
ns})
    = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"LocalRdrEnv {")
         Int
2 ([SDoc] -> SDoc
vcat [ String -> SDoc
text String
"env =" SDoc -> SDoc -> SDoc
<+> forall a. (a -> SDoc) -> OccEnv a -> SDoc
pprOccEnv Name -> SDoc
ppr_elt OccEnv Name
env
                 , String -> SDoc
text String
"in_scope ="
                    SDoc -> SDoc -> SDoc
<+> forall key a. UniqFM key a -> ([a] -> SDoc) -> SDoc
pprUFM (forall a. UniqSet a -> UniqFM a a
getUniqSet NameSet
ns) (SDoc -> SDoc
braces forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas forall a. Outputable a => a -> SDoc
ppr)
                 ] SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'}')
    where
      ppr_elt :: Name -> SDoc
ppr_elt Name
name = SDoc -> SDoc
parens (forall a. Outputable a => a -> SDoc
ppr (forall a. Uniquable a => a -> Unique
getUnique (Name -> OccName
nameOccName Name
name))) SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Name
name
                     -- So we can see if the keys line up correctly

emptyLocalRdrEnv :: LocalRdrEnv
emptyLocalRdrEnv :: LocalRdrEnv
emptyLocalRdrEnv = LRE { lre_env :: OccEnv Name
lre_env = forall a. OccEnv a
emptyOccEnv
                       , lre_in_scope :: NameSet
lre_in_scope = NameSet
emptyNameSet }

extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
-- See Note [LocalRdrEnv]
extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
extendLocalRdrEnv lre :: LocalRdrEnv
lre@(LRE { lre_env :: LocalRdrEnv -> OccEnv Name
lre_env = OccEnv Name
env, lre_in_scope :: LocalRdrEnv -> NameSet
lre_in_scope = NameSet
ns }) Name
name
  = LocalRdrEnv
lre { lre_env :: OccEnv Name
lre_env      = forall a. OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv OccEnv Name
env (Name -> OccName
nameOccName Name
name) Name
name
        , lre_in_scope :: NameSet
lre_in_scope = NameSet -> Name -> NameSet
extendNameSet NameSet
ns Name
name }

extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv
-- See Note [LocalRdrEnv]
extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv
extendLocalRdrEnvList lre :: LocalRdrEnv
lre@(LRE { lre_env :: LocalRdrEnv -> OccEnv Name
lre_env = OccEnv Name
env, lre_in_scope :: LocalRdrEnv -> NameSet
lre_in_scope = NameSet
ns }) [Name]
names
  = LocalRdrEnv
lre { lre_env :: OccEnv Name
lre_env = forall a. OccEnv a -> [(OccName, a)] -> OccEnv a
extendOccEnvList OccEnv Name
env [(Name -> OccName
nameOccName Name
n, Name
n) | Name
n <- [Name]
names]
        , lre_in_scope :: NameSet
lre_in_scope = NameSet -> [Name] -> NameSet
extendNameSetList NameSet
ns [Name]
names }

lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
lookupLocalRdrEnv (LRE { lre_env :: LocalRdrEnv -> OccEnv Name
lre_env = OccEnv Name
env, lre_in_scope :: LocalRdrEnv -> NameSet
lre_in_scope = NameSet
ns }) RdrName
rdr
  | Unqual OccName
occ <- RdrName
rdr
  = forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv Name
env OccName
occ

  -- See Note [Local bindings with Exact Names]
  | Exact Name
name <- RdrName
rdr
  , Name
name Name -> NameSet -> Bool
`elemNameSet` NameSet
ns
  = forall a. a -> Maybe a
Just Name
name

  | Bool
otherwise
  = forall a. Maybe a
Nothing

lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name
lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name
lookupLocalRdrOcc (LRE { lre_env :: LocalRdrEnv -> OccEnv Name
lre_env = OccEnv Name
env }) OccName
occ = forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv OccEnv Name
env OccName
occ

elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
elemLocalRdrEnv RdrName
rdr_name (LRE { lre_env :: LocalRdrEnv -> OccEnv Name
lre_env = OccEnv Name
env, lre_in_scope :: LocalRdrEnv -> NameSet
lre_in_scope = NameSet
ns })
  = case RdrName
rdr_name of
      Unqual OccName
occ -> OccName
occ  forall a. OccName -> OccEnv a -> Bool
`elemOccEnv` OccEnv Name
env
      Exact Name
name -> Name
name Name -> NameSet -> Bool
`elemNameSet` NameSet
ns  -- See Note [Local bindings with Exact Names]
      Qual {} -> Bool
False
      Orig {} -> Bool
False

localRdrEnvElts :: LocalRdrEnv -> [Name]
localRdrEnvElts :: LocalRdrEnv -> [Name]
localRdrEnvElts (LRE { lre_env :: LocalRdrEnv -> OccEnv Name
lre_env = OccEnv Name
env }) = forall a. OccEnv a -> [a]
occEnvElts OccEnv Name
env

inLocalRdrEnvScope :: Name -> LocalRdrEnv -> Bool
-- This is the point of the NameSet
inLocalRdrEnvScope :: Name -> LocalRdrEnv -> Bool
inLocalRdrEnvScope Name
name (LRE { lre_in_scope :: LocalRdrEnv -> NameSet
lre_in_scope = NameSet
ns }) = Name
name Name -> NameSet -> Bool
`elemNameSet` NameSet
ns

delLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv
delLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv
delLocalRdrEnvList lre :: LocalRdrEnv
lre@(LRE { lre_env :: LocalRdrEnv -> OccEnv Name
lre_env = OccEnv Name
env }) [OccName]
occs
  = LocalRdrEnv
lre { lre_env :: OccEnv Name
lre_env = forall a. OccEnv a -> [OccName] -> OccEnv a
delListFromOccEnv OccEnv Name
env [OccName]
occs }

{-
Note [Local bindings with Exact Names]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
With Template Haskell we can make local bindings that have Exact Names.
Computing shadowing etc may use elemLocalRdrEnv (at least it certainly
does so in GHC.Rename.HsType.bindHsQTyVars), so for an Exact Name we must consult
the in-scope-name-set.


************************************************************************
*                                                                      *
                        GlobalRdrEnv
*                                                                      *
************************************************************************
-}

-- | Global Reader Environment
type GlobalRdrEnv = OccEnv [GlobalRdrElt]
-- ^ Keyed by 'OccName'; when looking up a qualified name
-- we look up the 'OccName' part, and then check the 'Provenance'
-- to see if the appropriate qualification is valid.  This
-- saves routinely doubling the size of the env by adding both
-- qualified and unqualified names to the domain.
--
-- The list in the codomain is required because there may be name clashes
-- These only get reported on lookup, not on construction
--
-- INVARIANT 1: All the members of the list have distinct
--              'gre_name' fields; that is, no duplicate Names
--
-- INVARIANT 2: Imported provenance => Name is an ExternalName
--              However LocalDefs can have an InternalName.  This
--              happens only when type-checking a [d| ... |] Template
--              Haskell quotation; see this note in GHC.Rename.Names
--              Note [Top-level Names in Template Haskell decl quotes]
--
-- INVARIANT 3: If the GlobalRdrEnv maps [occ -> gre], then
--                 greOccName gre = occ
--
--              NB: greOccName gre is usually the same as
--                  nameOccName (greMangledName gre), but not always in the
--                  case of record selectors; see Note [GreNames]

-- | Global Reader Element
--
-- An element of the 'GlobalRdrEnv'
data GlobalRdrElt
  = GRE { GlobalRdrElt -> GreName
gre_name :: !GreName      -- ^ See Note [GreNames]
        , GlobalRdrElt -> Parent
gre_par  :: !Parent       -- ^ See Note [Parents]
        , GlobalRdrElt -> Bool
gre_lcl :: !Bool          -- ^ True <=> the thing was defined locally
        , GlobalRdrElt -> [ImportSpec]
gre_imp :: ![ImportSpec]  -- ^ In scope through these imports
    } deriving (Typeable GlobalRdrElt
GlobalRdrElt -> DataType
GlobalRdrElt -> Constr
(forall b. Data b => b -> b) -> GlobalRdrElt -> GlobalRdrElt
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> GlobalRdrElt -> u
forall u. (forall d. Data d => d -> u) -> GlobalRdrElt -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GlobalRdrElt -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GlobalRdrElt -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GlobalRdrElt -> m GlobalRdrElt
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GlobalRdrElt -> m GlobalRdrElt
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GlobalRdrElt
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GlobalRdrElt -> c GlobalRdrElt
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GlobalRdrElt)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GlobalRdrElt)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GlobalRdrElt -> m GlobalRdrElt
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GlobalRdrElt -> m GlobalRdrElt
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GlobalRdrElt -> m GlobalRdrElt
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GlobalRdrElt -> m GlobalRdrElt
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GlobalRdrElt -> m GlobalRdrElt
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GlobalRdrElt -> m GlobalRdrElt
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GlobalRdrElt -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GlobalRdrElt -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> GlobalRdrElt -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GlobalRdrElt -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GlobalRdrElt -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GlobalRdrElt -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GlobalRdrElt -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GlobalRdrElt -> r
gmapT :: (forall b. Data b => b -> b) -> GlobalRdrElt -> GlobalRdrElt
$cgmapT :: (forall b. Data b => b -> b) -> GlobalRdrElt -> GlobalRdrElt
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GlobalRdrElt)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GlobalRdrElt)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GlobalRdrElt)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GlobalRdrElt)
dataTypeOf :: GlobalRdrElt -> DataType
$cdataTypeOf :: GlobalRdrElt -> DataType
toConstr :: GlobalRdrElt -> Constr
$ctoConstr :: GlobalRdrElt -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GlobalRdrElt
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GlobalRdrElt
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GlobalRdrElt -> c GlobalRdrElt
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GlobalRdrElt -> c GlobalRdrElt
Data, GlobalRdrElt -> GlobalRdrElt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalRdrElt -> GlobalRdrElt -> Bool
$c/= :: GlobalRdrElt -> GlobalRdrElt -> Bool
== :: GlobalRdrElt -> GlobalRdrElt -> Bool
$c== :: GlobalRdrElt -> GlobalRdrElt -> Bool
Eq)
         -- INVARIANT: either gre_lcl = True or gre_imp is non-empty
         -- See Note [GlobalRdrElt provenance]

-- | See Note [Parents]
data Parent = NoParent
            | ParentIs  { Parent -> Name
par_is :: Name }
            deriving (Parent -> Parent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parent -> Parent -> Bool
$c/= :: Parent -> Parent -> Bool
== :: Parent -> Parent -> Bool
$c== :: Parent -> Parent -> Bool
Eq, Typeable Parent
Parent -> DataType
Parent -> Constr
(forall b. Data b => b -> b) -> Parent -> Parent
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Parent -> u
forall u. (forall d. Data d => d -> u) -> Parent -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Parent -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Parent -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Parent -> m Parent
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Parent -> m Parent
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Parent
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Parent -> c Parent
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Parent)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Parent)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Parent -> m Parent
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Parent -> m Parent
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Parent -> m Parent
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Parent -> m Parent
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Parent -> m Parent
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Parent -> m Parent
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Parent -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Parent -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Parent -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Parent -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Parent -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Parent -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Parent -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Parent -> r
gmapT :: (forall b. Data b => b -> b) -> Parent -> Parent
$cgmapT :: (forall b. Data b => b -> b) -> Parent -> Parent
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Parent)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Parent)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Parent)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Parent)
dataTypeOf :: Parent -> DataType
$cdataTypeOf :: Parent -> DataType
toConstr :: Parent -> Constr
$ctoConstr :: Parent -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Parent
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Parent
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Parent -> c Parent
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Parent -> c Parent
Data)

instance Outputable Parent where
   ppr :: Parent -> SDoc
ppr Parent
NoParent        = SDoc
empty
   ppr (ParentIs Name
n)    = String -> SDoc
text String
"parent:" SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr Name
n

plusParent :: Parent -> Parent -> Parent
-- See Note [Combining parents]
plusParent :: Parent -> Parent -> Parent
plusParent p1 :: Parent
p1@(ParentIs Name
_)    Parent
p2 = Parent -> Parent -> Parent
hasParent Parent
p1 Parent
p2
plusParent Parent
p1 p2 :: Parent
p2@(ParentIs Name
_)    = Parent -> Parent -> Parent
hasParent Parent
p2 Parent
p1
plusParent Parent
NoParent Parent
NoParent     = Parent
NoParent

hasParent :: Parent -> Parent -> Parent
#if defined(DEBUG)
hasParent p NoParent = p
hasParent p p'
  | p /= p' = pprPanic "hasParent" (ppr p <+> ppr p')  -- Parents should agree
#endif
hasParent :: Parent -> Parent -> Parent
hasParent Parent
p Parent
_  = Parent
p


{- Note [GlobalRdrElt provenance]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The gre_lcl and gre_imp fields of a GlobalRdrElt describe its "provenance",
i.e. how the Name came to be in scope.  It can be in scope two ways:
  - gre_lcl = True: it is bound in this module
  - gre_imp: a list of all the imports that brought it into scope

It's an INVARIANT that you have one or the other; that is, either
gre_lcl is True, or gre_imp is non-empty.

It is just possible to have *both* if there is a module loop: a Name
is defined locally in A, and also brought into scope by importing a
module that SOURCE-imported A.  Example (#7672):

 A.hs-boot   module A where
               data T

 B.hs        module B(Decl.T) where
               import {-# SOURCE #-} qualified A as Decl

 A.hs        module A where
               import qualified B
               data T = Z | S B.T

In A.hs, 'T' is locally bound, *and* imported as B.T.


Note [Parents]
~~~~~~~~~~~~~~~~~
The children of a Name are the things that are abbreviated by the ".." notation
in export lists.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Parent           Children
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  data T           Data constructors
                   Record-field ids

  data family T    Data constructors and record-field ids
                   of all visible data instances of T

  class C          Class operations
                   Associated type constructors

~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Constructor      Meaning
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  NoParent         Not bundled with a type constructor.
  ParentIs n       Bundled with the type constructor corresponding to n.

Pattern synonym constructors (and their record fields, if any) are unusual:
their gre_par is NoParent in the module in which they are defined.  However, a
pattern synonym can be bundled with a type constructor on export, in which case
whenever the pattern synonym is imported the gre_par will be ParentIs.

Thus the gre_name and gre_par fields are independent, because a normal datatype
introduces FieldGreNames using ParentIs, but a record pattern synonym can
introduce FieldGreNames that use NoParent. (In the past we represented fields
using an additional constructor of the Parent type, which could not adequately
represent this situation.) See also
Note [Representing pattern synonym fields in AvailInfo] in GHC.Types.Avail.


Note [GreNames]
~~~~~~~~~~~~~~~
A `GlobalRdrElt` has a field `gre_name :: GreName`, which uniquely
identifies what the `GlobalRdrElt` describes.  There are two sorts of
`GreName` (see the data type decl):

* NormalGreName Name: this is used for most entities; the Name
  uniquely identifies it. It is stored in the GlobalRdrEnv under
  the OccName of the Name.

* FieldGreName FieldLabel: is used only for field labels of a
  record. With -XDuplicateRecordFields there may be many field
  labels `x` in scope; e.g.
     data T1 = MkT1 { x :: Int }
     data T2 = MkT2 { x :: Bool }
  Each has a different GlobalRdrElt with a distinct GreName.
  The two fields are uniquely identified by their record selectors,
  which are stored in the FieldLabel, and have mangled names like
  `$sel:x:MkT1`.  See Note [FieldLabel] in GHC.Types.FieldLabel.

  These GREs are stored in the GlobalRdrEnv under the OccName of the
  field (i.e. "x" in both cases above), /not/ the OccName of the mangled
  record selector function.

A GreName, and hence a GRE, has both a "printable" and a "mangled" Name.  These
are identical for normal names, but for record fields compiled with
-XDuplicateRecordFields they will differ. So we have two pairs of functions:

 * greNameMangledName :: GreName -> Name
   greMangledName :: GlobalRdrElt -> Name
   The "mangled" Name is the actual Name of the selector function,
   e.g. $sel:x:MkT1.  This should not be displayed to the user, but is used to
   uniquely identify the field in the renamer, and later in the backend.

 * greNamePrintableName :: GreName -> Name
   grePrintableName :: GlobalRdrElt -> Name
   The "printable" Name is the "manged" Name with its OccName replaced with that
   of the field label.  This is how the field should be output to the user.

Since the right Name to use is context-dependent, we do not define a NamedThing
instance for GREName (or GlobalRdrElt), but instead make the choice explicit.


Note [Combining parents]
~~~~~~~~~~~~~~~~~~~~~~~~
With an associated type we might have
   module M where
     class C a where
       data T a
       op :: T a -> a
     instance C Int where
       data T Int = TInt
     instance C Bool where
       data T Bool = TBool

Then:   C is the parent of T
        T is the parent of TInt and TBool
So: in an export list
    C(..) is short for C( op, T )
    T(..) is short for T( TInt, TBool )

Module M exports everything, so its exports will be
   AvailTC C [C,T,op]
   AvailTC T [T,TInt,TBool]
On import we convert to GlobalRdrElt and then combine
those.  For T that will mean we have
  one GRE with Parent C
  one GRE with NoParent
That's why plusParent picks the "best" case.
-}

-- | make a 'GlobalRdrEnv' where all the elements point to the same
-- Provenance (useful for "hiding" imports, or imports with no details).
gresFromAvails :: Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
-- prov = Nothing   => locally bound
--        Just spec => imported as described by spec
gresFromAvails :: Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails Maybe ImportSpec
prov [AvailInfo]
avails
  = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Name -> Maybe ImportSpec) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail (forall a b. a -> b -> a
const Maybe ImportSpec
prov)) [AvailInfo]
avails

localGREsFromAvail :: AvailInfo -> [GlobalRdrElt]
-- Turn an Avail into a list of LocalDef GlobalRdrElts
localGREsFromAvail :: AvailInfo -> [GlobalRdrElt]
localGREsFromAvail = (Name -> Maybe ImportSpec) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)

gresFromAvail :: (Name -> Maybe ImportSpec) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail :: (Name -> Maybe ImportSpec) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail Name -> Maybe ImportSpec
prov_fn AvailInfo
avail
  = forall a b. (a -> b) -> [a] -> [b]
map Name -> GlobalRdrElt
mk_gre (AvailInfo -> [Name]
availNonFldNames AvailInfo
avail) forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> GlobalRdrElt
mk_fld_gre (AvailInfo -> [FieldLabel]
availFlds AvailInfo
avail)
  where
    mk_gre :: Name -> GlobalRdrElt
mk_gre Name
n
      = case Name -> Maybe ImportSpec
prov_fn Name
n of  -- Nothing => bound locally
                           -- Just is => imported from 'is'
          Maybe ImportSpec
Nothing -> GRE { gre_name :: GreName
gre_name = Name -> GreName
NormalGreName Name
n, gre_par :: Parent
gre_par = Name -> AvailInfo -> Parent
mkParent Name
n AvailInfo
avail
                         , gre_lcl :: Bool
gre_lcl = Bool
True, gre_imp :: [ImportSpec]
gre_imp = [] }
          Just ImportSpec
is -> GRE { gre_name :: GreName
gre_name = Name -> GreName
NormalGreName Name
n, gre_par :: Parent
gre_par = Name -> AvailInfo -> Parent
mkParent Name
n AvailInfo
avail
                         , gre_lcl :: Bool
gre_lcl = Bool
False, gre_imp :: [ImportSpec]
gre_imp = [ImportSpec
is] }

    mk_fld_gre :: FieldLabel -> GlobalRdrElt
mk_fld_gre FieldLabel
fl
      = case Name -> Maybe ImportSpec
prov_fn (FieldLabel -> Name
flSelector FieldLabel
fl) of  -- Nothing => bound locally
                           -- Just is => imported from 'is'
          Maybe ImportSpec
Nothing -> GRE { gre_name :: GreName
gre_name = FieldLabel -> GreName
FieldGreName FieldLabel
fl, gre_par :: Parent
gre_par = AvailInfo -> Parent
availParent AvailInfo
avail
                         , gre_lcl :: Bool
gre_lcl = Bool
True, gre_imp :: [ImportSpec]
gre_imp = [] }
          Just ImportSpec
is -> GRE { gre_name :: GreName
gre_name = FieldLabel -> GreName
FieldGreName FieldLabel
fl, gre_par :: Parent
gre_par = AvailInfo -> Parent
availParent AvailInfo
avail
                         , gre_lcl :: Bool
gre_lcl = Bool
False, gre_imp :: [ImportSpec]
gre_imp = [ImportSpec
is] }

instance HasOccName GlobalRdrElt where
  occName :: GlobalRdrElt -> OccName
occName = GlobalRdrElt -> OccName
greOccName

-- | See Note [GreNames]
greOccName :: GlobalRdrElt -> OccName
greOccName :: GlobalRdrElt -> OccName
greOccName = forall name. HasOccName name => name -> OccName
occName forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> GreName
gre_name

-- | A 'Name' for the GRE for internal use.  Careful: the 'OccName' of this
-- 'Name' is not necessarily the same as the 'greOccName' (see Note [GreNames]).
greMangledName :: GlobalRdrElt -> Name
greMangledName :: GlobalRdrElt -> Name
greMangledName = GreName -> Name
greNameMangledName forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> GreName
gre_name

-- | A 'Name' for the GRE suitable for output to the user.  Its 'OccName' will
-- be the 'greOccName' (see Note [GreNames]).
grePrintableName :: GlobalRdrElt -> Name
grePrintableName :: GlobalRdrElt -> Name
grePrintableName = GreName -> Name
greNamePrintableName forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> GreName
gre_name

-- | The SrcSpan of the name pointed to by the GRE.
greDefinitionSrcSpan :: GlobalRdrElt -> SrcSpan
greDefinitionSrcSpan :: GlobalRdrElt -> SrcSpan
greDefinitionSrcSpan = Name -> SrcSpan
nameSrcSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Name
greMangledName

-- | The module in which the name pointed to by the GRE is defined.
greDefinitionModule :: GlobalRdrElt -> Maybe Module
greDefinitionModule :: GlobalRdrElt -> Maybe Module
greDefinitionModule = Name -> Maybe Module
nameModule_maybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Name
greMangledName

greQualModName :: GlobalRdrElt -> ModuleName
-- Get a suitable module qualifier for the GRE
-- (used in mkPrintUnqualified)
-- Prerecondition: the greMangledName is always External
greQualModName :: GlobalRdrElt -> ModuleName
greQualModName gre :: GlobalRdrElt
gre@(GRE { gre_lcl :: GlobalRdrElt -> Bool
gre_lcl = Bool
lcl, gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_imp = [ImportSpec]
iss })
 | Bool
lcl, Just Module
mod <- GlobalRdrElt -> Maybe Module
greDefinitionModule GlobalRdrElt
gre = forall unit. GenModule unit -> ModuleName
moduleName Module
mod
 | (ImportSpec
is:[ImportSpec]
_) <- [ImportSpec]
iss                            = ImpDeclSpec -> ModuleName
is_as (ImportSpec -> ImpDeclSpec
is_decl ImportSpec
is)
 | Bool
otherwise                                = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"greQualModName" (forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
gre)

greRdrNames :: GlobalRdrElt -> [RdrName]
greRdrNames :: GlobalRdrElt -> [RdrName]
greRdrNames gre :: GlobalRdrElt
gre@GRE{ gre_lcl :: GlobalRdrElt -> Bool
gre_lcl = Bool
lcl, gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_imp = [ImportSpec]
iss }
  = (if Bool
lcl then [RdrName
unqual] else []) forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ImpDeclSpec -> [RdrName]
do_spec (forall a b. (a -> b) -> [a] -> [b]
map ImportSpec -> ImpDeclSpec
is_decl [ImportSpec]
iss)
  where
    occ :: OccName
occ    = GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre
    unqual :: RdrName
unqual = OccName -> RdrName
Unqual OccName
occ
    do_spec :: ImpDeclSpec -> [RdrName]
do_spec ImpDeclSpec
decl_spec
        | ImpDeclSpec -> Bool
is_qual ImpDeclSpec
decl_spec = [RdrName
qual]
        | Bool
otherwise         = [RdrName
unqual,RdrName
qual]
        where qual :: RdrName
qual = ModuleName -> OccName -> RdrName
Qual (ImpDeclSpec -> ModuleName
is_as ImpDeclSpec
decl_spec) OccName
occ

-- the SrcSpan that pprNameProvenance prints out depends on whether
-- the Name is defined locally or not: for a local definition the
-- definition site is used, otherwise the location of the import
-- declaration.  We want to sort the export locations in
-- exportClashErr by this SrcSpan, we need to extract it:
greSrcSpan :: GlobalRdrElt -> SrcSpan
greSrcSpan :: GlobalRdrElt -> SrcSpan
greSrcSpan gre :: GlobalRdrElt
gre@(GRE { gre_lcl :: GlobalRdrElt -> Bool
gre_lcl = Bool
lcl, gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_imp = [ImportSpec]
iss } )
  | Bool
lcl           = GlobalRdrElt -> SrcSpan
greDefinitionSrcSpan GlobalRdrElt
gre
  | (ImportSpec
is:[ImportSpec]
_) <- [ImportSpec]
iss = ImpDeclSpec -> SrcSpan
is_dloc (ImportSpec -> ImpDeclSpec
is_decl ImportSpec
is)
  | Bool
otherwise     = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"greSrcSpan" (forall a. Outputable a => a -> SDoc
ppr GlobalRdrElt
gre)

mkParent :: Name -> AvailInfo -> Parent
mkParent :: Name -> AvailInfo -> Parent
mkParent Name
_ (Avail GreName
_)                 = Parent
NoParent
mkParent Name
n (AvailTC Name
m [GreName]
_) | Name
n forall a. Eq a => a -> a -> Bool
== Name
m    = Parent
NoParent
                         | Bool
otherwise = Name -> Parent
ParentIs Name
m

availParent :: AvailInfo -> Parent
availParent :: AvailInfo -> Parent
availParent (AvailTC Name
m [GreName]
_) = Name -> Parent
ParentIs Name
m
availParent (Avail {})    = Parent
NoParent


greParent_maybe :: GlobalRdrElt -> Maybe Name
greParent_maybe :: GlobalRdrElt -> Maybe Name
greParent_maybe GlobalRdrElt
gre = case GlobalRdrElt -> Parent
gre_par GlobalRdrElt
gre of
                        Parent
NoParent      -> forall a. Maybe a
Nothing
                        ParentIs Name
n    -> forall a. a -> Maybe a
Just Name
n

-- | Takes a list of distinct GREs and folds them
-- into AvailInfos. This is more efficient than mapping each individual
-- GRE to an AvailInfo and the folding using `plusAvail` but needs the
-- uniqueness assumption.
gresToAvailInfo :: [GlobalRdrElt] -> [AvailInfo]
gresToAvailInfo :: [GlobalRdrElt] -> [AvailInfo]
gresToAvailInfo [GlobalRdrElt]
gres
  = forall a. NameEnv a -> [a]
nameEnvElts NameEnv AvailInfo
avail_env
  where
    avail_env :: NameEnv AvailInfo -- Keyed by the parent
    (NameEnv AvailInfo
avail_env, NameSet
_) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (NameEnv AvailInfo, NameSet)
-> GlobalRdrElt -> (NameEnv AvailInfo, NameSet)
add (forall a. NameEnv a
emptyNameEnv, NameSet
emptyNameSet) [GlobalRdrElt]
gres

    add :: (NameEnv AvailInfo, NameSet)
        -> GlobalRdrElt
        -> (NameEnv AvailInfo, NameSet)
    add :: (NameEnv AvailInfo, NameSet)
-> GlobalRdrElt -> (NameEnv AvailInfo, NameSet)
add (NameEnv AvailInfo
env, NameSet
done) GlobalRdrElt
gre
      | Name
name Name -> NameSet -> Bool
`elemNameSet` NameSet
done
      = (NameEnv AvailInfo
env, NameSet
done)  -- Don't insert twice into the AvailInfo
      | Bool
otherwise
      = ( forall a b.
(a -> b -> b) -> (a -> b) -> NameEnv b -> Name -> a -> NameEnv b
extendNameEnv_Acc GlobalRdrElt -> AvailInfo -> AvailInfo
comb GlobalRdrElt -> AvailInfo
availFromGRE NameEnv AvailInfo
env Name
key GlobalRdrElt
gre
        , NameSet
done NameSet -> Name -> NameSet
`extendNameSet` Name
name )
      where
        name :: Name
name = GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre
        key :: Name
key = case GlobalRdrElt -> Maybe Name
greParent_maybe GlobalRdrElt
gre of
                 Just Name
parent -> Name
parent
                 Maybe Name
Nothing     -> GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre

        -- We want to insert the child `k` into a list of children but
        -- need to maintain the invariant that the parent is first.
        --
        -- We also use the invariant that `k` is not already in `ns`.
        insertChildIntoChildren :: Name -> [GreName] -> GreName -> [GreName]
        insertChildIntoChildren :: Name -> [GreName] -> GreName -> [GreName]
insertChildIntoChildren Name
_ [] GreName
k = [GreName
k]
        insertChildIntoChildren Name
p (GreName
n:[GreName]
ns) GreName
k
          | Name -> GreName
NormalGreName Name
p forall a. Eq a => a -> a -> Bool
== GreName
k = GreName
kforall a. a -> [a] -> [a]
:GreName
nforall a. a -> [a] -> [a]
:[GreName]
ns
          | Bool
otherwise = GreName
nforall a. a -> [a] -> [a]
:GreName
kforall a. a -> [a] -> [a]
:[GreName]
ns

        comb :: GlobalRdrElt -> AvailInfo -> AvailInfo
        comb :: GlobalRdrElt -> AvailInfo -> AvailInfo
comb GlobalRdrElt
_   (Avail GreName
n) = GreName -> AvailInfo
Avail GreName
n -- Duplicated name, should not happen
        comb GlobalRdrElt
gre (AvailTC Name
m [GreName]
ns)
          = case GlobalRdrElt -> Parent
gre_par GlobalRdrElt
gre of
              Parent
NoParent    -> Name -> [GreName] -> AvailInfo
AvailTC Name
m (GlobalRdrElt -> GreName
gre_name GlobalRdrElt
greforall a. a -> [a] -> [a]
:[GreName]
ns) -- Not sure this ever happens
              ParentIs {} -> Name -> [GreName] -> AvailInfo
AvailTC Name
m (Name -> [GreName] -> GreName -> [GreName]
insertChildIntoChildren Name
m [GreName]
ns (GlobalRdrElt -> GreName
gre_name GlobalRdrElt
gre))

availFromGRE :: GlobalRdrElt -> AvailInfo
availFromGRE :: GlobalRdrElt -> AvailInfo
availFromGRE (GRE { gre_name :: GlobalRdrElt -> GreName
gre_name = GreName
child, gre_par :: GlobalRdrElt -> Parent
gre_par = Parent
parent })
  = case Parent
parent of
      ParentIs Name
p -> Name -> [GreName] -> AvailInfo
AvailTC Name
p [GreName
child]
      Parent
NoParent | NormalGreName Name
me <- GreName
child, Name -> Bool
isTyConName Name
me -> Name -> [GreName] -> AvailInfo
AvailTC Name
me [GreName
child]
               | Bool
otherwise -> GreName -> AvailInfo
Avail GreName
child

emptyGlobalRdrEnv :: GlobalRdrEnv
emptyGlobalRdrEnv :: GlobalRdrEnv
emptyGlobalRdrEnv = forall a. OccEnv a
emptyOccEnv

globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts GlobalRdrEnv
env = forall a b. (a -> b -> b) -> b -> OccEnv a -> b
foldOccEnv forall a. [a] -> [a] -> [a]
(++) [] GlobalRdrEnv
env

instance Outputable GlobalRdrElt where
  ppr :: GlobalRdrElt -> SDoc
ppr GlobalRdrElt
gre = SDoc -> Int -> SDoc -> SDoc
hang (forall a. Outputable a => a -> SDoc
ppr (GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre) SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (GlobalRdrElt -> Parent
gre_par GlobalRdrElt
gre))
               Int
2 (GlobalRdrElt -> SDoc
pprNameProvenance GlobalRdrElt
gre)

pprGlobalRdrEnv :: Bool -> GlobalRdrEnv -> SDoc
pprGlobalRdrEnv :: Bool -> GlobalRdrEnv -> SDoc
pprGlobalRdrEnv Bool
locals_only GlobalRdrEnv
env
  = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"GlobalRdrEnv" SDoc -> SDoc -> SDoc
<+> Bool -> SDoc -> SDoc
ppWhen Bool
locals_only (PtrString -> SDoc
ptext (String -> PtrString
sLit String
"(locals only)"))
             SDoc -> SDoc -> SDoc
<+> SDoc
lbrace
         , Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
vcat [ [GlobalRdrElt] -> SDoc
pp ([GlobalRdrElt] -> [GlobalRdrElt]
remove_locals [GlobalRdrElt]
gre_list) | [GlobalRdrElt]
gre_list <- forall a. OccEnv a -> [a]
occEnvElts GlobalRdrEnv
env ]
             SDoc -> SDoc -> SDoc
<+> SDoc
rbrace) ]
  where
    remove_locals :: [GlobalRdrElt] -> [GlobalRdrElt]
remove_locals [GlobalRdrElt]
gres | Bool
locals_only = forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
isLocalGRE [GlobalRdrElt]
gres
                       | Bool
otherwise   = [GlobalRdrElt]
gres
    pp :: [GlobalRdrElt] -> SDoc
pp []   = SDoc
empty
    pp [GlobalRdrElt]
gres = SDoc -> Int -> SDoc -> SDoc
hang (forall a. Outputable a => a -> SDoc
ppr OccName
occ
                     SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (String -> SDoc
text String
"unique" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (forall a. Uniquable a => a -> Unique
getUnique OccName
occ))
                     SDoc -> SDoc -> SDoc
<> SDoc
colon)
                 Int
2 ([SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
gres))
      where
        occ :: OccName
occ = Name -> OccName
nameOccName (GlobalRdrElt -> Name
greMangledName (forall a. [a] -> a
head [GlobalRdrElt]
gres))

lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
env OccName
occ_name = case forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv GlobalRdrEnv
env OccName
occ_name of
                                  Maybe [GlobalRdrElt]
Nothing   -> []
                                  Just [GlobalRdrElt]
gres -> [GlobalRdrElt]
gres

lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
-- ^ Look for this 'RdrName' in the global environment.  Omits record fields
-- without selector functions (see Note [NoFieldSelectors] in GHC.Rename.Env).
lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName RdrName
rdr_name GlobalRdrEnv
env =
    forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Bool
isNoFieldSelectorGRE) (RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName' RdrName
rdr_name GlobalRdrEnv
env)

lookupGRE_RdrName' :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
-- ^ Look for this 'RdrName' in the global environment.  Includes record fields
-- without selector functions (see Note [NoFieldSelectors] in GHC.Rename.Env).
lookupGRE_RdrName' :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName' RdrName
rdr_name GlobalRdrEnv
env
  = case forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv GlobalRdrEnv
env (RdrName -> OccName
rdrNameOcc RdrName
rdr_name) of
    Maybe [GlobalRdrElt]
Nothing   -> []
    Just [GlobalRdrElt]
gres -> RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
pickGREs RdrName
rdr_name [GlobalRdrElt]
gres

lookupGRE_Name :: GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
-- ^ Look for precisely this 'Name' in the environment.  This tests
-- whether it is in scope, ignoring anything else that might be in
-- scope with the same 'OccName'.
lookupGRE_Name :: GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
lookupGRE_Name GlobalRdrEnv
env Name
name
  = GlobalRdrEnv -> Name -> OccName -> Maybe GlobalRdrElt
lookupGRE_Name_OccName GlobalRdrEnv
env Name
name (Name -> OccName
nameOccName Name
name)

lookupGRE_GreName :: GlobalRdrEnv -> GreName -> Maybe GlobalRdrElt
-- ^ Look for precisely this 'GreName' in the environment.  This tests
-- whether it is in scope, ignoring anything else that might be in
-- scope with the same 'OccName'.
lookupGRE_GreName :: GlobalRdrEnv -> GreName -> Maybe GlobalRdrElt
lookupGRE_GreName GlobalRdrEnv
env GreName
gname
  = GlobalRdrEnv -> Name -> OccName -> Maybe GlobalRdrElt
lookupGRE_Name_OccName GlobalRdrEnv
env (GreName -> Name
greNameMangledName GreName
gname) (forall name. HasOccName name => name -> OccName
occName GreName
gname)

lookupGRE_FieldLabel :: GlobalRdrEnv -> FieldLabel -> Maybe GlobalRdrElt
-- ^ Look for a particular record field selector in the environment, where the
-- selector name and field label may be different: the GlobalRdrEnv is keyed on
-- the label.  See Note [GreNames] for why this happens.
lookupGRE_FieldLabel :: GlobalRdrEnv -> FieldLabel -> Maybe GlobalRdrElt
lookupGRE_FieldLabel GlobalRdrEnv
env FieldLabel
fl
  = GlobalRdrEnv -> Name -> OccName -> Maybe GlobalRdrElt
lookupGRE_Name_OccName GlobalRdrEnv
env (FieldLabel -> Name
flSelector FieldLabel
fl) (FastString -> OccName
mkVarOccFS (FieldLabel -> FastString
flLabel FieldLabel
fl))

lookupGRE_Name_OccName :: GlobalRdrEnv -> Name -> OccName -> Maybe GlobalRdrElt
-- ^ Look for precisely this 'Name' in the environment, but with an 'OccName'
-- that might differ from that of the 'Name'.  See 'lookupGRE_FieldLabel' and
-- Note [GreNames].
lookupGRE_Name_OccName :: GlobalRdrEnv -> Name -> OccName -> Maybe GlobalRdrElt
lookupGRE_Name_OccName GlobalRdrEnv
env Name
name OccName
occ
  = case [ GlobalRdrElt
gre | GlobalRdrElt
gre <- GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
env OccName
occ
               , GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre forall a. Eq a => a -> a -> Bool
== Name
name ] of
      []    -> forall a. Maybe a
Nothing
      [GlobalRdrElt
gre] -> forall a. a -> Maybe a
Just GlobalRdrElt
gre
      [GlobalRdrElt]
gres  -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"lookupGRE_Name_OccName"
                        (forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr OccName
occ SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
gres)
               -- See INVARIANT 1 on GlobalRdrEnv


getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
-- Returns all the qualifiers by which 'x' is in scope
-- Nothing means "the unqualified version is in scope"
-- [] means the thing is not in scope at all
getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
getGRE_NameQualifier_maybes GlobalRdrEnv
env Name
name
  = case GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
lookupGRE_Name GlobalRdrEnv
env Name
name of
      Just GlobalRdrElt
gre -> [GlobalRdrElt -> Maybe [ModuleName]
qualifier_maybe GlobalRdrElt
gre]
      Maybe GlobalRdrElt
Nothing  -> []
  where
    qualifier_maybe :: GlobalRdrElt -> Maybe [ModuleName]
qualifier_maybe (GRE { gre_lcl :: GlobalRdrElt -> Bool
gre_lcl = Bool
lcl, gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_imp = [ImportSpec]
iss })
      | Bool
lcl       = forall a. Maybe a
Nothing
      | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (ImpDeclSpec -> ModuleName
is_as forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportSpec -> ImpDeclSpec
is_decl) [ImportSpec]
iss

isLocalGRE :: GlobalRdrElt -> Bool
isLocalGRE :: GlobalRdrElt -> Bool
isLocalGRE (GRE {gre_lcl :: GlobalRdrElt -> Bool
gre_lcl = Bool
lcl }) = Bool
lcl

isRecFldGRE :: GlobalRdrElt -> Bool
isRecFldGRE :: GlobalRdrElt -> Bool
isRecFldGRE = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Maybe FieldLabel
greFieldLabel

isDuplicateRecFldGRE :: GlobalRdrElt -> Bool
-- ^ Is this a record field defined with DuplicateRecordFields?
-- (See Note [GreNames])
isDuplicateRecFldGRE :: GlobalRdrElt -> Bool
isDuplicateRecFldGRE =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((DuplicateRecordFields
DuplicateRecordFields forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> DuplicateRecordFields
flHasDuplicateRecordFields) forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Maybe FieldLabel
greFieldLabel

isNoFieldSelectorGRE :: GlobalRdrElt -> Bool
-- ^ Is this a record field defined with NoFieldSelectors?
-- (See Note [NoFieldSelectors] in GHC.Rename.Env)
isNoFieldSelectorGRE :: GlobalRdrElt -> Bool
isNoFieldSelectorGRE =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((FieldSelectors
NoFieldSelectors forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> FieldSelectors
flHasFieldSelector) forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Maybe FieldLabel
greFieldLabel

isFieldSelectorGRE :: GlobalRdrElt -> Bool
-- ^ Is this a record field defined with FieldSelectors?
-- (See Note [NoFieldSelectors] in GHC.Rename.Env)
isFieldSelectorGRE :: GlobalRdrElt -> Bool
isFieldSelectorGRE =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((FieldSelectors
FieldSelectors forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> FieldSelectors
flHasFieldSelector) forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> Maybe FieldLabel
greFieldLabel

greFieldLabel :: GlobalRdrElt -> Maybe FieldLabel
-- ^ Returns the field label of this GRE, if it has one
greFieldLabel :: GlobalRdrElt -> Maybe FieldLabel
greFieldLabel = GreName -> Maybe FieldLabel
greNameFieldLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalRdrElt -> GreName
gre_name

unQualOK :: GlobalRdrElt -> Bool
-- ^ Test if an unqualified version of this thing would be in scope
unQualOK :: GlobalRdrElt -> Bool
unQualOK (GRE {gre_lcl :: GlobalRdrElt -> Bool
gre_lcl = Bool
lcl, gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_imp = [ImportSpec]
iss })
  | Bool
lcl = Bool
True
  | Bool
otherwise = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ImportSpec -> Bool
unQualSpecOK [ImportSpec]
iss

{- Note [GRE filtering]
~~~~~~~~~~~~~~~~~~~~~~~
(pickGREs rdr gres) takes a list of GREs which have the same OccName
as 'rdr', say "x".  It does two things:

(a) filters the GREs to a subset that are in scope
    * Qualified,   as 'M.x'  if want_qual    is Qual M _
    * Unqualified, as 'x'    if want_unqual  is Unqual _

(b) for that subset, filter the provenance field (gre_lcl and gre_imp)
    to ones that brought it into scope qualified or unqualified resp.

Example:
      module A ( f ) where
      import qualified Foo( f )
      import Baz( f )
      f = undefined

Let's suppose that Foo.f and Baz.f are the same entity really, but the local
'f' is different, so there will be two GREs matching "f":
   gre1:  gre_lcl = True,  gre_imp = []
   gre2:  gre_lcl = False, gre_imp = [ imported from Foo, imported from Bar ]

The use of "f" in the export list is ambiguous because it's in scope
from the local def and the import Baz(f); but *not* the import qualified Foo.
pickGREs returns two GRE
   gre1:   gre_lcl = True,  gre_imp = []
   gre2:   gre_lcl = False, gre_imp = [ imported from Bar ]

Now the "ambiguous occurrence" message can correctly report how the
ambiguity arises.
-}

pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
-- ^ Takes a list of GREs which have the right OccName 'x'
-- Pick those GREs that are in scope
--    * Qualified,   as 'M.x'  if want_qual    is Qual M _
--    * Unqualified, as 'x'    if want_unqual  is Unqual _
--
-- Return each such GRE, with its ImportSpecs filtered, to reflect
-- how it is in scope qualified or unqualified respectively.
-- See Note [GRE filtering]
pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
pickGREs (Unqual {})  [GlobalRdrElt]
gres = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GlobalRdrElt -> Maybe GlobalRdrElt
pickUnqualGRE     [GlobalRdrElt]
gres
pickGREs (Qual ModuleName
mod OccName
_) [GlobalRdrElt]
gres = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ModuleName -> GlobalRdrElt -> Maybe GlobalRdrElt
pickQualGRE ModuleName
mod) [GlobalRdrElt]
gres
pickGREs RdrName
_            [GlobalRdrElt]
_    = []  -- I don't think this actually happens

pickUnqualGRE :: GlobalRdrElt -> Maybe GlobalRdrElt
pickUnqualGRE :: GlobalRdrElt -> Maybe GlobalRdrElt
pickUnqualGRE gre :: GlobalRdrElt
gre@(GRE { gre_lcl :: GlobalRdrElt -> Bool
gre_lcl = Bool
lcl, gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_imp = [ImportSpec]
iss })
  | Bool -> Bool
not Bool
lcl, forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ImportSpec]
iss' = forall a. Maybe a
Nothing
  | Bool
otherwise          = forall a. a -> Maybe a
Just (GlobalRdrElt
gre { gre_imp :: [ImportSpec]
gre_imp = [ImportSpec]
iss' })
  where
    iss' :: [ImportSpec]
iss' = forall a. (a -> Bool) -> [a] -> [a]
filter ImportSpec -> Bool
unQualSpecOK [ImportSpec]
iss

pickQualGRE :: ModuleName -> GlobalRdrElt -> Maybe GlobalRdrElt
pickQualGRE :: ModuleName -> GlobalRdrElt -> Maybe GlobalRdrElt
pickQualGRE ModuleName
mod gre :: GlobalRdrElt
gre@(GRE { gre_lcl :: GlobalRdrElt -> Bool
gre_lcl = Bool
lcl, gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_imp = [ImportSpec]
iss })
  | Bool -> Bool
not Bool
lcl', forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ImportSpec]
iss' = forall a. Maybe a
Nothing
  | Bool
otherwise           = forall a. a -> Maybe a
Just (GlobalRdrElt
gre { gre_lcl :: Bool
gre_lcl = Bool
lcl', gre_imp :: [ImportSpec]
gre_imp = [ImportSpec]
iss' })
  where
    iss' :: [ImportSpec]
iss' = forall a. (a -> Bool) -> [a] -> [a]
filter (ModuleName -> ImportSpec -> Bool
qualSpecOK ModuleName
mod) [ImportSpec]
iss
    lcl' :: Bool
lcl' = Bool
lcl Bool -> Bool -> Bool
&& ModuleName -> Bool
name_is_from ModuleName
mod

    name_is_from :: ModuleName -> Bool
    name_is_from :: ModuleName -> Bool
name_is_from ModuleName
mod = case GlobalRdrElt -> Maybe Module
greDefinitionModule GlobalRdrElt
gre of
                         Just Module
n_mod -> forall unit. GenModule unit -> ModuleName
moduleName Module
n_mod forall a. Eq a => a -> a -> Bool
== ModuleName
mod
                         Maybe Module
Nothing    -> Bool
False

pickGREsModExp :: ModuleName -> [GlobalRdrElt] -> [(GlobalRdrElt,GlobalRdrElt)]
-- ^ Pick GREs that are in scope *both* qualified *and* unqualified
-- Return each GRE that is, as a pair
--    (qual_gre, unqual_gre)
-- These two GREs are the original GRE with imports filtered to express how
-- it is in scope qualified an unqualified respectively
--
-- Used only for the 'module M' item in export list;
--   see 'GHC.Tc.Gen.Export.exports_from_avail'
pickGREsModExp :: ModuleName -> [GlobalRdrElt] -> [(GlobalRdrElt, GlobalRdrElt)]
pickGREsModExp ModuleName
mod [GlobalRdrElt]
gres = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ModuleName -> GlobalRdrElt -> Maybe (GlobalRdrElt, GlobalRdrElt)
pickBothGRE ModuleName
mod) [GlobalRdrElt]
gres

-- | isBuiltInSyntax filter out names for built-in syntax They
-- just clutter up the environment (esp tuples), and the
-- parser will generate Exact RdrNames for them, so the
-- cluttered envt is no use.  Really, it's only useful for
-- GHC.Base and GHC.Tuple.
pickBothGRE :: ModuleName -> GlobalRdrElt -> Maybe (GlobalRdrElt, GlobalRdrElt)
pickBothGRE :: ModuleName -> GlobalRdrElt -> Maybe (GlobalRdrElt, GlobalRdrElt)
pickBothGRE ModuleName
mod GlobalRdrElt
gre
  | Name -> Bool
isBuiltInSyntax (GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre)   = forall a. Maybe a
Nothing
  | Just GlobalRdrElt
gre1 <- ModuleName -> GlobalRdrElt -> Maybe GlobalRdrElt
pickQualGRE ModuleName
mod GlobalRdrElt
gre
  , Just GlobalRdrElt
gre2 <- GlobalRdrElt -> Maybe GlobalRdrElt
pickUnqualGRE   GlobalRdrElt
gre = forall a. a -> Maybe a
Just (GlobalRdrElt
gre1, GlobalRdrElt
gre2)
  | Bool
otherwise                        = forall a. Maybe a
Nothing

-- Building GlobalRdrEnvs

plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
plusGlobalRdrEnv GlobalRdrEnv
env1 GlobalRdrEnv
env2 = forall a. (a -> a -> a) -> OccEnv a -> OccEnv a -> OccEnv a
plusOccEnv_C (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
insertGRE) GlobalRdrEnv
env1 GlobalRdrEnv
env2

mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv
mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv
mkGlobalRdrEnv [GlobalRdrElt]
gres
  = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GlobalRdrElt -> GlobalRdrEnv -> GlobalRdrEnv
add GlobalRdrEnv
emptyGlobalRdrEnv [GlobalRdrElt]
gres
  where
    add :: GlobalRdrElt -> GlobalRdrEnv -> GlobalRdrEnv
add GlobalRdrElt
gre GlobalRdrEnv
env = forall a b.
(a -> b -> b) -> (a -> b) -> OccEnv b -> OccName -> a -> OccEnv b
extendOccEnv_Acc GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
insertGRE forall a. a -> [a]
Utils.singleton GlobalRdrEnv
env
                                   (GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre)
                                   GlobalRdrElt
gre

insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
insertGRE GlobalRdrElt
new_g [] = [GlobalRdrElt
new_g]
insertGRE GlobalRdrElt
new_g (GlobalRdrElt
old_g : [GlobalRdrElt]
old_gs)
        | GlobalRdrElt -> GreName
gre_name GlobalRdrElt
new_g forall a. Eq a => a -> a -> Bool
== GlobalRdrElt -> GreName
gre_name GlobalRdrElt
old_g
        = GlobalRdrElt
new_g GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
`plusGRE` GlobalRdrElt
old_g forall a. a -> [a] -> [a]
: [GlobalRdrElt]
old_gs
        | Bool
otherwise
        = GlobalRdrElt
old_g forall a. a -> [a] -> [a]
: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
insertGRE GlobalRdrElt
new_g [GlobalRdrElt]
old_gs

plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
-- Used when the gre_name fields match
plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
plusGRE GlobalRdrElt
g1 GlobalRdrElt
g2
  = GRE { gre_name :: GreName
gre_name = GlobalRdrElt -> GreName
gre_name GlobalRdrElt
g1
        , gre_lcl :: Bool
gre_lcl  = GlobalRdrElt -> Bool
gre_lcl GlobalRdrElt
g1 Bool -> Bool -> Bool
|| GlobalRdrElt -> Bool
gre_lcl GlobalRdrElt
g2
        , gre_imp :: [ImportSpec]
gre_imp  = GlobalRdrElt -> [ImportSpec]
gre_imp GlobalRdrElt
g1 forall a. [a] -> [a] -> [a]
++ GlobalRdrElt -> [ImportSpec]
gre_imp GlobalRdrElt
g2
        , gre_par :: Parent
gre_par  = GlobalRdrElt -> Parent
gre_par  GlobalRdrElt
g1 Parent -> Parent -> Parent
`plusParent` GlobalRdrElt -> Parent
gre_par  GlobalRdrElt
g2 }

transformGREs :: (GlobalRdrElt -> GlobalRdrElt)
              -> [OccName]
              -> GlobalRdrEnv -> GlobalRdrEnv
-- ^ Apply a transformation function to the GREs for these OccNames
transformGREs :: (GlobalRdrElt -> GlobalRdrElt)
-> [OccName] -> GlobalRdrEnv -> GlobalRdrEnv
transformGREs GlobalRdrElt -> GlobalRdrElt
trans_gre [OccName]
occs GlobalRdrEnv
rdr_env
  = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr OccName -> GlobalRdrEnv -> GlobalRdrEnv
trans GlobalRdrEnv
rdr_env [OccName]
occs
  where
    trans :: OccName -> GlobalRdrEnv -> GlobalRdrEnv
trans OccName
occ GlobalRdrEnv
env
      = case forall a. OccEnv a -> OccName -> Maybe a
lookupOccEnv GlobalRdrEnv
env OccName
occ of
           Just [GlobalRdrElt]
gres -> forall a. OccEnv a -> OccName -> a -> OccEnv a
extendOccEnv GlobalRdrEnv
env OccName
occ (forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> GlobalRdrElt
trans_gre [GlobalRdrElt]
gres)
           Maybe [GlobalRdrElt]
Nothing   -> GlobalRdrEnv
env

extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
extendGlobalRdrEnv GlobalRdrEnv
env GlobalRdrElt
gre
  = forall a b.
(a -> b -> b) -> (a -> b) -> OccEnv b -> OccName -> a -> OccEnv b
extendOccEnv_Acc GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
insertGRE forall a. a -> [a]
Utils.singleton GlobalRdrEnv
env
                     (GlobalRdrElt -> OccName
greOccName GlobalRdrElt
gre) GlobalRdrElt
gre

shadowNames :: GlobalRdrEnv -> [GreName] -> GlobalRdrEnv
shadowNames :: GlobalRdrEnv -> [GreName] -> GlobalRdrEnv
shadowNames = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' GlobalRdrEnv -> GreName -> GlobalRdrEnv
shadowName

{- Note [GlobalRdrEnv shadowing]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Before adding new names to the GlobalRdrEnv we nuke some existing entries;
this is "shadowing".  The actual work is done by RdrEnv.shadowName.
Suppose
   env' = shadowName env M.f

Then:
   * Looking up (Unqual f) in env' should succeed, returning M.f,
     even if env contains existing unqualified bindings for f.
     They are shadowed

   * Looking up (Qual M.f) in env' should succeed, returning M.f

   * Looking up (Qual X.f) in env', where X /= M, should be the same as
     looking up (Qual X.f) in env.
     That is, shadowName does /not/ delete earlier qualified bindings

There are two reasons for shadowing:

* The GHCi REPL

  - Ids bought into scope on the command line (eg let x = True) have
    External Names, like Ghci4.x.  We want a new binding for 'x' (say)
    to override the existing binding for 'x'.  Example:

           ghci> :load M    -- Brings `x` and `M.x` into scope
           ghci> x
           ghci> "Hello"
           ghci> M.x
           ghci> "hello"
           ghci> let x = True  -- Shadows `x`
           ghci> x             -- The locally bound `x`
                               -- NOT an ambiguous reference
           ghci> True
           ghci> M.x           -- M.x is still in scope!
           ghci> "Hello"
    So when we add `x = True` we must not delete the `M.x` from the
    `GlobalRdrEnv`; rather we just want to make it "qualified only";
    hence the `mk_fake-imp_spec` in `shadowName`.  See also Note
    [Interactively-bound Ids in GHCi] in GHC.Runtime.Context

  - Data types also have External Names, like Ghci4.T; but we still want
    'T' to mean the newly-declared 'T', not an old one.

* Nested Template Haskell declaration brackets
  See Note [Top-level Names in Template Haskell decl quotes] in GHC.Rename.Names

  Consider a TH decl quote:
      module M where
        f x = h [d| f = ...f...M.f... |]
  We must shadow the outer unqualified binding of 'f', else we'll get
  a complaint when extending the GlobalRdrEnv, saying that there are
  two bindings for 'f'.  There are several tricky points:

    - This shadowing applies even if the binding for 'f' is in a
      where-clause, and hence is in the *local* RdrEnv not the *global*
      RdrEnv.  This is done in lcl_env_TH in extendGlobalRdrEnvRn.

    - The External Name M.f from the enclosing module must certainly
      still be available.  So we don't nuke it entirely; we just make
      it seem like qualified import.

    - We only shadow *External* names (which come from the main module),
      or from earlier GHCi commands. Do not shadow *Internal* names
      because in the bracket
          [d| class C a where f :: a
              f = 4 |]
      rnSrcDecls will first call extendGlobalRdrEnvRn with C[f] from the
      class decl, and *separately* extend the envt with the value binding.
      At that stage, the class op 'f' will have an Internal name.
-}

shadowName :: GlobalRdrEnv -> GreName -> GlobalRdrEnv
-- Remove certain old GREs that share the same OccName as this new Name.
-- See Note [GlobalRdrEnv shadowing] for details
shadowName :: GlobalRdrEnv -> GreName -> GlobalRdrEnv
shadowName GlobalRdrEnv
env GreName
new_name
  = forall elt.
(Maybe elt -> Maybe elt) -> OccEnv elt -> OccName -> OccEnv elt
alterOccEnv (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GlobalRdrElt -> Maybe GlobalRdrElt
shadow)) GlobalRdrEnv
env (forall name. HasOccName name => name -> OccName
occName GreName
new_name)
  where
    maybe_new_mod :: Maybe Module
maybe_new_mod = Name -> Maybe Module
nameModule_maybe (GreName -> Name
greNameMangledName GreName
new_name)

    shadow :: GlobalRdrElt -> Maybe GlobalRdrElt
    shadow :: GlobalRdrElt -> Maybe GlobalRdrElt
shadow
       old_gre :: GlobalRdrElt
old_gre@(GRE { gre_lcl :: GlobalRdrElt -> Bool
gre_lcl = Bool
lcl, gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_imp = [ImportSpec]
iss })
       = case GlobalRdrElt -> Maybe Module
greDefinitionModule GlobalRdrElt
old_gre of
           Maybe Module
Nothing -> forall a. a -> Maybe a
Just GlobalRdrElt
old_gre   -- Old name is Internal; do not shadow
           Just Module
old_mod
              | Just Module
new_mod <- Maybe Module
maybe_new_mod
              , Module
new_mod forall a. Eq a => a -> a -> Bool
== Module
old_mod   -- Old name same as new name; shadow completely
              -> forall a. Maybe a
Nothing

              | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ImportSpec]
iss'            -- Nothing remains
              -> forall a. Maybe a
Nothing

              | Bool
otherwise
              -> forall a. a -> Maybe a
Just (GlobalRdrElt
old_gre { gre_lcl :: Bool
gre_lcl = Bool
False, gre_imp :: [ImportSpec]
gre_imp = [ImportSpec]
iss' })

              where
                iss' :: [ImportSpec]
iss' = [ImportSpec]
lcl_imp forall a. [a] -> [a] -> [a]
++ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ImportSpec -> Maybe ImportSpec
shadow_is [ImportSpec]
iss
                lcl_imp :: [ImportSpec]
lcl_imp | Bool
lcl       = [forall {unit}. GlobalRdrElt -> GenModule unit -> ImportSpec
mk_fake_imp_spec GlobalRdrElt
old_gre Module
old_mod]
                        | Bool
otherwise = []

    mk_fake_imp_spec :: GlobalRdrElt -> GenModule unit -> ImportSpec
mk_fake_imp_spec GlobalRdrElt
old_gre GenModule unit
old_mod    -- Urgh!
      = ImpDeclSpec -> ImpItemSpec -> ImportSpec
ImpSpec ImpDeclSpec
id_spec ImpItemSpec
ImpAll
      where
        old_mod_name :: ModuleName
old_mod_name = forall unit. GenModule unit -> ModuleName
moduleName GenModule unit
old_mod
        id_spec :: ImpDeclSpec
id_spec      = ImpDeclSpec { is_mod :: ModuleName
is_mod = ModuleName
old_mod_name
                                   , is_as :: ModuleName
is_as = ModuleName
old_mod_name
                                   , is_qual :: Bool
is_qual = Bool
True
                                   , is_dloc :: SrcSpan
is_dloc = GlobalRdrElt -> SrcSpan
greDefinitionSrcSpan GlobalRdrElt
old_gre }

    shadow_is :: ImportSpec -> Maybe ImportSpec
    shadow_is :: ImportSpec -> Maybe ImportSpec
shadow_is is :: ImportSpec
is@(ImpSpec { is_decl :: ImportSpec -> ImpDeclSpec
is_decl = ImpDeclSpec
id_spec })
       | Just Module
new_mod <- Maybe Module
maybe_new_mod
       , ImpDeclSpec -> ModuleName
is_as ImpDeclSpec
id_spec forall a. Eq a => a -> a -> Bool
== forall unit. GenModule unit -> ModuleName
moduleName Module
new_mod
       = forall a. Maybe a
Nothing   -- Shadow both qualified and unqualified
       | Bool
otherwise -- Shadow unqualified only
       = forall a. a -> Maybe a
Just (ImportSpec
is { is_decl :: ImpDeclSpec
is_decl = ImpDeclSpec
id_spec { is_qual :: Bool
is_qual = Bool
True } })


{-
************************************************************************
*                                                                      *
                        ImportSpec
*                                                                      *
************************************************************************
-}

-- | Import Specification
--
-- The 'ImportSpec' of something says how it came to be imported
-- It's quite elaborate so that we can give accurate unused-name warnings.
data ImportSpec = ImpSpec { ImportSpec -> ImpDeclSpec
is_decl :: ImpDeclSpec,
                            ImportSpec -> ImpItemSpec
is_item :: ImpItemSpec }
                deriving( ImportSpec -> ImportSpec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportSpec -> ImportSpec -> Bool
$c/= :: ImportSpec -> ImportSpec -> Bool
== :: ImportSpec -> ImportSpec -> Bool
$c== :: ImportSpec -> ImportSpec -> Bool
Eq, Typeable ImportSpec
ImportSpec -> DataType
ImportSpec -> Constr
(forall b. Data b => b -> b) -> ImportSpec -> ImportSpec
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ImportSpec -> u
forall u. (forall d. Data d => d -> u) -> ImportSpec -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImportSpec -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImportSpec -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImportSpec -> m ImportSpec
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImportSpec -> m ImportSpec
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImportSpec
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImportSpec -> c ImportSpec
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImportSpec)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImportSpec)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImportSpec -> m ImportSpec
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImportSpec -> m ImportSpec
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImportSpec -> m ImportSpec
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImportSpec -> m ImportSpec
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImportSpec -> m ImportSpec
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImportSpec -> m ImportSpec
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImportSpec -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImportSpec -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ImportSpec -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ImportSpec -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImportSpec -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImportSpec -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImportSpec -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImportSpec -> r
gmapT :: (forall b. Data b => b -> b) -> ImportSpec -> ImportSpec
$cgmapT :: (forall b. Data b => b -> b) -> ImportSpec -> ImportSpec
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImportSpec)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ImportSpec)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImportSpec)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImportSpec)
dataTypeOf :: ImportSpec -> DataType
$cdataTypeOf :: ImportSpec -> DataType
toConstr :: ImportSpec -> Constr
$ctoConstr :: ImportSpec -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImportSpec
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImportSpec
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImportSpec -> c ImportSpec
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImportSpec -> c ImportSpec
Data )

-- | Import Declaration Specification
--
-- Describes a particular import declaration and is
-- shared among all the 'Provenance's for that decl
data ImpDeclSpec
  = ImpDeclSpec {
        ImpDeclSpec -> ModuleName
is_mod      :: ModuleName, -- ^ Module imported, e.g. @import Muggle@
                                   -- Note the @Muggle@ may well not be
                                   -- the defining module for this thing!

                                   -- TODO: either should be Module, or there
                                   -- should be a Maybe UnitId here too.
        ImpDeclSpec -> ModuleName
is_as       :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)
        ImpDeclSpec -> Bool
is_qual     :: Bool,       -- ^ Was this import qualified?
        ImpDeclSpec -> SrcSpan
is_dloc     :: SrcSpan     -- ^ The location of the entire import declaration
    } deriving (ImpDeclSpec -> ImpDeclSpec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImpDeclSpec -> ImpDeclSpec -> Bool
$c/= :: ImpDeclSpec -> ImpDeclSpec -> Bool
== :: ImpDeclSpec -> ImpDeclSpec -> Bool
$c== :: ImpDeclSpec -> ImpDeclSpec -> Bool
Eq, Typeable ImpDeclSpec
ImpDeclSpec -> DataType
ImpDeclSpec -> Constr
(forall b. Data b => b -> b) -> ImpDeclSpec -> ImpDeclSpec
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ImpDeclSpec -> u
forall u. (forall d. Data d => d -> u) -> ImpDeclSpec -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImpDeclSpec -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImpDeclSpec -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImpDeclSpec -> m ImpDeclSpec
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImpDeclSpec -> m ImpDeclSpec
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImpDeclSpec
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImpDeclSpec -> c ImpDeclSpec
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImpDeclSpec)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImpDeclSpec)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImpDeclSpec -> m ImpDeclSpec
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImpDeclSpec -> m ImpDeclSpec
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImpDeclSpec -> m ImpDeclSpec
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImpDeclSpec -> m ImpDeclSpec
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImpDeclSpec -> m ImpDeclSpec
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImpDeclSpec -> m ImpDeclSpec
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImpDeclSpec -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImpDeclSpec -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ImpDeclSpec -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ImpDeclSpec -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImpDeclSpec -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImpDeclSpec -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImpDeclSpec -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImpDeclSpec -> r
gmapT :: (forall b. Data b => b -> b) -> ImpDeclSpec -> ImpDeclSpec
$cgmapT :: (forall b. Data b => b -> b) -> ImpDeclSpec -> ImpDeclSpec
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImpDeclSpec)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImpDeclSpec)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImpDeclSpec)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImpDeclSpec)
dataTypeOf :: ImpDeclSpec -> DataType
$cdataTypeOf :: ImpDeclSpec -> DataType
toConstr :: ImpDeclSpec -> Constr
$ctoConstr :: ImpDeclSpec -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImpDeclSpec
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImpDeclSpec
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImpDeclSpec -> c ImpDeclSpec
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImpDeclSpec -> c ImpDeclSpec
Data)

-- | Import Item Specification
--
-- Describes import info a particular Name
data ImpItemSpec
  = ImpAll              -- ^ The import had no import list,
                        -- or had a hiding list

  | ImpSome {
        ImpItemSpec -> Bool
is_explicit :: Bool,
        ImpItemSpec -> SrcSpan
is_iloc     :: SrcSpan  -- Location of the import item
    }   -- ^ The import had an import list.
        -- The 'is_explicit' field is @True@ iff the thing was named
        -- /explicitly/ in the import specs rather
        -- than being imported as part of a "..." group. Consider:
        --
        -- > import C( T(..) )
        --
        -- Here the constructors of @T@ are not named explicitly;
        -- only @T@ is named explicitly.
  deriving (ImpItemSpec -> ImpItemSpec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImpItemSpec -> ImpItemSpec -> Bool
$c/= :: ImpItemSpec -> ImpItemSpec -> Bool
== :: ImpItemSpec -> ImpItemSpec -> Bool
$c== :: ImpItemSpec -> ImpItemSpec -> Bool
Eq, Typeable ImpItemSpec
ImpItemSpec -> DataType
ImpItemSpec -> Constr
(forall b. Data b => b -> b) -> ImpItemSpec -> ImpItemSpec
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ImpItemSpec -> u
forall u. (forall d. Data d => d -> u) -> ImpItemSpec -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImpItemSpec -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImpItemSpec -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImpItemSpec -> m ImpItemSpec
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImpItemSpec -> m ImpItemSpec
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImpItemSpec
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImpItemSpec -> c ImpItemSpec
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImpItemSpec)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImpItemSpec)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImpItemSpec -> m ImpItemSpec
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImpItemSpec -> m ImpItemSpec
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImpItemSpec -> m ImpItemSpec
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImpItemSpec -> m ImpItemSpec
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImpItemSpec -> m ImpItemSpec
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImpItemSpec -> m ImpItemSpec
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImpItemSpec -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImpItemSpec -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ImpItemSpec -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ImpItemSpec -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImpItemSpec -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImpItemSpec -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImpItemSpec -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImpItemSpec -> r
gmapT :: (forall b. Data b => b -> b) -> ImpItemSpec -> ImpItemSpec
$cgmapT :: (forall b. Data b => b -> b) -> ImpItemSpec -> ImpItemSpec
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImpItemSpec)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImpItemSpec)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImpItemSpec)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImpItemSpec)
dataTypeOf :: ImpItemSpec -> DataType
$cdataTypeOf :: ImpItemSpec -> DataType
toConstr :: ImpItemSpec -> Constr
$ctoConstr :: ImpItemSpec -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImpItemSpec
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImpItemSpec
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImpItemSpec -> c ImpItemSpec
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImpItemSpec -> c ImpItemSpec
Data)

bestImport :: [ImportSpec] -> ImportSpec
-- See Note [Choosing the best import declaration]
bestImport :: [ImportSpec] -> ImportSpec
bestImport [ImportSpec]
iss
  = case forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ImportSpec -> ImportSpec -> Ordering
best [ImportSpec]
iss of
      (ImportSpec
is:[ImportSpec]
_) -> ImportSpec
is
      []     -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"bestImport" (forall a. Outputable a => a -> SDoc
ppr [ImportSpec]
iss)
  where
    best :: ImportSpec -> ImportSpec -> Ordering
    -- Less means better
    -- Unqualified always wins over qualified; then
    -- import-all wins over import-some; then
    -- earlier declaration wins over later
    best :: ImportSpec -> ImportSpec -> Ordering
best (ImpSpec { is_item :: ImportSpec -> ImpItemSpec
is_item = ImpItemSpec
item1, is_decl :: ImportSpec -> ImpDeclSpec
is_decl = ImpDeclSpec
d1 })
         (ImpSpec { is_item :: ImportSpec -> ImpItemSpec
is_item = ImpItemSpec
item2, is_decl :: ImportSpec -> ImpDeclSpec
is_decl = ImpDeclSpec
d2 })
      = (ImpDeclSpec -> Bool
is_qual ImpDeclSpec
d1 forall a. Ord a => a -> a -> Ordering
`compare` ImpDeclSpec -> Bool
is_qual ImpDeclSpec
d2) Ordering -> Ordering -> Ordering
`thenCmp`
        (ImpItemSpec -> ImpItemSpec -> Ordering
best_item ImpItemSpec
item1 ImpItemSpec
item2)           Ordering -> Ordering -> Ordering
`thenCmp`
        SrcSpan -> SrcSpan -> Ordering
SrcLoc.leftmost_smallest (ImpDeclSpec -> SrcSpan
is_dloc ImpDeclSpec
d1) (ImpDeclSpec -> SrcSpan
is_dloc ImpDeclSpec
d2)

    best_item :: ImpItemSpec -> ImpItemSpec -> Ordering
    best_item :: ImpItemSpec -> ImpItemSpec -> Ordering
best_item ImpItemSpec
ImpAll ImpItemSpec
ImpAll = Ordering
EQ
    best_item ImpItemSpec
ImpAll (ImpSome {}) = Ordering
LT
    best_item (ImpSome {}) ImpItemSpec
ImpAll = Ordering
GT
    best_item (ImpSome { is_explicit :: ImpItemSpec -> Bool
is_explicit = Bool
e1 })
              (ImpSome { is_explicit :: ImpItemSpec -> Bool
is_explicit = Bool
e2 }) = Bool
e1 forall a. Ord a => a -> a -> Ordering
`compare` Bool
e2
     -- False < True, so if e1 is explicit and e2 is not, we get GT

{- Note [Choosing the best import declaration]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When reporting unused import declarations we use the following rules.
   (see [wiki:commentary/compiler/unused-imports])

Say that an import-item is either
  * an entire import-all decl (eg import Foo), or
  * a particular item in an import list (eg import Foo( ..., x, ...)).
The general idea is that for each /occurrence/ of an imported name, we will
attribute that use to one import-item. Once we have processed all the
occurrences, any import items with no uses attributed to them are unused,
and are warned about. More precisely:

1. For every RdrName in the program text, find its GlobalRdrElt.

2. Then, from the [ImportSpec] (gre_imp) of that GRE, choose one
   the "chosen import-item", and mark it "used". This is done
   by 'bestImport'

3. After processing all the RdrNames, bleat about any
   import-items that are unused.
   This is done in GHC.Rename.Names.warnUnusedImportDecls.

The function 'bestImport' returns the dominant import among the
ImportSpecs it is given, implementing Step 2.  We say import-item A
dominates import-item B if we choose A over B. In general, we try to
choose the import that is most likely to render other imports
unnecessary.  Here is the dominance relationship we choose:

    a) import Foo dominates import qualified Foo.

    b) import Foo dominates import Foo(x).

    c) Otherwise choose the textually first one.

Rationale for (a).  Consider
   import qualified M  -- Import #1
   import M( x )       -- Import #2
   foo = M.x + x

The unqualified 'x' can only come from import #2.  The qualified 'M.x'
could come from either, but bestImport picks import #2, because it is
more likely to be useful in other imports, as indeed it is in this
case (see #5211 for a concrete example).

But the rules are not perfect; consider
   import qualified M  -- Import #1
   import M( x )       -- Import #2
   foo = M.x + M.y

The M.x will use import #2, but M.y can only use import #1.
-}


unQualSpecOK :: ImportSpec -> Bool
-- ^ Is in scope unqualified?
unQualSpecOK :: ImportSpec -> Bool
unQualSpecOK ImportSpec
is = Bool -> Bool
not (ImpDeclSpec -> Bool
is_qual (ImportSpec -> ImpDeclSpec
is_decl ImportSpec
is))

qualSpecOK :: ModuleName -> ImportSpec -> Bool
-- ^ Is in scope qualified with the given module?
qualSpecOK :: ModuleName -> ImportSpec -> Bool
qualSpecOK ModuleName
mod ImportSpec
is = ModuleName
mod forall a. Eq a => a -> a -> Bool
== ImpDeclSpec -> ModuleName
is_as (ImportSpec -> ImpDeclSpec
is_decl ImportSpec
is)

importSpecLoc :: ImportSpec -> SrcSpan
importSpecLoc :: ImportSpec -> SrcSpan
importSpecLoc (ImpSpec ImpDeclSpec
decl ImpItemSpec
ImpAll) = ImpDeclSpec -> SrcSpan
is_dloc ImpDeclSpec
decl
importSpecLoc (ImpSpec ImpDeclSpec
_    ImpItemSpec
item)   = ImpItemSpec -> SrcSpan
is_iloc ImpItemSpec
item

importSpecModule :: ImportSpec -> ModuleName
importSpecModule :: ImportSpec -> ModuleName
importSpecModule ImportSpec
is = ImpDeclSpec -> ModuleName
is_mod (ImportSpec -> ImpDeclSpec
is_decl ImportSpec
is)

isExplicitItem :: ImpItemSpec -> Bool
isExplicitItem :: ImpItemSpec -> Bool
isExplicitItem ImpItemSpec
ImpAll                        = Bool
False
isExplicitItem (ImpSome {is_explicit :: ImpItemSpec -> Bool
is_explicit = Bool
exp}) = Bool
exp

pprNameProvenance :: GlobalRdrElt -> SDoc
-- ^ Print out one place where the name was define/imported
-- (With -dppr-debug, print them all)
pprNameProvenance :: GlobalRdrElt -> SDoc
pprNameProvenance gre :: GlobalRdrElt
gre@(GRE { gre_lcl :: GlobalRdrElt -> Bool
gre_lcl = Bool
lcl, gre_imp :: GlobalRdrElt -> [ImportSpec]
gre_imp = [ImportSpec]
iss })
  = SDoc -> SDoc -> SDoc
ifPprDebug ([SDoc] -> SDoc
vcat [SDoc]
pp_provs)
               (forall a. [a] -> a
head [SDoc]
pp_provs)
  where
    name :: Name
name = GlobalRdrElt -> Name
greMangledName GlobalRdrElt
gre
    pp_provs :: [SDoc]
pp_provs = [SDoc]
pp_lcl forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map ImportSpec -> SDoc
pp_is [ImportSpec]
iss
    pp_lcl :: [SDoc]
pp_lcl = if Bool
lcl then [String -> SDoc
text String
"defined at" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (Name -> SrcLoc
nameSrcLoc Name
name)]
                    else []
    pp_is :: ImportSpec -> SDoc
pp_is ImportSpec
is = [SDoc] -> SDoc
sep [forall a. Outputable a => a -> SDoc
ppr ImportSpec
is, ImportSpec -> Name -> SDoc
ppr_defn_site ImportSpec
is Name
name]

-- If we know the exact definition point (which we may do with GHCi)
-- then show that too.  But not if it's just "imported from X".
ppr_defn_site :: ImportSpec -> Name -> SDoc
ppr_defn_site :: ImportSpec -> Name -> SDoc
ppr_defn_site ImportSpec
imp_spec Name
name
  | Bool
same_module Bool -> Bool -> Bool
&& Bool -> Bool
not (SrcSpan -> Bool
isGoodSrcSpan SrcSpan
loc)
  = SDoc
empty              -- Nothing interesting to say
  | Bool
otherwise
  = SDoc -> SDoc
parens forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"and originally defined" SDoc -> SDoc -> SDoc
<+> SDoc
pp_mod)
                Int
2 (SrcSpan -> SDoc
pprLoc SrcSpan
loc)
  where
    loc :: SrcSpan
loc = Name -> SrcSpan
nameSrcSpan Name
name
    defining_mod :: Module
defining_mod = ASSERT2( isExternalName name, ppr name ) nameModule name
    same_module :: Bool
same_module = ImportSpec -> ModuleName
importSpecModule ImportSpec
imp_spec forall a. Eq a => a -> a -> Bool
== forall unit. GenModule unit -> ModuleName
moduleName Module
defining_mod
    pp_mod :: SDoc
pp_mod | Bool
same_module = SDoc
empty
           | Bool
otherwise   = String -> SDoc
text String
"in" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr Module
defining_mod)


instance Outputable ImportSpec where
   ppr :: ImportSpec -> SDoc
ppr ImportSpec
imp_spec
     = String -> SDoc
text String
"imported" SDoc -> SDoc -> SDoc
<+> SDoc
qual
        SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"from" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr (ImportSpec -> ModuleName
importSpecModule ImportSpec
imp_spec))
        SDoc -> SDoc -> SDoc
<+> SrcSpan -> SDoc
pprLoc (ImportSpec -> SrcSpan
importSpecLoc ImportSpec
imp_spec)
     where
       qual :: SDoc
qual | ImpDeclSpec -> Bool
is_qual (ImportSpec -> ImpDeclSpec
is_decl ImportSpec
imp_spec) = String -> SDoc
text String
"qualified"
            | Bool
otherwise                  = SDoc
empty

pprLoc :: SrcSpan -> SDoc
pprLoc :: SrcSpan -> SDoc
pprLoc (RealSrcSpan RealSrcSpan
s Maybe BufSpan
_)  = String -> SDoc
text String
"at" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
s
pprLoc (UnhelpfulSpan {}) = SDoc
empty

-- | Display info about the treatment of '*' under NoStarIsType.
--
-- With StarIsType, three properties of '*' hold:
--
--   (a) it is not an infix operator
--   (b) it is always in scope
--   (c) it is a synonym for Data.Kind.Type
--
-- However, the user might not know that they are working on a module with
-- NoStarIsType and write code that still assumes (a), (b), and (c), which
-- actually do not hold in that module.
--
-- Violation of (a) shows up in the parser. For instance, in the following
-- examples, we have '*' not applied to enough arguments:
--
--   data A :: *
--   data F :: * -> *
--
-- Violation of (b) or (c) show up in the renamer and the typechecker
-- respectively. For instance:
--
--   type K = Either * Bool
--
-- This will parse differently depending on whether StarIsType is enabled,
-- but it will parse nonetheless. With NoStarIsType it is parsed as a type
-- operator, thus we have ((*) Either Bool). Now there are two cases to
-- consider:
--
--   1. There is no definition of (*) in scope. In this case the renamer will
--      fail to look it up. This is a violation of assumption (b).
--
--   2. There is a definition of the (*) type operator in scope (for example
--      coming from GHC.TypeNats). In this case the user will get a kind
--      mismatch error. This is a violation of assumption (c).
--
-- The user might unknowingly be working on a module with NoStarIsType
-- or use '*' as 'Data.Kind.Type' out of habit. So it is important to give a
-- hint whenever an assumption about '*' is violated. Unfortunately, it is
-- somewhat difficult to deal with (c), so we limit ourselves to (a) and (b).
--
-- 'starInfo' generates an appropriate hint to the user depending on the
-- extensions enabled in the module and the name that triggered the error.
-- That is, if we have NoStarIsType and the error is related to '*' or its
-- Unicode variant, the resulting SDoc will contain a helpful suggestion.
-- Otherwise it is empty.
--
starInfo :: Bool -> RdrName -> SDoc
starInfo :: Bool -> RdrName -> SDoc
starInfo Bool
star_is_type RdrName
rdr_name =
  -- One might ask: if can use `sdocOption sdocStarIsType` here, why bother to
  -- take star_is_type as input? Why not refactor?
  --
  -- The reason is that `sdocOption sdocStarIsType` would indicate that
  -- StarIsType is enabled in the module that tries to load the problematic
  -- definition, not in the module that is being loaded.
  --
  -- So if we have 'data T :: *' in a module with NoStarIsType, then the hint
  -- must be displayed even if we load this definition from a module (or GHCi)
  -- with StarIsType enabled!
  --
  if Bool
isUnqualStar Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
star_is_type
     then String -> SDoc
text String
"With NoStarIsType, " SDoc -> SDoc -> SDoc
<>
          SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name) SDoc -> SDoc -> SDoc
<>
          String -> SDoc
text String
" is treated as a regular type operator. "
        SDoc -> SDoc -> SDoc
$$
          String -> SDoc
text String
"Did you mean to use " SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
quotes (String -> SDoc
text String
"Type") SDoc -> SDoc -> SDoc
<>
          String -> SDoc
text String
" from Data.Kind instead?"
      else SDoc
empty
  where
    -- Does rdr_name look like the user might have meant the '*' kind by it?
    -- We focus on unqualified stars specifically, because qualified stars are
    -- treated as type operators even under StarIsType.
    isUnqualStar :: Bool
isUnqualStar
      | Unqual OccName
occName <- RdrName
rdr_name
      = let fs :: FastString
fs = OccName -> FastString
occNameFS OccName
occName
        in FastString
fs forall a. Eq a => a -> a -> Bool
== String -> FastString
fsLit String
"*" Bool -> Bool -> Bool
|| FastString
fs forall a. Eq a => a -> a -> Bool
== String -> FastString
fsLit String
"★"
      | Bool
otherwise = Bool
False

-- | Indicate if the given name is the "@" operator
opIsAt :: RdrName -> Bool
opIsAt :: RdrName -> Bool
opIsAt RdrName
e = RdrName
e forall a. Eq a => a -> a -> Bool
== NameSpace -> FastString -> RdrName
mkUnqual NameSpace
varName (String -> FastString
fsLit String
"@")