{-# LANGUAGE DeriveDataTypeable #-}
--
-- (c) The University of Glasgow
--

module GHC.Types.Avail (
    Avails,
    AvailInfo(..),
    avail,
    availField,
    availTC,
    availsToNameSet,
    availsToNameSetWithSelectors,
    availsToNameEnv,
    availExportsDecl,
    availName, availGreName,
    availNames, availNonFldNames,
    availNamesWithSelectors,
    availFlds,
    availGreNames,
    availSubordinateGreNames,
    stableAvailCmp,
    plusAvail,
    trimAvail,
    filterAvail,
    filterAvails,
    nubAvails,

    GreName(..),
    greNameMangledName,
    greNamePrintableName,
    greNameSrcSpan,
    greNameFieldLabel,
    partitionGreNames,
    stableGreNameCmp,
  ) where

import GHC.Prelude

import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Types.SrcLoc

import GHC.Types.FieldLabel
import GHC.Utils.Binary
import GHC.Data.List.SetOps
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Constants (debugIsOn)

import Control.DeepSeq
import Data.Data ( Data )
import Data.Either ( partitionEithers )
import Data.Functor.Classes ( liftCompare )
import Data.List ( find )
import Data.Maybe
import qualified Data.Semigroup as S

-- -----------------------------------------------------------------------------
-- The AvailInfo type

-- | Records what things are \"available\", i.e. in scope
data AvailInfo

  -- | An ordinary identifier in scope, or a field label without a parent type
  -- (see Note [Representing pattern synonym fields in AvailInfo]).
  = Avail GreName

  -- | A type or class in scope
  --
  -- The __AvailTC Invariant__: If the type or class is itself to be in scope,
  -- it must be /first/ in this list.  Thus, typically:
  --
  -- > AvailTC Eq [Eq, ==, \/=]
  | AvailTC
       Name         -- ^ The name of the type or class
       [GreName]      -- ^ The available pieces of type or class
                    -- (see Note [Representing fields in AvailInfo]).

   deriving ( AvailInfo -> AvailInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AvailInfo -> AvailInfo -> Bool
$c/= :: AvailInfo -> AvailInfo -> Bool
== :: AvailInfo -> AvailInfo -> Bool
$c== :: AvailInfo -> AvailInfo -> Bool
Eq    -- ^ Used when deciding if the interface has changed
            , Typeable AvailInfo
AvailInfo -> DataType
AvailInfo -> Constr
(forall b. Data b => b -> b) -> AvailInfo -> AvailInfo
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) -> AvailInfo -> u
forall u. (forall d. Data d => d -> u) -> AvailInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AvailInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AvailInfo -> c AvailInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AvailInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AvailInfo)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AvailInfo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AvailInfo -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> AvailInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AvailInfo -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
gmapT :: (forall b. Data b => b -> b) -> AvailInfo -> AvailInfo
$cgmapT :: (forall b. Data b => b -> b) -> AvailInfo -> AvailInfo
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AvailInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AvailInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AvailInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AvailInfo)
dataTypeOf :: AvailInfo -> DataType
$cdataTypeOf :: AvailInfo -> DataType
toConstr :: AvailInfo -> Constr
$ctoConstr :: AvailInfo -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AvailInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AvailInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AvailInfo -> c AvailInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AvailInfo -> c AvailInfo
Data )

-- | A collection of 'AvailInfo' - several things that are \"available\"
type Avails = [AvailInfo]

