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


{-# 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

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

delListFromNameSet :: NameSet -> [Name] -> NameSet
delListFromNameSet NameSet
set [Name]
ns = (NameSet -> Name -> NameSet) -> NameSet -> [Name] -> NameSet
forall b a. (b -> a -> b) -> b -> [a] -> b
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 = (Name -> Bool) -> NameSet -> Bool
forall a. (a -> Bool) -> UniqSet a -> Bool
uniqSetAny

nameSetAll :: (Name -> Bool) -> NameSet -> Bool
nameSetAll :: (Name -> Bool) -> NameSet -> Bool
nameSetAll = (Name -> Bool) -> NameSet -> Bool
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 =
  (Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Name -> Name -> Ordering
stableNameCmp ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ NameSet -> [Name]
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 = DefUses
forall a. OrdList a
nilOL

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

mkDUs :: [(Defs,Uses)] -> DefUses
mkDUs :: [(NameSet, NameSet)] -> DefUses
mkDUs [(NameSet, NameSet)]
pairs = [DefUse] -> DefUses
forall a. [a] -> OrdList a
toOL [(NameSet -> Maybe NameSet
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 = DefUses -> DefUses -> DefUses
forall a. OrdList a -> OrdList a -> OrdList a
appOL

duDefs :: DefUses -> Defs
duDefs :: DefUses -> NameSet
duDefs DefUses
dus = (DefUse -> NameSet -> NameSet) -> NameSet -> DefUses -> NameSet
forall a b. (a -> b -> b) -> b -> OrdList a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DefUse -> NameSet -> NameSet
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 = (DefUse -> NameSet -> NameSet) -> NameSet -> DefUses -> NameSet
forall a b. (a -> b -> b) -> b -> OrdList a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DefUse -> NameSet -> NameSet
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 = (DefUse -> NameSet -> NameSet) -> NameSet -> DefUses -> NameSet
forall a b. (a -> b -> b) -> b -> OrdList a -> b
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
  = (DefUse -> NameSet -> NameSet) -> NameSet -> DefUses -> NameSet
forall a b. (a -> b -> b) -> b -> OrdList a -> b
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 (OccName -> Bool) -> (Name -> OccName) -> Name -> Bool
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
(NonCaffySet -> NonCaffySet -> NonCaffySet)
-> (NonEmpty NonCaffySet -> NonCaffySet)
-> (forall b. Integral b => b -> NonCaffySet -> NonCaffySet)
-> Semigroup 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
$c<> :: NonCaffySet -> NonCaffySet -> NonCaffySet
<> :: NonCaffySet -> NonCaffySet -> NonCaffySet
$csconcat :: NonEmpty NonCaffySet -> NonCaffySet
sconcat :: NonEmpty NonCaffySet -> NonCaffySet
$cstimes :: forall b. Integral b => b -> NonCaffySet -> NonCaffySet
stimes :: forall b. Integral b => b -> NonCaffySet -> NonCaffySet
Semigroup, Semigroup NonCaffySet
NonCaffySet
Semigroup NonCaffySet
-> NonCaffySet
-> (NonCaffySet -> NonCaffySet -> NonCaffySet)
-> ([NonCaffySet] -> NonCaffySet)
-> Monoid NonCaffySet
[NonCaffySet] -> NonCaffySet
NonCaffySet -> NonCaffySet -> NonCaffySet
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: NonCaffySet
mempty :: NonCaffySet
$cmappend :: NonCaffySet -> NonCaffySet -> NonCaffySet
mappend :: NonCaffySet -> NonCaffySet -> NonCaffySet
$cmconcat :: [NonCaffySet] -> NonCaffySet
mconcat :: [NonCaffySet] -> NonCaffySet
Monoid)