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

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

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

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

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

        DNameEnv,

        emptyDNameEnv,
        lookupDNameEnv,
        delFromDNameEnv, filterDNameEnv,
        mapDNameEnv,
        adjustDNameEnv, alterDNameEnv, extendDNameEnv,
        -- ** Dependency analysis
        depAnal
    ) where

#include "HsVersions.h"

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
  = forall key payload.
Uniquable key =>
[Node key payload] -> [SCC payload]
stronglyConnCompFromEdgedVerticesUniq [Node Int node]
graph_nodes
  where
    graph_nodes :: [Node Int node]
graph_nodes = (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 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 = (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv Int
key_map) (node -> [Name]
get_uses node
node))
      in 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 = 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
nameEnvElts        :: 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
anyNameEnv         :: (elt -> Bool) -> NameEnv elt -> Bool
mapNameEnv         :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
disjointNameEnv    :: NameEnv a -> NameEnv a -> Bool

nameEnvElts :: forall a. NameEnv a -> [a]
nameEnvElts NameEnv a
x         = forall key elt. UniqFM key elt -> [elt]
eltsUFM NameEnv a
x
emptyNameEnv :: forall a. NameEnv a
emptyNameEnv          = forall key elt. UniqFM key elt
emptyUFM
isEmptyNameEnv :: forall a. NameEnv a -> Bool
isEmptyNameEnv        = forall key elt. UniqFM key elt -> Bool
isNullUFM
unitNameEnv :: forall a. Name -> a -> NameEnv a
unitNameEnv Name
x a
y       = 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   = 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 = 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     = 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          = 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       = 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       = forall a. [(Name, a)] -> NameEnv a
mkNameEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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          = 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          = 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      = 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 = 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    = 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  = 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           = 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  = 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 = 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      = 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  = 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       = forall elt key. (elt -> Bool) -> UniqFM key elt -> UniqFM key elt
filterUFM elt -> Bool
x NameEnv elt
y
anyNameEnv :: forall elt. (elt -> Bool) -> NameEnv elt -> Bool
anyNameEnv elt -> Bool
f NameEnv elt
x          = forall elt a key. (elt -> a -> a) -> a -> UniqFM key elt -> a
foldUFM (Bool -> 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     = forall key elt1 elt2. UniqFM key elt1 -> UniqFM key elt2 -> Bool
disjointUFM NameEnv a
x NameEnv a
y

lookupNameEnv_NF :: forall a. NameEnv a -> Name -> a
lookupNameEnv_NF NameEnv a
env Name
n = forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"lookupNameEnv_NF" (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 = forall key elt. UniqDFM key elt
emptyUDFM

lookupDNameEnv :: DNameEnv a -> Name -> Maybe a
lookupDNameEnv :: forall a. DNameEnv a -> Name -> Maybe a
lookupDNameEnv = 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 = 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 = 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 = 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 = 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 = 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 = forall key elt.
Uniquable key =>
UniqDFM key elt -> key -> elt -> UniqDFM key elt
addToUDFM