{-
Note [Representing fields in AvailInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See also Note [FieldLabel] in GHC.Types.FieldLabel.

When -XDuplicateRecordFields is disabled (the normal case), a
datatype like

  data T = MkT { foo :: Int }

gives rise to the AvailInfo

  AvailTC T [T, MkT, FieldLabel "foo" NoDuplicateRecordFields FieldSelectors foo]

whereas if -XDuplicateRecordFields is enabled it gives

  AvailTC T [T, MkT, FieldLabel "foo" DuplicateRecordFields FieldSelectors $sel:foo:MkT]

where the label foo does not match the selector name $sel:foo:MkT.

The labels in a field list are not necessarily unique:
data families allow the same parent (the family tycon) to have
multiple distinct fields with the same label. For example,

  data family F a
  data instance F Int  = MkFInt { foo :: Int }
  data instance F Bool = MkFBool { foo :: Bool}

gives rise to

  AvailTC F [ F, MkFInt, MkFBool
            , FieldLabel "foo" DuplicateRecordFields FieldSelectors $sel:foo:MkFInt
            , FieldLabel "foo" DuplicateRecordFields FieldSelectors $sel:foo:MkFBool ]

Moreover, note that the flHasDuplicateRecordFields or flFieldSelectors flags
need not be the same for all the elements of the list.  In the example above,
this occurs if the two data instances are defined in different modules, with
different states of the `-XDuplicateRecordFields` or `-XNoFieldSelectors`
extensions.  Thus it is possible to have

  AvailTC F [ F, MkFInt, MkFBool
            , FieldLabel "foo" DuplicateRecordFields FieldSelectors $sel:foo:MkFInt
            , FieldLabel "foo" NoDuplicateRecordFields FieldSelectors foo ]

If the two data instances are defined in different modules, both without
`-XDuplicateRecordFields` or `-XNoFieldSelectors`, it will be impossible to
export them from the same module (even with `-XDuplicateRecordfields` enabled),
because they would be represented identically.  The workaround here is to enable
`-XDuplicateRecordFields` or `-XNoFieldSelectors` on the defining modules.  See
also #13352.


Note [Representing pattern synonym fields in AvailInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Record pattern synonym fields cannot be represented using AvailTC like fields of
normal record types (see Note [Representing fields in AvailInfo]), because they
do not always have a parent type constructor.  So we represent them using the
Avail constructor, with a NormalGreName that carries the underlying FieldLabel.

Thus under -XDuplicateRecordFields -XPatternSynoynms, the declaration

  pattern MkFoo{f} = Bar f

gives rise to the AvailInfo

  Avail (NormalGreName MkFoo)
  Avail (FieldGreName (FieldLabel "f" True $sel:f:MkFoo))

However, if `f` is bundled with a type constructor `T` by using `T(MkFoo,f)` in
an export list, then whenever `f` is imported the parent will be `T`,
represented as

  AvailTC T [ NormalGreName T
            , NormalGreName MkFoo
            , FieldGreName (FieldLabel "f" True $sel:f:MkFoo) ]

See also Note [GreNames] in GHC.Types.Name.Reader.
-}

-- | Compare lexicographically
stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
stableAvailCmp (Avail GreName
c1)     (Avail GreName
c2)     = GreName
c1 GreName -> GreName -> Ordering
`stableGreNameCmp` GreName
c2
stableAvailCmp (Avail {})     (AvailTC {})   = Ordering
LT
stableAvailCmp (AvailTC Name
n [GreName]
ns) (AvailTC Name
m [GreName]
ms) = Name -> Name -> Ordering
stableNameCmp Name
n Name
m forall a. Semigroup a => a -> a -> a
S.<> forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare GreName -> GreName -> Ordering
stableGreNameCmp [GreName]
ns [GreName]
ms
stableAvailCmp (AvailTC {})   (Avail {})     = Ordering
GT

stableGreNameCmp :: GreName -> GreName -> Ordering
stableGreNameCmp :: GreName -> GreName -> Ordering
stableGreNameCmp (NormalGreName Name
n1) (NormalGreName Name
n2) = Name
n1 Name -> Name -> Ordering
`stableNameCmp` Name
n2
stableGreNameCmp (NormalGreName {}) (FieldGreName  {}) = Ordering
LT
stableGreNameCmp (FieldGreName  FieldLabel
f1) (FieldGreName  FieldLabel
f2) = FieldLabel -> Name
flSelector FieldLabel
f1 Name -> Name -> Ordering
`stableNameCmp` FieldLabel -> Name
flSelector FieldLabel
f2
stableGreNameCmp (FieldGreName  {}) (NormalGreName {}) = Ordering
GT

avail :: Name -> AvailInfo
avail :: Name -> AvailInfo
avail Name
n = GreName -> AvailInfo
Avail (Name -> GreName
NormalGreName Name
n)

availField :: FieldLabel -> AvailInfo
availField :: FieldLabel -> AvailInfo
availField FieldLabel
fl = GreName -> AvailInfo
Avail (FieldLabel -> GreName
FieldGreName FieldLabel
fl)

availTC :: Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC :: Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC Name
n [Name]
ns [FieldLabel]
fls = Name -> [GreName] -> AvailInfo
AvailTC Name
n (forall a b. (a -> b) -> [a] -> [b]
map Name -> GreName
NormalGreName [Name]
ns forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> GreName
FieldGreName [FieldLabel]
fls)


-- -----------------------------------------------------------------------------
-- Operations on AvailInfo

availsToNameSet :: [AvailInfo] -> NameSet
availsToNameSet :: [AvailInfo] -> NameSet
availsToNameSet [AvailInfo]
avails = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AvailInfo -> NameSet -> NameSet
add NameSet
emptyNameSet [AvailInfo]
avails
      where add :: AvailInfo -> NameSet -> NameSet
add AvailInfo
avail NameSet
set = NameSet -> [Name] -> NameSet
extendNameSetList NameSet
set (AvailInfo -> [Name]
availNames AvailInfo
avail)

availsToNameSetWithSelectors :: [AvailInfo] -> NameSet
availsToNameSetWithSelectors :: [AvailInfo] -> NameSet
availsToNameSetWithSelectors [AvailInfo]
avails = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AvailInfo -> NameSet -> NameSet
add NameSet
emptyNameSet [AvailInfo]
avails
      where add :: AvailInfo -> NameSet -> NameSet
add AvailInfo
avail NameSet
set = NameSet -> [Name] -> NameSet
extendNameSetList NameSet
set (AvailInfo -> [Name]
availNamesWithSelectors AvailInfo
avail)

availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
availsToNameEnv [AvailInfo]
avails = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AvailInfo -> NameEnv AvailInfo -> NameEnv AvailInfo
add forall a. NameEnv a
emptyNameEnv [AvailInfo]
avails
     where add :: AvailInfo -> NameEnv AvailInfo -> NameEnv AvailInfo
add AvailInfo
avail NameEnv AvailInfo
env = forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList NameEnv AvailInfo
env
                                (forall a b. [a] -> [b] -> [(a, b)]
zip (AvailInfo -> [Name]
availNames AvailInfo
avail) (forall a. a -> [a]
repeat AvailInfo
avail))

-- | Does this 'AvailInfo' export the parent decl?  This depends on the
-- invariant that the parent is first if it appears at all.
availExportsDecl :: AvailInfo -> Bool
availExportsDecl :: AvailInfo -> Bool
availExportsDecl (AvailTC Name
ty_name [GreName]
names)
  | GreName
n : [GreName]
_ <- [GreName]
names = Name -> GreName
NormalGreName Name
ty_name forall a. Eq a => a -> a -> Bool
== GreName
n
  | Bool
otherwise      = Bool
False
availExportsDecl AvailInfo
_ = Bool
True

-- | Just the main name made available, i.e. not the available pieces
-- of type or class brought into scope by the 'AvailInfo'
availName :: AvailInfo -> Name
availName :: AvailInfo -> Name
availName (Avail GreName
n)     = GreName -> Name
greNameMangledName GreName
n
availName (AvailTC Name
n [GreName]
_) = Name
n

availGreName :: AvailInfo -> GreName
availGreName :: AvailInfo -> GreName
availGreName (Avail GreName
c) = GreName
c
availGreName (AvailTC Name
n [GreName]
_) = Name -> GreName
NormalGreName Name
n

-- | All names made available by the availability information (excluding overloaded selectors)
availNames :: AvailInfo -> [Name]
availNames :: AvailInfo -> [Name]
availNames (Avail GreName
c) = GreName -> [Name]
childNonOverloadedNames GreName
c
availNames (AvailTC Name
_ [GreName]
cs) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GreName -> [Name]
childNonOverloadedNames [GreName]
cs

childNonOverloadedNames :: GreName -> [Name]
childNonOverloadedNames :: GreName -> [Name]
childNonOverloadedNames (NormalGreName Name
n) = [Name
n]
childNonOverloadedNames (FieldGreName FieldLabel
fl) = [ FieldLabel -> Name
flSelector FieldLabel
fl | Bool -> Bool
not (FieldLabel -> Bool
flIsOverloaded FieldLabel
fl) ]

-- | All names made available by the availability information (including overloaded selectors)
availNamesWithSelectors :: AvailInfo -> [Name]
availNamesWithSelectors :: AvailInfo -> [Name]
availNamesWithSelectors (Avail GreName
c) = [GreName -> Name
greNameMangledName GreName
c]
availNamesWithSelectors (AvailTC Name
_ [GreName]
cs) = forall a b. (a -> b) -> [a] -> [b]
map GreName -> Name
greNameMangledName [GreName]
cs

-- | Names for non-fields made available by the availability information
availNonFldNames :: AvailInfo -> [Name]
availNonFldNames :: AvailInfo -> [Name]
availNonFldNames (Avail (NormalGreName Name
n)) = [Name
n]
availNonFldNames (Avail (FieldGreName {})) = []
availNonFldNames (AvailTC Name
_ [GreName]
ns) = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GreName -> Maybe Name
f [GreName]
ns
  where
    f :: GreName -> Maybe Name
f (NormalGreName Name
n) = forall a. a -> Maybe a
Just Name
n
    f (FieldGreName {}) = forall a. Maybe a
Nothing

-- | Fields made available by the availability information
availFlds :: AvailInfo -> [FieldLabel]
availFlds :: AvailInfo -> [FieldLabel]
availFlds (Avail GreName
c) = forall a. Maybe a -> [a]
maybeToList (GreName -> Maybe FieldLabel
greNameFieldLabel GreName
c)
availFlds (AvailTC Name
_ [GreName]
cs) = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe GreName -> Maybe FieldLabel
greNameFieldLabel [GreName]
cs

-- | Names and fields made available by the availability information.
availGreNames :: AvailInfo -> [GreName]
availGreNames :: AvailInfo -> [GreName]
availGreNames (Avail GreName
c)      = [GreName
c]
availGreNames (AvailTC Name
_ [GreName]
cs) = [GreName]
cs

-- | Names and fields made available by the availability information, other than
-- the main decl itself.
availSubordinateGreNames :: AvailInfo -> [GreName]
availSubordinateGreNames :: AvailInfo -> [GreName]
availSubordinateGreNames (Avail {}) = []
availSubordinateGreNames avail :: AvailInfo
avail@(AvailTC Name
_ [GreName]
ns)
  | AvailInfo -> Bool
availExportsDecl AvailInfo
avail = forall a. [a] -> [a]
tail [GreName]
ns
  | Bool
otherwise              = [GreName]
ns


-- | Used where we may have an ordinary name or a record field label.
-- See Note [GreNames] in GHC.Types.Name.Reader.
data GreName = NormalGreName Name
             | FieldGreName FieldLabel
    deriving (Typeable GreName
GreName -> DataType
GreName -> Constr
(forall b. Data b => b -> b) -> GreName -> GreName
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) -> GreName -> u
forall u. (forall d. Data d => d -> u) -> GreName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GreName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GreName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GreName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GreName -> c GreName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GreName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GreName)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GreName -> m GreName
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GreName -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GreName -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> GreName -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GreName -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GreName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GreName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GreName -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GreName -> r
gmapT :: (forall b. Data b => b -> b) -> GreName -> GreName
$cgmapT :: (forall b. Data b => b -> b) -> GreName -> GreName
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GreName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GreName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GreName)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GreName)
dataTypeOf :: GreName -> DataType
$cdataTypeOf :: GreName -> DataType
toConstr :: GreName -> Constr
$ctoConstr :: GreName -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GreName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GreName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GreName -> c GreName
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GreName -> c GreName
Data, GreName -> GreName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GreName -> GreName -> Bool
$c/= :: GreName -> GreName -> Bool
== :: GreName -> GreName -> Bool
$c== :: GreName -> GreName -> Bool
Eq)

