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

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    module GHC.Types.Name.Set (
            -- * Names set type
            NameSet,

            -- ** Manipulating these sets
            emptyNameSet, unitNameSet, mkNameSet, unionNameSet, unionNameSets,
            minusNameSet, elemNameSet, extendNameSet, extendNameSetList,
            delFromNameSet, delListFromNameSet, isEmptyNameSet, filterNameSet,
            intersectsNameSet, disjointNameSet, intersectNameSet,
            nameSetAny, nameSetAll, nameSetElemsStable,

            -- * Free variables
            FreeVars,

            -- ** Manipulating sets of free variables
            isEmptyFVs, emptyFVs, plusFVs, plusFV,
            mkFVs, addOneFV, unitFV, delFV, delFVs,
            intersectFVs,

            -- * Defs and uses
            Defs, Uses, DefUse, DefUses,

            -- ** Manipulating defs and uses
            emptyDUs, usesOnly, mkDUs, plusDU,
            findUses, duDefs, duUses, allUses,

            -- * Non-CAFfy names
            NonCaffySet(..)
        ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Types.Name
    import GHC.Data.OrdList
    import GHC.Types.Unique.Set
    import Data.List (sortBy)

    {-
    ************************************************************************
    *                                                                      *
    \subsection[Sets of names}
    *                                                                      *
    ************************************************************************
    -}

    type NameSet = UniqSet Name

    emptyNameSet       :: NameSet
    unitNameSet        :: Name -> NameSet
    extendNameSetList   :: NameSet -> [Name] -> NameSet
    extendNameSet    :: NameSet -> Name -> NameSet
    mkNameSet          :: [Name] -> NameSet
    unionNameSet      :: NameSet -> NameSet -> NameSet
    unionNameSets  :: [NameSet] -> NameSet
    minusNameSet       :: NameSet -> NameSet -> NameSet
    elemNameSet        :: Name -> NameSet -> Bool
    isEmptyNameSet     :: NameSet -> Bool
    delFromNameSet     :: NameSet -> Name -> NameSet
    delListFromNameSet :: NameSet -> [Name] -> NameSet
    filterNameSet      :: (Name -> Bool) -> NameSet -> NameSet
    intersectNameSet   :: NameSet -> NameSet -> NameSet
    intersectsNameSet  :: NameSet -> NameSet -> Bool
    disjointNameSet    :: NameSet -> NameSet -> Bool
    -- ^ True if there is a non-empty intersection.
    -- @s1 `intersectsNameSet` s2@ doesn't compute @s2@ if @s1@ is empty

    isEmptyNameSet :: NameSet -> Bool
    isEmptyNameSet    = forall a. UniqSet a -> Bool
    isEmptyUniqSet
    emptyNameSet :: NameSet
    emptyNameSet      = forall a. UniqSet a
    emptyUniqSet
    unitNameSet :: Name -> NameSet
    unitNameSet       = forall a. Uniquable a => a -> UniqSet a
    unitUniqSet
    mkNameSet :: [Name] -> NameSet
    mkNameSet         = forall a. Uniquable a => [a] -> UniqSet a
    mkUniqSet
    extendNameSetList :: NameSet -> [Name] -> NameSet
    extendNameSetList  = forall a. Uniquable a => UniqSet a -> [a] -> UniqSet a
    addListToUniqSet
    extendNameSet :: NameSet -> Name -> NameSet
    extendNameSet   = forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    addOneToUniqSet
    unionNameSet :: NameSet -> NameSet -> NameSet
    unionNameSet     = forall a. UniqSet a -> UniqSet a -> UniqSet a
    unionUniqSets
    unionNameSets :: [NameSet] -> NameSet
    unionNameSets = forall a. [UniqSet a] -> UniqSet a
    unionManyUniqSets
    minusNameSet :: NameSet -> NameSet -> NameSet
    minusNameSet      = forall a. UniqSet a -> UniqSet a -> UniqSet a
    minusUniqSet
    elemNameSet :: Name -> NameSet -> Bool
    elemNameSet       = forall a. Uniquable a => a -> UniqSet a -> Bool
    elementOfUniqSet
    delFromNameSet :: NameSet -> Name -> NameSet
    delFromNameSet    = forall a. Uniquable a => UniqSet a -> a -> UniqSet a
    delOneFromUniqSet
    filterNameSet :: (Name -> Bool) -> NameSet -> NameSet
    filterNameSet     = forall a. (a -> Bool) -> UniqSet a -> UniqSet a
    filterUniqSet
    intersectNameSet :: NameSet -> NameSet -> NameSet
    intersectNameSet  = forall a. UniqSet a -> UniqSet a -> UniqSet a
    intersectUniqSets
    disjointNameSet :: NameSet -> NameSet -> Bool
    disjointNameSet   = forall a. UniqSet a -> UniqSet a -> Bool
    disjointUniqSets

    delListFromNameSet :: NameSet -> [Name] -> NameSet
    delListFromNameSet NameSet
    set [Name]
    ns = forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' NameSet -> Name -> NameSet
    delFromNameSet NameSet
    set [Name]
    ns

    intersectsNameSet :: NameSet -> NameSet -> Bool
    intersectsNameSet NameSet
    s1 NameSet
    s2 = Bool -> Bool
    not (NameSet
    s1 NameSet -> NameSet -> Bool
    `disjointNameSet` NameSet
    s2)

    nameSetAny :: (Name -> Bool) -> NameSet -> Bool
    nameSetAny :: (Name -> Bool) -> NameSet -> Bool
    nameSetAny = forall a. (a -> Bool) -> UniqSet a -> Bool
    uniqSetAny

    nameSetAll :: (Name -> Bool) -> NameSet -> Bool
    nameSetAll :: (Name -> Bool) -> NameSet -> Bool
    nameSetAll = forall a. (a -> Bool) -> UniqSet a -> Bool
    uniqSetAll

    -- | Get the elements of a NameSet with some stable ordering.
    -- This only works for Names that originate in the source code or have been
    -- tidied.
    -- See Note [Deterministic UniqFM] to learn about nondeterminism
    nameSetElemsStable :: NameSet -> [Name]
    nameSetElemsStable :: NameSet -> [Name]
    nameSetElemsStable NameSet
    ns =
      forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy Name -> Name -> Ordering
    stableNameCmp forall a b. (a -> b) -> a -> b
    $ forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet NameSet
    ns
      -- It's OK to use nonDetEltsUniqSet here because we immediately sort
      -- with stableNameCmp

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Free variables}
    *                                                                      *
    ************************************************************************

    These synonyms are useful when we are thinking of free variables
    -}

    type FreeVars   = NameSet

    plusFV   :: FreeVars -> FreeVars -> FreeVars
    addOneFV :: FreeVars -> Name -> FreeVars
    unitFV   :: Name -> FreeVars
    emptyFVs :: FreeVars
    plusFVs  :: [FreeVars] -> FreeVars
    mkFVs    :: [Name] -> FreeVars
    delFV    :: Name -> FreeVars -> FreeVars
    delFVs   :: [Name] -> FreeVars -> FreeVars
    intersectFVs :: FreeVars -> FreeVars -> FreeVars

    isEmptyFVs :: NameSet -> Bool
    isEmptyFVs :: NameSet -> Bool
    isEmptyFVs  = NameSet -> Bool
    isEmptyNameSet
    emptyFVs :: NameSet
    emptyFVs    = NameSet
    emptyNameSet
    plusFVs :: [NameSet] -> NameSet
    plusFVs     = [NameSet] -> NameSet
    unionNameSets
    plusFV :: NameSet -> NameSet -> NameSet
    plusFV      = NameSet -> NameSet -> NameSet
    unionNameSet
    mkFVs :: [Name] -> NameSet
    mkFVs       = [Name] -> NameSet
    mkNameSet
    addOneFV :: NameSet -> Name -> NameSet
    addOneFV    = NameSet -> Name -> NameSet
    extendNameSet
    unitFV :: Name -> NameSet
    unitFV      = Name -> NameSet
    unitNameSet
    delFV :: Name -> NameSet -> NameSet
    delFV Name
    n NameSet
    s   = NameSet -> Name -> NameSet
    delFromNameSet NameSet
    s Name
    n
    delFVs :: [Name] -> NameSet -> NameSet
    delFVs [Name]
    ns NameSet
    s = NameSet -> [Name] -> NameSet
    delListFromNameSet NameSet
    s [Name]
    ns
    intersectFVs :: NameSet -> NameSet -> NameSet
    intersectFVs = NameSet -> NameSet -> NameSet
    intersectNameSet

    {-
    ************************************************************************
    *                                                                      *
                    Defs and uses
    *                                                                      *
    ************************************************************************
    -}

    -- | A set of names that are defined somewhere
    type Defs = NameSet

    -- | A set of names that are used somewhere
    type Uses = NameSet

    -- | @(Just ds, us) =>@ The use of any member of the @ds@
    --                      implies that all the @us@ are used too.
    --                      Also, @us@ may mention @ds@.
    --
    -- @Nothing =>@ Nothing is defined in this group, but
    --              nevertheless all the uses are essential.
    --              Used for instance declarations, for example
    type DefUse  = (Maybe Defs, Uses)

    -- | A number of 'DefUse's in dependency order: earlier 'Defs' scope over later 'Uses'
    --   In a single (def, use) pair, the defs also scope over the uses
    type DefUses = OrdList DefUse

    emptyDUs :: DefUses
    emptyDUs :: DefUses
    emptyDUs = forall a. OrdList a
    nilOL

    usesOnly :: Uses -> DefUses
    usesOnly :: NameSet -> DefUses
    usesOnly NameSet
    uses = forall a. a -> OrdList a
    unitOL (forall a. Maybe a
    Nothing, NameSet
    uses)

    mkDUs :: [(Defs,Uses)] -> DefUses
    mkDUs :: [(NameSet, NameSet)] -> DefUses
    mkDUs [(NameSet, NameSet)]
    pairs = forall a. [a] -> OrdList a
    toOL [(forall a. a -> Maybe a
    Just NameSet
    defs, NameSet
    uses) | (NameSet
    defs,NameSet
    uses) <- [(NameSet, NameSet)]
    pairs]

    plusDU :: DefUses -> DefUses -> DefUses
    plusDU :: DefUses -> DefUses -> DefUses
    plusDU = forall a. OrdList a -> OrdList a -> OrdList a
    appOL

    duDefs :: DefUses -> Defs
    duDefs :: DefUses -> NameSet
    duDefs DefUses
    dus = forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr forall {b}. (Maybe NameSet, b) -> NameSet -> NameSet
    get NameSet
    emptyNameSet DefUses
    dus
      where
        get :: (Maybe NameSet, b) -> NameSet -> NameSet
    get (Maybe NameSet
    Nothing, b
    _u1) NameSet
    d2 = NameSet
    d2
        get (Just NameSet
    d1, b
    _u1) NameSet
    d2 = NameSet
    d1 NameSet -> NameSet -> NameSet
    `unionNameSet` NameSet
    d2

    allUses :: DefUses -> Uses
    -- ^ Just like 'duUses', but 'Defs' are not eliminated from the 'Uses' returned
    allUses :: DefUses -> NameSet
    allUses DefUses
    dus = forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr forall {a}. (a, NameSet) -> NameSet -> NameSet
    get NameSet
    emptyNameSet DefUses
    dus
      where
        get :: (a, NameSet) -> NameSet -> NameSet
    get (a
    _d1, NameSet
    u1) NameSet
    u2 = NameSet
    u1 NameSet -> NameSet -> NameSet
    `unionNameSet` NameSet
    u2

    duUses :: DefUses -> Uses
    -- ^ Collect all 'Uses', regardless of whether the group is itself used,
    -- but remove 'Defs' on the way
    duUses :: DefUses -> NameSet
    duUses DefUses
    dus = forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr DefUse -> NameSet -> NameSet
    get NameSet
    emptyNameSet DefUses
    dus
      where
        get :: DefUse -> NameSet -> NameSet
    get (Maybe NameSet
    Nothing,   NameSet
    rhs_uses) NameSet
    uses = NameSet
    rhs_uses NameSet -> NameSet -> NameSet
    `unionNameSet` NameSet
    uses
        get (Just NameSet
    defs, NameSet
    rhs_uses) NameSet
    uses = (NameSet
    rhs_uses NameSet -> NameSet -> NameSet
    `unionNameSet` NameSet
    uses)
                                         NameSet -> NameSet -> NameSet
    `minusNameSet` NameSet
    defs

    findUses :: DefUses -> Uses -> Uses
    -- ^ Given some 'DefUses' and some 'Uses', find all the uses, transitively.
    -- The result is a superset of the input 'Uses'; and includes things defined
    -- in the input 'DefUses' (but only if they are used)
    findUses :: DefUses -> NameSet -> NameSet
    findUses DefUses
    dus NameSet
    uses
      = forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr DefUse -> NameSet -> NameSet
    get NameSet
    uses DefUses
    dus
      where
        get :: DefUse -> NameSet -> NameSet
    get (Maybe NameSet
    Nothing, NameSet
    rhs_uses) NameSet
    uses
            = NameSet
    rhs_uses NameSet -> NameSet -> NameSet
    `unionNameSet` NameSet
    uses
        get (Just NameSet
    defs, NameSet
    rhs_uses) NameSet
    uses
            | NameSet
    defs NameSet -> NameSet -> Bool
    `intersectsNameSet` NameSet
    uses         -- Used
            Bool -> Bool -> Bool
    || (Name -> Bool) -> NameSet -> Bool
    nameSetAny (OccName -> Bool
    startsWithUnderscore forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> OccName
    nameOccName) NameSet
    defs
                    -- At least one starts with an "_",
                    -- so treat the group as used
            = NameSet
    rhs_uses NameSet -> NameSet -> NameSet
    `unionNameSet` NameSet
    uses
            | Bool
    otherwise     -- No def is used
            = NameSet
    uses

    -- | 'Id's which have no CAF references. This is a result of analysis of C--.
    -- It is always safe to use an empty 'NonCaffySet'. TODO Refer to Note.
    newtype NonCaffySet = NonCaffySet NameSet
      deriving (NonEmpty NonCaffySet -> NonCaffySet
    NonCaffySet -> NonCaffySet -> NonCaffySet
    forall b. Integral b => b -> NonCaffySet -> NonCaffySet
    forall a.
    (a -> a -> a)
    -> (NonEmpty a -> a)
    -> (forall b. Integral b => b -> a -> a)
    -> Semigroup a
    stimes :: forall b. Integral b => b -> NonCaffySet -> NonCaffySet
    $cstimes :: forall b. Integral b => b -> NonCaffySet -> NonCaffySet
    sconcat :: NonEmpty NonCaffySet -> NonCaffySet
    $csconcat :: NonEmpty NonCaffySet -> NonCaffySet
    <> :: NonCaffySet -> NonCaffySet -> NonCaffySet
    $c<> :: NonCaffySet -> NonCaffySet -> NonCaffySet
    Semigroup, Semigroup NonCaffySet
    NonCaffySet
    [NonCaffySet] -> NonCaffySet
    NonCaffySet -> NonCaffySet -> NonCaffySet
    forall a.
    Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
    mconcat :: [NonCaffySet] -> NonCaffySet
    $cmconcat :: [NonCaffySet] -> NonCaffySet
    mappend :: NonCaffySet -> NonCaffySet -> NonCaffySet
    $cmappend :: NonCaffySet -> NonCaffySet -> NonCaffySet
    mempty :: NonCaffySet
    $cmempty :: NonCaffySet
    Monoid)