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

\section[NameEnv]{@NameEnv@: name environments}
-}


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

module GHC.Types.Name.Env (
        -- * Var, Id and TyVar environments (maps)
        NameEnv,

        -- ** Manipulating these environments
        mkNameEnv, mkNameEnvWith,
        emptyNameEnv, isEmptyNameEnv,
        unitNameEnv, nonDetNameEnvElts,
        extendNameEnv_C, extendNameEnv_Acc, extendNameEnv,
        extendNameEnvList, extendNameEnvList_C,
        filterNameEnv, mapMaybeNameEnv, anyNameEnv,
        plusNameEnv, plusNameEnv_C, plusNameEnv_CD, plusNameEnv_CD2, alterNameEnv,
        lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,
        elemNameEnv, mapNameEnv, disjointNameEnv,
        seqEltsNameEnv,

        DNameEnv,

        emptyDNameEnv,
        isEmptyDNameEnv,
        lookupDNameEnv,
        delFromDNameEnv, filterDNameEnv,
        mapDNameEnv,
        adjustDNameEnv, alterDNameEnv, extendDNameEnv,
        eltsDNameEnv, extendDNameEnv_C,
        plusDNameEnv_C,
        foldDNameEnv,
        nonDetStrictFoldDNameEnv,
        -- ** Dependency analysis
        depAnal
    ) where

import GHC.Prelude

import GHC.Data.Graph.Directed
import GHC.Types.Name
import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
import GHC.Data.Maybe

{-
************************************************************************
*                                                                      *
\subsection{Name environment}
*                                                                      *
************************************************************************
-}

{-
Note [depAnal determinism]
~~~~~~~~~~~~~~~~~~~~~~~~~~
depAnal is deterministic provided it gets the nodes in a deterministic order.
The order of lists that get_defs and get_uses return doesn't matter, as these
are only used to construct the edges, and stronglyConnCompFromEdgedVertices is
deterministic even when the edges are not in deterministic order as explained
in Note [Deterministic SCC] in GHC.Data.Graph.Directed.
-}

depAnal :: forall node.
           (node -> [Name])      -- Defs
        -> (node -> [Name])      -- Uses
        -> [node]
        -> [SCC node]
-- Perform dependency analysis on a group of definitions,
-- where each definition may define more than one Name
--
-- The get_defs and get_uses functions are called only once per node
depAnal :: forall node.
(node -> [Name]) -> (node -> [Name]) -> [node] -> [SCC node]
depAnal node -> [Name]
get_defs node -> [Name]
get_uses [node]
nodes
  = [Node Int node] -> [SCC node]
forall key payload.
Uniquable key =>
[Node key payload] -> [SCC payload]
stronglyConnCompFromEdgedVerticesUniq [Node Int node]
graph_nodes
  where
    graph_nodes :: [Node Int node]
graph_nodes = (((node, Int) -> Node Int node) -> [(node, Int)] -> [Node Int node]
forall a b. (a -> b) -> [a] -> [b]
map (node, Int) -> Node Int node
mk_node [(node, Int)]
keyed_nodes) :: [Node Int node]
    keyed_nodes :: [(node, Int)]
keyed_nodes = [node]
nodes [node] -> [Int] -> [(node, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [(Int
1::Int)..]
    mk_node :: (node, Int) -> Node Int node
mk_node (node
node, Int
key) =
      let !edges :: [Int]
edges = ((Name -> Maybe Int) -> [Name] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (NameEnv Int -> Name -> Maybe Int
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv Int
key_map) (node -> [Name]
get_uses node
node))
      in node -> Int -> [Int] -> Node Int node
forall key payload. payload -> key -> [key] -> Node key payload
DigraphNode node
node Int
key [Int]
edges

    key_map :: NameEnv Int   -- Maps a Name to the key of the decl that defines it
    key_map :: NameEnv Int
key_map = [(Name, Int)] -> NameEnv Int
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name
name,Int
key) | (node
node, Int
key) <- [(node, Int)]
keyed_nodes, Name
name <- node -> [Name]
get_defs node
node]

{-
************************************************************************
*                                                                      *
\subsection{Name environment}
*                                                                      *
************************************************************************
-}

-- | Name Environment
type NameEnv a = UniqFM Name a       -- Domain is Name