instance Outputable GreName where
  ppr :: GreName -> SDoc
ppr (NormalGreName Name
n) = forall a. Outputable a => a -> SDoc
ppr Name
n
  ppr (FieldGreName FieldLabel
fl) = forall a. Outputable a => a -> SDoc
ppr FieldLabel
fl

instance NFData GreName where
  rnf :: GreName -> ()
rnf (NormalGreName Name
n) = forall a. NFData a => a -> ()
rnf Name
n
  rnf (FieldGreName FieldLabel
f) = forall a. NFData a => a -> ()
rnf FieldLabel
f

instance HasOccName GreName where
  occName :: GreName -> OccName
occName (NormalGreName Name
n) = forall name. HasOccName name => name -> OccName
occName Name
n
  occName (FieldGreName FieldLabel
fl) = forall name. HasOccName name => name -> OccName
occName FieldLabel
fl

instance Ord GreName where
  compare :: GreName -> GreName -> Ordering
compare = GreName -> GreName -> Ordering
stableGreNameCmp

-- | A 'Name' for internal use, but not for output to the user.  For fields, the
-- 'OccName' will be the selector.  See Note [GreNames] in GHC.Types.Name.Reader.
greNameMangledName :: GreName -> Name
greNameMangledName :: GreName -> Name
greNameMangledName (NormalGreName Name
n) = Name
n
greNameMangledName (FieldGreName FieldLabel
fl) = FieldLabel -> Name
flSelector FieldLabel
fl

