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

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

{-# LANGUAGE CPP #-}
module NameEnv (
        -- * Var, Id and TyVar environments (maps)
        NameEnv,

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

        DNameEnv,

        emptyDNameEnv,
        lookupDNameEnv,
        mapDNameEnv,
        alterDNameEnv,
        -- ** Dependency analysis
        depAnal
    ) where

#include "HsVersions.h"

import GhcPrelude

import Digraph
import Name
import UniqFM
import UniqDFM
import Maybes

{-
************************************************************************
*                                                                      *
\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 Digraph.
-}

depAnal :: (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 :: (node -> [Name]) -> (node -> [Name]) -> [node] -> [SCC node]
depAnal get_defs :: node -> [Name]
get_defs get_uses :: node -> [Name]
get_uses nodes :: [node]
nodes
  = [Node Int node] -> [SCC node]
forall key payload.
Uniquable key =>
[Node key payload] -> [SCC payload]
stronglyConnCompFromEdgedVerticesUniq (((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)
  where
    keyed_nodes :: [(node, Int)]
keyed_nodes = [node]
nodes [node] -> [Int] -> [(node, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [(1::Int)..]
    mk_node :: (node, Int) -> Node Int node
mk_node (node :: node
node, key :: Int
key) =
      node -> Int -> [Int] -> Node Int node
forall key payload. payload -> key -> [key] -> Node key payload
DigraphNode node
node Int
key ((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))

    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
node, key :: Int
key) <- [(node, Int)]
keyed_nodes, Name
name <- node -> [Name]
get_defs node
node]

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

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

emptyNameEnv       :: NameEnv a
isEmptyNameEnv     :: NameEnv a -> Bool
mkNameEnv          :: [(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
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 :: NameEnv a -> [a]
nameEnvElts x :: NameEnv a
x         = NameEnv a -> [a]
forall elt. UniqFM elt -> [elt]
eltsUFM NameEnv a
x
emptyNameEnv :: NameEnv a
emptyNameEnv          = NameEnv a
forall elt. UniqFM elt
emptyUFM
isEmptyNameEnv :: NameEnv a -> Bool
isEmptyNameEnv        = NameEnv a -> Bool
forall elt. UniqFM elt -> Bool
isNullUFM
unitNameEnv :: Name -> a -> NameEnv a
unitNameEnv x :: Name
x y :: a
y       = Name -> a -> NameEnv a
forall key elt. Uniquable key => key -> elt -> UniqFM elt
unitUFM Name
x a
y
extendNameEnv :: NameEnv a -> Name -> a -> NameEnv a
extendNameEnv x :: NameEnv a
x y :: Name
y z :: a
z   = NameEnv a -> Name -> a -> NameEnv a
forall key elt.
Uniquable key =>
UniqFM elt -> key -> elt -> UniqFM elt
addToUFM NameEnv a
x Name
y a
z
extendNameEnvList :: NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList x :: NameEnv a
x l :: [(Name, a)]
l = NameEnv a -> [(Name, a)] -> NameEnv a
forall key elt.
Uniquable key =>
UniqFM elt -> [(key, elt)] -> UniqFM elt
addListToUFM NameEnv a
x [(Name, a)]
l
lookupNameEnv :: NameEnv a -> Name -> Maybe a
lookupNameEnv x :: NameEnv a
x y :: Name
y     = NameEnv a -> Name -> Maybe a
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM NameEnv a
x Name
y
alterNameEnv :: (Maybe a -> Maybe a) -> NameEnv a -> Name -> NameEnv a
alterNameEnv          = (Maybe a -> Maybe a) -> NameEnv a -> Name -> NameEnv a
forall key elt.
Uniquable key =>
(Maybe elt -> Maybe elt) -> UniqFM elt -> key -> UniqFM elt
alterUFM
mkNameEnv :: [(Name, a)] -> NameEnv a
mkNameEnv     l :: [(Name, a)]
l       = [(Name, a)] -> NameEnv a
forall key elt. Uniquable key => [(key, elt)] -> UniqFM elt
listToUFM [(Name, a)]
l
elemNameEnv :: Name -> NameEnv a -> Bool
elemNameEnv x :: Name
x y :: NameEnv a
y          = Name -> NameEnv a -> Bool
forall key elt. Uniquable key => key -> UniqFM elt -> Bool
elemUFM Name
x NameEnv a
y
plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv x :: NameEnv a
x y :: NameEnv a
y          = NameEnv a -> NameEnv a -> NameEnv a
forall elt. UniqFM elt -> UniqFM elt -> UniqFM elt
plusUFM NameEnv a
x NameEnv a
y
plusNameEnv_C :: (a -> a -> a) -> NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv_C f :: a -> a -> a
f x :: NameEnv a
x y :: NameEnv a
y      = (a -> a -> a) -> NameEnv a -> NameEnv a -> NameEnv a
forall elt.
(elt -> elt -> elt) -> UniqFM elt -> UniqFM elt -> UniqFM elt
plusUFM_C a -> a -> a
f NameEnv a
x NameEnv a
y
extendNameEnv_C :: (a -> a -> a) -> NameEnv a -> Name -> a -> NameEnv a
extendNameEnv_C f :: a -> a -> a
f x :: NameEnv a
x y :: Name
y z :: a
z  = (a -> a -> a) -> NameEnv a -> Name -> a -> NameEnv a
forall key elt.
Uniquable key =>
(elt -> elt -> elt) -> UniqFM elt -> key -> elt -> UniqFM elt
addToUFM_C a -> a -> a
f NameEnv a
x Name
y a
z
mapNameEnv :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
mapNameEnv f :: elt1 -> elt2
f x :: NameEnv elt1
x           = (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
forall elt1 elt2. (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
mapUFM elt1 -> elt2
f NameEnv elt1
x
extendNameEnv_Acc :: (a -> b -> b) -> (a -> b) -> NameEnv b -> Name -> a -> NameEnv b
extendNameEnv_Acc x :: a -> b -> b
x y :: a -> b
y z :: NameEnv b
z a :: Name
a b :: 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 elts -> key -> elt -> UniqFM elts
addToUFM_Acc a -> b -> b
x a -> b
y NameEnv b
z Name
a a
b
extendNameEnvList_C :: (a -> a -> a) -> NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList_C x :: a -> a -> a
x y :: NameEnv a
y z :: [(Name, a)]
z = (a -> a -> a) -> NameEnv a -> [(Name, a)] -> NameEnv a
forall key elt.
Uniquable key =>
(elt -> elt -> elt) -> UniqFM elt -> [(key, elt)] -> UniqFM elt
addListToUFM_C a -> a -> a
x NameEnv a
y [(Name, a)]
z
delFromNameEnv :: NameEnv a -> Name -> NameEnv a
delFromNameEnv x :: NameEnv a
x y :: Name
y      = NameEnv a -> Name -> NameEnv a
forall key elt. Uniquable key => UniqFM elt -> key -> UniqFM elt
delFromUFM NameEnv a
x Name
y
delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a
delListFromNameEnv x :: NameEnv a
x y :: [Name]
y  = NameEnv a -> [Name] -> NameEnv a
forall key elt. Uniquable key => UniqFM elt -> [key] -> UniqFM elt
delListFromUFM NameEnv a
x [Name]
y
filterNameEnv :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
filterNameEnv x :: elt -> Bool
x y :: NameEnv elt
y       = (elt -> Bool) -> NameEnv elt -> NameEnv elt
forall elt. (elt -> Bool) -> UniqFM elt -> UniqFM elt
filterUFM elt -> Bool
x NameEnv elt
y
anyNameEnv :: (elt -> Bool) -> NameEnv elt -> Bool
anyNameEnv f :: elt -> Bool
f x :: NameEnv elt
x          = (elt -> Bool -> Bool) -> Bool -> NameEnv elt -> Bool
forall elt a. (elt -> a -> a) -> a -> UniqFM 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 :: NameEnv a -> NameEnv a -> Bool
disjointNameEnv x :: NameEnv a
x y :: NameEnv a
y     = NameEnv a -> Bool
forall elt. UniqFM elt -> Bool
isNullUFM (NameEnv a -> NameEnv a -> NameEnv a
forall elt1 elt2. UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
intersectUFM NameEnv a
x NameEnv a
y)

lookupNameEnv_NF :: NameEnv a -> Name -> a
lookupNameEnv_NF env :: NameEnv a
env n :: Name
n = String -> Maybe a -> a
forall a. HasCallStack => String -> Maybe a -> a
expectJust "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 UniqDFM for explanation why we need
-- DNameEnv.
type DNameEnv a = UniqDFM a

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

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

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

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