emptyNameEnv       :: NameEnv a
isEmptyNameEnv     :: NameEnv a -> Bool
mkNameEnv          :: [(Name,a)] -> NameEnv a
mkNameEnvWith      :: (a -> Name) -> [a] -> NameEnv a
nonDetNameEnvElts  :: NameEnv a -> [a]
alterNameEnv       :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a
extendNameEnv_C    :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
extendNameEnv_Acc  :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b
extendNameEnv      :: NameEnv a -> Name -> a -> NameEnv a
plusNameEnv        :: NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv_C      :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv_CD     :: (a->a->a) -> NameEnv a -> a -> NameEnv a -> a -> NameEnv a
plusNameEnv_CD2    :: (Maybe a->Maybe a->a) -> NameEnv a -> NameEnv a -> NameEnv a
extendNameEnvList  :: NameEnv a -> [(Name,a)] -> NameEnv a
extendNameEnvList_C :: (a->a->a) -> NameEnv a -> [(Name,a)] -> NameEnv a
delFromNameEnv     :: NameEnv a -> Name -> NameEnv a
delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a
elemNameEnv        :: Name -> NameEnv a -> Bool
unitNameEnv        :: Name -> a -> NameEnv a
lookupNameEnv      :: NameEnv a -> Name -> Maybe a
lookupNameEnv_NF   :: NameEnv a -> Name -> a
filterNameEnv      :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
mapMaybeNameEnv    :: (a -> Maybe b) -> NameEnv a -> NameEnv b
anyNameEnv         :: (elt -> Bool) -> NameEnv elt -> Bool
mapNameEnv         :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
disjointNameEnv    :: NameEnv a -> NameEnv a -> Bool
seqEltsNameEnv     :: (elt -> ()) -> NameEnv elt -> ()