-- | A 'Name' suitable for output to the user.  For fields, the 'OccName' will
-- be the field label.  See Note [GreNames] in GHC.Types.Name.Reader.
greNamePrintableName :: GreName -> Name
greNamePrintableName :: GreName -> Name
greNamePrintableName (NormalGreName Name
n) = Name
n
greNamePrintableName (FieldGreName FieldLabel
fl) = FieldLabel -> Name
fieldLabelPrintableName FieldLabel
fl

greNameSrcSpan :: GreName -> SrcSpan
greNameSrcSpan :: GreName -> SrcSpan
greNameSrcSpan (NormalGreName Name
n) = Name -> SrcSpan
nameSrcSpan Name
n
greNameSrcSpan (FieldGreName FieldLabel
fl) = Name -> SrcSpan
nameSrcSpan (FieldLabel -> Name
flSelector FieldLabel
fl)

greNameFieldLabel :: GreName -> Maybe FieldLabel
greNameFieldLabel :: GreName -> Maybe FieldLabel
greNameFieldLabel (NormalGreName {}) = forall a. Maybe a
Nothing
greNameFieldLabel (FieldGreName FieldLabel
fl)  = forall a. a -> Maybe a
Just FieldLabel
fl

partitionGreNames :: [GreName] -> ([Name], [FieldLabel])
partitionGreNames :: [GreName] -> ([Name], [FieldLabel])
partitionGreNames = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map GreName -> Either Name FieldLabel
to_either
  where
    to_either :: GreName -> Either Name FieldLabel
