d9ad35945b8a131837472d46013d2c8ab0d8c459
[ghc.git] / compiler / basicTypes / NameEnv.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5 \section[NameEnv]{@NameEnv@: name environments}
6 -}
7
8 {-# LANGUAGE CPP #-}
9 module NameEnv (
10 -- * Var, Id and TyVar environments (maps)
11 NameEnv,
12
13 -- ** Manipulating these environments
14 mkNameEnv,
15 emptyNameEnv, isEmptyNameEnv,
16 unitNameEnv, nameEnvElts, nameEnvUniqueElts,
17 extendNameEnv_C, extendNameEnv_Acc, extendNameEnv,
18 extendNameEnvList, extendNameEnvList_C,
19 filterNameEnv, anyNameEnv,
20 plusNameEnv, plusNameEnv_C, alterNameEnv,
21 lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,
22 elemNameEnv, mapNameEnv, disjointNameEnv,
23
24 -- ** Dependency analysis
25 depAnal
26 ) where
27
28 #include "HsVersions.h"
29
30 import Digraph
31 import Name
32 import Unique
33 import UniqFM
34 import Maybes
35
36 {-
37 ************************************************************************
38 * *
39 \subsection{Name environment}
40 * *
41 ************************************************************************
42 -}
43
44 depAnal :: (node -> [Name]) -- Defs
45 -> (node -> [Name]) -- Uses
46 -> [node]
47 -> [SCC node]
48 -- Peform dependency analysis on a group of definitions,
49 -- where each definition may define more than one Name
50 --
51 -- The get_defs and get_uses functions are called only once per node
52 depAnal get_defs get_uses nodes
53 = stronglyConnCompFromEdgedVertices (map mk_node keyed_nodes)
54 where
55 keyed_nodes = nodes `zip` [(1::Int)..]
56 mk_node (node, key) = (node, key, mapMaybe (lookupNameEnv key_map) (get_uses node))
57
58 key_map :: NameEnv Int -- Maps a Name to the key of the decl that defines it
59 key_map = mkNameEnv [(name,key) | (node, key) <- keyed_nodes, name <- get_defs node]
60
61 {-
62 ************************************************************************
63 * *
64 \subsection{Name environment}
65 * *
66 ************************************************************************
67 -}
68
69 type NameEnv a = UniqFM a -- Domain is Name
70
71 emptyNameEnv :: NameEnv a
72 isEmptyNameEnv :: NameEnv a -> Bool
73 mkNameEnv :: [(Name,a)] -> NameEnv a
74 nameEnvElts :: NameEnv a -> [a]
75 nameEnvUniqueElts :: NameEnv a -> [(Unique, a)]
76 alterNameEnv :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a
77 extendNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
78 extendNameEnv_Acc :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b
79 extendNameEnv :: NameEnv a -> Name -> a -> NameEnv a
80 plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a
81 plusNameEnv_C :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
82 extendNameEnvList :: NameEnv a -> [(Name,a)] -> NameEnv a
83 extendNameEnvList_C :: (a->a->a) -> NameEnv a -> [(Name,a)] -> NameEnv a
84 delFromNameEnv :: NameEnv a -> Name -> NameEnv a
85 delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a
86 elemNameEnv :: Name -> NameEnv a -> Bool
87 unitNameEnv :: Name -> a -> NameEnv a
88 lookupNameEnv :: NameEnv a -> Name -> Maybe a
89 lookupNameEnv_NF :: NameEnv a -> Name -> a
90 filterNameEnv :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
91 anyNameEnv :: (elt -> Bool) -> NameEnv elt -> Bool
92 mapNameEnv :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
93 disjointNameEnv :: NameEnv a -> NameEnv a -> Bool
94
95 nameEnvElts x = eltsUFM x
96 emptyNameEnv = emptyUFM
97 isEmptyNameEnv = isNullUFM
98 unitNameEnv x y = unitUFM x y
99 extendNameEnv x y z = addToUFM x y z
100 extendNameEnvList x l = addListToUFM x l
101 lookupNameEnv x y = lookupUFM x y
102 alterNameEnv = alterUFM
103 mkNameEnv l = listToUFM l
104 elemNameEnv x y = elemUFM x y
105 plusNameEnv x y = plusUFM x y
106 plusNameEnv_C f x y = plusUFM_C f x y
107 extendNameEnv_C f x y z = addToUFM_C f x y z
108 mapNameEnv f x = mapUFM f x
109 nameEnvUniqueElts x = ufmToList x
110 extendNameEnv_Acc x y z a b = addToUFM_Acc x y z a b
111 extendNameEnvList_C x y z = addListToUFM_C x y z
112 delFromNameEnv x y = delFromUFM x y
113 delListFromNameEnv x y = delListFromUFM x y
114 filterNameEnv x y = filterUFM x y
115 anyNameEnv f x = foldUFM ((||) . f) False x
116 disjointNameEnv x y = isNullUFM (intersectUFM x y)
117
118 lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n)