nonDetNameEnvElts :: forall a. NameEnv a -> [a]
nonDetNameEnvElts NameEnv a
x         = NameEnv a -> [a]
forall key elt. UniqFM key elt -> [elt]
nonDetEltsUFM NameEnv a
x
emptyNameEnv :: forall a. NameEnv a
emptyNameEnv          = UniqFM Name a
forall key elt. UniqFM key elt
emptyUFM
isEmptyNameEnv :: forall a. NameEnv a -> Bool
isEmptyNameEnv        = UniqFM Name a -> Bool
forall key elt. UniqFM key elt -> Bool
isNullUFM
unitNameEnv :: forall a. Name -> a -> NameEnv a
unitNameEnv Name
x a
y       = Name -> a -> UniqFM Name a
forall key elt. Uniquable key => key -> elt -> UniqFM key elt
unitUFM Name
x a
y
extendNameEnv :: forall a. NameEnv a -> Name -> a -> NameEnv a
extendNameEnv NameEnv a
x Name
y a
z   = NameEnv a -> Name -> a -> NameEnv a
forall key elt.
Uniquable key =>
UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM NameEnv a
x Name
y a
z
extendNameEnvList :: forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList NameEnv a
x [(Name, a)]
l = NameEnv a -> [(Name, a)] -> NameEnv a
forall key elt.
Uniquable key =>
UniqFM key elt -> [(key, elt)] -> UniqFM key elt
addListToUFM NameEnv a
x [(Name, a)]
l
lookupNameEnv :: forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv a
x Name
y     = NameEnv a -> Name -> Maybe a
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM NameEnv a
x Name
y
alterNameEnv :: forall a. (Maybe a -> Maybe a) -> NameEnv a -> Name -> NameEnv a
alterNameEnv          = (Maybe a -> Maybe a) -> UniqFM Name a -> Name -> UniqFM Name a
forall key elt.
Uniquable key =>
(Maybe elt -> Maybe elt) -> UniqFM key elt -> key -> UniqFM key elt
alterUFM
mkNameEnv :: forall a. [(Name, a)] -> NameEnv a
mkNameEnv     [(Name, a)]
l       = [(Name, a)] -> UniqFM Name a
forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
listToUFM [(Name, a)]
l
mkNameEnvWith :: forall a. (a -> Name) -> [a] -> NameEnv a
mkNameEnvWith a -> Name
f       = [(Name, a)] -> NameEnv a
forall a. [(Name, a)] -> NameEnv a
mkNameEnv ([(Name, a)] -> NameEnv a)
-> ([a] -> [(Name, a)]) -> [a] -> NameEnv a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (Name, a)) -> [a] -> [(Name, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\a
a -> (a -> Name
f a
a, a
a))
elemNameEnv :: forall a. Name -> NameEnv a -> Bool
elemNameEnv Name
x NameEnv a
y          = Name -> NameEnv a -> Bool
forall key elt. Uniquable key => key -> UniqFM key elt -> Bool
elemUFM Name
x NameEnv a
y
plusNameEnv :: forall a. NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv NameEnv a
x NameEnv a
y          = NameEnv a -> NameEnv a -> NameEnv a
forall key elt. UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusUFM NameEnv a
x NameEnv a
y
plusNameEnv_C :: forall a. (a -> a -> a) -> NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv_C a -> a -> a
f NameEnv a
x NameEnv a
y      = (a -> a -> a) -> NameEnv a -> NameEnv a -> NameEnv a
forall elt key.
(elt -> elt -> elt)
-> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
plusUFM_C a -> a -> a
f NameEnv a
x NameEnv a
y
{-# INLINE plusNameEnv_CD #-}
plusNameEnv_CD :: forall a.
(a -> a -> a) -> NameEnv a -> a -> NameEnv a -> a -> NameEnv a
plusNameEnv_CD a -> a -> a
f NameEnv a
x a
d NameEnv a
y a
b = (a -> a -> a) -> NameEnv a -> a -> NameEnv a -> a -> NameEnv a
forall elta eltb eltc key.
(elta -> eltb -> eltc)
-> UniqFM key elta
-> elta
-> UniqFM key eltb
-> eltb
-> UniqFM key eltc
plusUFM_CD a -> a -> a
f NameEnv a
x a
d NameEnv a
y a
b
plusNameEnv_CD2 :: forall a.
(Maybe a -> Maybe a -> a) -> NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv_CD2 Maybe a -> Maybe a -> a
f NameEnv a
x NameEnv a
y    = (Maybe a -> Maybe a -> a) -> NameEnv a -> NameEnv a -> NameEnv a
forall elta eltb eltc key.
(Maybe elta -> Maybe eltb -> eltc)
-> UniqFM key elta -> UniqFM key eltb -> UniqFM key eltc
plusUFM_CD2 Maybe a -> Maybe a -> a
f NameEnv a
x NameEnv a
y
extendNameEnv_C :: forall a. (a -> a -> a) -> NameEnv a -> Name -> a -> NameEnv a
extendNameEnv_C a -> a -> a
f NameEnv a
x Name
y a
z  = (a -> a -> a) -> NameEnv a -> Name -> a -> NameEnv a
forall key elt.
Uniquable key =>
(elt -> elt -> elt)
-> UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM_C a -> a -> a
f NameEnv a
x Name
y a
z
mapNameEnv :: forall elt1 elt2. (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
mapNameEnv elt1 -> elt2
f NameEnv elt1
x           = (elt1 -> elt2) -> NameEnv elt1 -> UniqFM Name elt2
forall elt1 elt2 key.
(elt1 -> elt2) -> UniqFM key elt1 -> UniqFM key elt2
mapUFM elt1 -> elt2
f NameEnv elt1
x
extendNameEnv_Acc :: forall a b.
(a -> b -> b) -> (a -> b) -> NameEnv b -> Name -> a -> NameEnv b
extendNameEnv_Acc a -> b -> b
x a -> b
y NameEnv b
z Name
a a
b  = (a -> b -> b) -> (a -> b) -> NameEnv b -> Name -> a -> NameEnv b
forall key elt elts.
Uniquable key =>
(elt -> elts -> elts)
-> (elt -> elts)
-> UniqFM key elts
-> key
-> elt
-> UniqFM key elts
addToUFM_Acc a -> b -> b
x a -> b
y NameEnv b
z Name
a a
b
extendNameEnvList_C :: forall a. (a -> a -> a) -> NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList_C a -> a -> a
x NameEnv a
y [(Name, a)]
z = (a -> a -> a) -> NameEnv a -> [(Name, a)] -> NameEnv a
forall key elt.
Uniquable key =>
(elt -> elt -> elt)
-> UniqFM key elt -> [(key, elt)] -> UniqFM key elt
addListToUFM_C a -> a -> a
x NameEnv a
y [(Name, a)]
z
delFromNameEnv :: forall a. NameEnv a -> Name -> NameEnv a
delFromNameEnv NameEnv a
x Name
y      = NameEnv a -> Name -> NameEnv a
forall key elt.
Uniquable key =>
UniqFM key elt -> key -> UniqFM key elt
delFromUFM NameEnv a
x Name
y
delListFromNameEnv :: forall a. NameEnv a -> [Name] -> NameEnv a
delListFromNameEnv NameEnv a
x [Name]
y  = NameEnv a -> [Name] -> NameEnv a
forall key elt.
Uniquable key =>
UniqFM key elt -> [key] -> UniqFM key elt
delListFromUFM NameEnv a
x [Name]
y
filterNameEnv :: forall elt. (elt -> Bool) -> NameEnv elt -> NameEnv elt
filterNameEnv elt -> Bool
x NameEnv elt
y       = (elt -> Bool) -> NameEnv elt -> NameEnv elt
forall elt key. (elt -> Bool) -> UniqFM key elt -> UniqFM key elt
filterUFM elt -> Bool
x NameEnv elt
y
mapMaybeNameEnv :: forall a b. (a -> Maybe b) -> NameEnv a -> NameEnv b
mapMaybeNameEnv a -> Maybe b
x NameEnv a
y     = (a -> Maybe b) -> NameEnv a -> UniqFM Name b
forall elt1 elt2 key.
(elt1 -> Maybe elt2) -> UniqFM key elt1 -> UniqFM key elt2
mapMaybeUFM a -> Maybe b
x NameEnv a
y
anyNameEnv :: forall elt. (elt -> Bool) -> NameEnv elt -> Bool
anyNameEnv elt -> Bool
f NameEnv elt
x          = (elt -> Bool -> Bool) -> Bool -> NameEnv elt -> Bool
forall elt a key. (elt -> a -> a) -> a -> UniqFM key elt -> a
foldUFM (Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> (elt -> Bool) -> elt -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. elt -> Bool
f) Bool
False NameEnv elt
x
disjointNameEnv :: forall a. NameEnv a -> NameEnv a -> Bool
disjointNameEnv NameEnv a
x NameEnv a
y     = NameEnv a -> NameEnv a -> Bool
forall key elt1 elt2. UniqFM key elt1 -> UniqFM key elt2 -> Bool
disjointUFM NameEnv a
x NameEnv a
y
seqEltsNameEnv :: forall elt. (elt -> ()) -> NameEnv elt -> ()
seqEltsNameEnv elt -> ()
seqElt NameEnv elt
x = (elt -> ()) -> NameEnv elt -> ()
forall elt key. (elt -> ()) -> UniqFM key elt -> ()
seqEltsUFM elt -> ()
seqElt NameEnv elt
x

lookupNameEnv_NF :: forall a. NameEnv a -> Name -> a
lookupNameEnv_NF NameEnv a
env Name
n = String -> Maybe a -> a
forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"lookupNameEnv_NF" (NameEnv a -> Name -> Maybe a
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv a
env Name
n)

-- | Deterministic Name Environment
--
-- See Note [Deterministic UniqFM] in "GHC.Types.Unique.DFM" for explanation why
-- we need DNameEnv.
type DNameEnv a = UniqDFM Name a

emptyDNameEnv :: DNameEnv a
emptyDNameEnv :: forall a. DNameEnv a
emptyDNameEnv = UniqDFM Name a
forall key elt. UniqDFM key elt
emptyUDFM

isEmptyDNameEnv :: DNameEnv a -> Bool
isEmptyDNameEnv :: forall a. DNameEnv a -> Bool
isEmptyDNameEnv = UniqDFM Name a -> Bool
forall key elt. UniqDFM key elt -> Bool
isNullUDFM

lookupDNameEnv :: DNameEnv a -> Name -> Maybe a
lookupDNameEnv :: forall a. DNameEnv a -> Name -> Maybe a
lookupDNameEnv = UniqDFM Name a -> Name -> Maybe a
forall key elt.
Uniquable key =>
UniqDFM key elt -> key -> Maybe elt
lookupUDFM

delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a
delFromDNameEnv :: forall a. DNameEnv a -> Name -> DNameEnv a
delFromDNameEnv = UniqDFM Name a -> Name -> UniqDFM Name a
forall key elt.
Uniquable key =>
UniqDFM key elt -> key -> UniqDFM key elt
delFromUDFM

filterDNameEnv :: (a -> Bool) -> DNameEnv a -> DNameEnv a
filterDNameEnv :: forall a. (a -> Bool) -> DNameEnv a -> DNameEnv a
filterDNameEnv = (a -> Bool) -> UniqDFM Name a -> UniqDFM Name a
forall elt key. (elt -> Bool) -> UniqDFM key elt -> UniqDFM key elt
filterUDFM

mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b
mapDNameEnv :: forall a b. (a -> b) -> DNameEnv a -> DNameEnv b
mapDNameEnv = (a -> b) -> UniqDFM Name a -> UniqDFM Name b
forall elt1 elt2 key.
(elt1 -> elt2) -> UniqDFM key elt1 -> UniqDFM key elt2
mapUDFM

adjustDNameEnv :: (a -> a) -> DNameEnv a -> Name -> DNameEnv a
adjustDNameEnv :: forall a. (a -> a) -> DNameEnv a -> Name -> DNameEnv a
adjustDNameEnv = (a -> a) -> UniqDFM Name a -> Name -> UniqDFM Name a
forall key elt.
Uniquable key =>
(elt -> elt) -> UniqDFM key elt -> key -> UniqDFM key elt
adjustUDFM

alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a
alterDNameEnv :: forall a. (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a
alterDNameEnv = (Maybe a -> Maybe a) -> UniqDFM Name a -> Name -> UniqDFM Name a
forall key elt.
Uniquable key =>
(Maybe elt -> Maybe elt)
-> UniqDFM key elt -> key -> UniqDFM key elt
alterUDFM

extendDNameEnv :: DNameEnv a -> Name -> a -> DNameEnv a
extendDNameEnv :: forall a. DNameEnv a -> Name -> a -> DNameEnv a
extendDNameEnv = UniqDFM Name a -> Name -> a -> UniqDFM Name a
forall key elt.
Uniquable key =>
UniqDFM key elt -> key -> elt -> UniqDFM key elt
addToUDFM

extendDNameEnv_C :: (a -> a -> a) -> DNameEnv a -> Name -> a -> DNameEnv a
extendDNameEnv_C :: forall a. (a -> a -> a) -> DNameEnv a -> Name -> a -> DNameEnv a
extendDNameEnv_C = (a -> a -> a) -> UniqDFM Name a -> Name -> a -> UniqDFM Name a
forall key elt.
Uniquable key =>
(elt -> elt -> elt)
-> UniqDFM key elt -> key -> elt -> UniqDFM key elt
addToUDFM_C

eltsDNameEnv :: DNameEnv a -> [a]
eltsDNameEnv :: forall a. DNameEnv a -> [a]
eltsDNameEnv = UniqDFM Name a -> [a]
forall key elt. UniqDFM key elt -> [elt]
eltsUDFM

foldDNameEnv :: (a -> b -> b) -> b -> DNameEnv a -> b
foldDNameEnv :: forall a b. (a -> b -> b) -> b -> DNameEnv a -> b
foldDNameEnv = (a -> b -> b) -> b -> UniqDFM Name a -> b
forall elt a key. (elt -> a -> a) -> a -> UniqDFM key elt -> a
foldUDFM

plusDNameEnv_C :: (elt -> elt -> elt) -> DNameEnv elt -> DNameEnv elt -> DNameEnv elt
plusDNameEnv_C :: forall elt.
(elt -> elt -> elt) -> DNameEnv elt -> DNameEnv elt -> DNameEnv elt
plusDNameEnv_C = (elt -> elt -> elt)
-> UniqDFM Name elt -> UniqDFM Name elt -> UniqDFM Name elt
forall elt key.
(elt -> elt -> elt)
-> UniqDFM key elt -> UniqDFM key elt -> UniqDFM key elt
plusUDFM_C

nonDetStrictFoldDNameEnv :: (a -> b -> b) -> b -> DNameEnv a -> b
nonDetStrictFoldDNameEnv :: forall a b. (a -> b -> b) -> b -> DNameEnv a -> b
nonDetStrictFoldDNameEnv = (a -> b -> b) -> b -> UniqDFM Name a -> b
forall elt a key. (elt -> a -> a) -> a -> UniqDFM key elt -> a
nonDetStrictFoldUDFM