to_either (NormalGreName Name
n) = forall a b. a -> Either a b
Left Name
n
    to_either (FieldGreName FieldLabel
fl) = forall a b. b -> Either a b
Right FieldLabel
fl


-- -----------------------------------------------------------------------------
-- Utility

plusAvail :: AvailInfo -> AvailInfo -> AvailInfo
plusAvail :: AvailInfo -> AvailInfo -> AvailInfo
plusAvail AvailInfo
a1 AvailInfo
a2
  | Bool
debugIsOn Bool -> Bool -> Bool
&& AvailInfo -> Name
availName AvailInfo
a1 forall a. Eq a => a -> a -> Bool
/= AvailInfo -> Name
availName AvailInfo
a2
  = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"GHC.Rename.Env.plusAvail names differ" (forall doc. IsLine doc => [doc] -> doc
hsep [forall a. Outputable a => a -> SDoc
ppr AvailInfo
a1,forall a. Outputable a => a -> SDoc
ppr AvailInfo
a2])
plusAvail a1 :: AvailInfo
a1@(Avail {})         (Avail {})        = AvailInfo
a1
plusAvail (AvailTC Name
_ [])     a2 :: AvailInfo
a2@(AvailTC {})   = AvailInfo
a2
plusAvail a1 :: AvailInfo
a1@(AvailTC {})       (AvailTC Name
_ []) = AvailInfo
a1
plusAvail (AvailTC Name
n1 (GreName
s1:[GreName]
ss1)) (AvailTC Name
n2 (GreName
s2:[GreName]
ss2))
  = case (Name -> GreName
NormalGreName Name
n1forall a. Eq a => a -> a -> Bool
==GreName
s1, Name -> GreName
NormalGreName Name
n2forall a. Eq a => a -> a -> Bool
==GreName
s2) of  -- Maintain invariant the parent is first
       (Bool
True,Bool
True)   -> Name -> [GreName] -> AvailInfo
AvailTC Name
n1 (GreName
s1 forall a. a -> [a] -> [a]
: ([GreName]
ss1 forall a.
(HasDebugCallStack, Outputable a, Ord a) =>
[a] -> [a] -> [a]
`unionListsOrd` [GreName]
ss2))
       (Bool
True,Bool
False)  -> Name -> [GreName] -> AvailInfo
AvailTC Name
n1 (GreName
s1 forall a. a -> [a] -> [a]
: ([GreName]
ss1 forall a.
(HasDebugCallStack, Outputable a, Ord a) =>
[a] -> [a] -> [a]
`unionListsOrd` (GreName
s2forall a. a -> [a] -> [a]
:[GreName]
ss2)))
       (Bool
False,Bool
True)  -> Name -> [GreName] -> AvailInfo
AvailTC Name
n1 (GreName
s2 forall a. a -> [a] -> [a]
: ((GreName
s1forall a. a -> [a] -> [a]
:[GreName]
ss1) forall a.
(HasDebugCallStack, Outputable a, Ord a) =>
[a] -> [a] -> [a]
`unionListsOrd` [GreName]
ss2))
       (Bool
False,Bool
False) -> Name -> [GreName] -> AvailInfo
AvailTC Name
n1 ((GreName
s1forall a. a -> [a] -> [a]
:[GreName]
ss1) forall a.
(HasDebugCallStack, Outputable a, Ord a) =>
[a] -> [a] -> [a]
`unionListsOrd` (GreName
s2forall a. a -> [a] -> [a]
:[GreName]
ss2))
plusAvail AvailInfo
a1 AvailInfo
a2 = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"GHC.Rename.Env.plusAvail" (forall doc. IsLine doc => [doc] -> doc
hsep [forall a. Outputable a => a -> SDoc
ppr AvailInfo
a1,forall a. Outputable a => a -> SDoc
ppr AvailInfo
a2])

-- | trims an 'AvailInfo' to keep only a single name
trimAvail :: AvailInfo -> Name -> AvailInfo
trimAvail :: AvailInfo -> Name -> AvailInfo
trimAvail avail :: AvailInfo
avail@(Avail {})         Name
_ = AvailInfo
avail
trimAvail avail :: AvailInfo
avail@(AvailTC Name
n [GreName]
ns) Name
m = case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== Name
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. GreName -> Name
greNameMangledName) [GreName]
ns of
    Just GreName
c  -> Name -> [GreName] -> AvailInfo
AvailTC Name
n [GreName
c]
    Maybe GreName
Nothing -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"trimAvail" (forall doc. IsLine doc => [doc] -> doc
hsep [forall a. Outputable a => a -> SDoc
ppr AvailInfo
avail, forall a. Outputable a => a -> SDoc
ppr Name
m])

-- | filters 'AvailInfo's by the given predicate
filterAvails  :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo]
filterAvails :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo]
filterAvails Name -> Bool
keep [AvailInfo]
avails = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
filterAvail Name -> Bool
keep) [] [AvailInfo]
avails

-- | filters an 'AvailInfo' by the given predicate
filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
filterAvail Name -> Bool
keep AvailInfo
ie [AvailInfo]
rest =
  case AvailInfo
ie of
    Avail GreName
c | Name -> Bool
keep (GreName -> Name
greNameMangledName GreName
c) -> AvailInfo
ie forall a. a -> [a] -> [a]
: [AvailInfo]
rest
            | Bool
otherwise -> [AvailInfo]
rest
    AvailTC Name
tc [GreName]
cs ->
        let cs' :: [GreName]
cs' = forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> Bool
keep forall b c a. (b -> c) -> (a -> b) -> a -> c
. GreName -> Name
greNameMangledName) [GreName]
cs
        in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GreName]
cs' then [AvailInfo]
rest else Name -> [GreName] -> AvailInfo
AvailTC Name
tc [GreName]
cs' forall a. a -> [a] -> [a]
: [AvailInfo]
rest


-- | Combines 'AvailInfo's from the same family
-- 'avails' may have several items with the same availName
-- E.g  import Ix( Ix(..), index )
-- will give Ix(Ix,index,range) and Ix(index)
-- We want to combine these; addAvail does that
nubAvails :: [AvailInfo] -> [AvailInfo]
nubAvails :: [AvailInfo] -> [AvailInfo]
nubAvails [AvailInfo]
avails = forall a. DNameEnv a -> [a]
eltsDNameEnv (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DNameEnv AvailInfo -> AvailInfo -> DNameEnv AvailInfo
add forall a. DNameEnv a
emptyDNameEnv [AvailInfo]
avails)
  where
    add :: DNameEnv AvailInfo -> AvailInfo -> DNameEnv AvailInfo
add DNameEnv AvailInfo
env AvailInfo
avail = forall a. (a -> a -> a) -> DNameEnv a -> Name -> a -> DNameEnv a
extendDNameEnv_C AvailInfo -> AvailInfo -> AvailInfo
plusAvail DNameEnv AvailInfo
env (AvailInfo -> Name
availName AvailInfo
avail) AvailInfo
avail

-- -----------------------------------------------------------------------------
-- Printing

instance Outputable AvailInfo where
   ppr :: AvailInfo -> SDoc
ppr = AvailInfo -> SDoc
pprAvail

pprAvail :: AvailInfo -> SDoc
pprAvail :: AvailInfo -> SDoc
pprAvail (Avail GreName
n)
  = forall a. Outputable a => a -> SDoc
ppr GreName
n
pprAvail (AvailTC Name
n [GreName]
ns)
  = forall a. Outputable a => a -> SDoc
ppr Name
n forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
braces (forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas forall a. Outputable a => a -> SDoc
ppr [GreName]
ns)

instance Binary AvailInfo where
    put_ :: BinHandle -> AvailInfo -> IO ()
put_ BinHandle
bh (Avail GreName
aa) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh GreName
aa
    put_ BinHandle
bh (AvailTC Name
ab [GreName]
ac) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Name
ab
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [GreName]
ac
    get :: BinHandle -> IO AvailInfo
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do GreName
aa <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      forall (m :: * -> *) a. Monad m => a -> m a
return (GreName -> AvailInfo
Avail GreName
aa)
              Word8
_ -> do Name
ab <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      [GreName]
ac <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [GreName] -> AvailInfo
AvailTC Name
ab [GreName]
ac)

instance NFData AvailInfo where
  rnf :: AvailInfo -> ()
rnf (Avail GreName
n) = forall a. NFData a => a -> ()
rnf GreName
n
  rnf (AvailTC Name
a [GreName]
b) = forall a. NFData a => a -> ()
rnf Name
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [GreName]
b

instance Binary GreName where
    put_ :: BinHandle -> GreName -> IO ()
put_ BinHandle
bh (NormalGreName Name
aa) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Name
aa
    put_ BinHandle
bh (FieldGreName FieldLabel
ab) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FieldLabel
ab
    get :: BinHandle -> IO GreName
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do Name
aa <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> GreName
NormalGreName Name
aa)
              Word8
_ -> do FieldLabel
ab <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      forall (m :: * -> *) a. Monad m => a -> m a
return (FieldLabel -> GreName
FieldGreName FieldLabel
ab)