Replace Digraph's Node type synonym with a data type
[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,
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 DNameEnv,
25
26 emptyDNameEnv,
27 lookupDNameEnv,
28 mapDNameEnv,
29 alterDNameEnv,
30 -- ** Dependency analysis
31 depAnal
32 ) where
33
34 #include "HsVersions.h"
35
36 import Digraph
37 import Name
38 import UniqFM
39 import UniqDFM
40 import Maybes
41
42 {-
43 ************************************************************************
44 * *
45 \subsection{Name environment}
46 * *
47 ************************************************************************
48 -}
49
50 {-
51 Note [depAnal determinism]
52 ~~~~~~~~~~~~~~~~~~~~~~~~~~
53 depAnal is deterministic provided it gets the nodes in a deterministic order.
54 The order of lists that get_defs and get_uses return doesn't matter, as these
55 are only used to construct the edges, and stronglyConnCompFromEdgedVertices is
56 deterministic even when the edges are not in deterministic order as explained
57 in Note [Deterministic SCC] in Digraph.
58 -}
59
60 depAnal :: (node -> [Name]) -- Defs
61 -> (node -> [Name]) -- Uses
62 -> [node]
63 -> [SCC node]
64 -- Perform dependency analysis on a group of definitions,
65 -- where each definition may define more than one Name
66 --
67 -- The get_defs and get_uses functions are called only once per node
68 depAnal get_defs get_uses nodes
69 = stronglyConnCompFromEdgedVerticesUniq (map mk_node keyed_nodes)
70 where
71 keyed_nodes = nodes `zip` [(1::Int)..]
72 mk_node (node, key) =
73 DigraphNode node key (mapMaybe (lookupNameEnv key_map) (get_uses node))
74
75 key_map :: NameEnv Int -- Maps a Name to the key of the decl that defines it
76 key_map = mkNameEnv [(name,key) | (node, key) <- keyed_nodes, name <- get_defs node]
77
78 {-
79 ************************************************************************
80 * *
81 \subsection{Name environment}
82 * *
83 ************************************************************************
84 -}
85
86 -- | Name Environment
87 type NameEnv a = UniqFM a -- Domain is Name
88
89 emptyNameEnv :: NameEnv a
90 isEmptyNameEnv :: NameEnv a -> Bool
91 mkNameEnv :: [(Name,a)] -> NameEnv a
92 nameEnvElts :: NameEnv a -> [a]
93 alterNameEnv :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a
94 extendNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
95 extendNameEnv_Acc :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b
96 extendNameEnv :: NameEnv a -> Name -> a -> NameEnv a
97 plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a
98 plusNameEnv_C :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
99 extendNameEnvList :: NameEnv a -> [(Name,a)] -> NameEnv a
100 extendNameEnvList_C :: (a->a->a) -> NameEnv a -> [(Name,a)] -> NameEnv a
101 delFromNameEnv :: NameEnv a -> Name -> NameEnv a
102 delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a
103 elemNameEnv :: Name -> NameEnv a -> Bool
104 unitNameEnv :: Name -> a -> NameEnv a
105 lookupNameEnv :: NameEnv a -> Name -> Maybe a
106 lookupNameEnv_NF :: NameEnv a -> Name -> a
107 filterNameEnv :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
108 anyNameEnv :: (elt -> Bool) -> NameEnv elt -> Bool
109 mapNameEnv :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
110 disjointNameEnv :: NameEnv a -> NameEnv a -> Bool
111
112 nameEnvElts x = eltsUFM x
113 emptyNameEnv = emptyUFM
114 isEmptyNameEnv = isNullUFM
115 unitNameEnv x y = unitUFM x y
116 extendNameEnv x y z = addToUFM x y z
117 extendNameEnvList x l = addListToUFM x l
118 lookupNameEnv x y = lookupUFM x y
119 alterNameEnv = alterUFM
120 mkNameEnv l = listToUFM l
121 elemNameEnv x y = elemUFM x y
122 plusNameEnv x y = plusUFM x y
123 plusNameEnv_C f x y = plusUFM_C f x y
124 extendNameEnv_C f x y z = addToUFM_C f x y z
125 mapNameEnv f x = mapUFM f x
126 extendNameEnv_Acc x y z a b = addToUFM_Acc x y z a b
127 extendNameEnvList_C x y z = addListToUFM_C x y z
128 delFromNameEnv x y = delFromUFM x y
129 delListFromNameEnv x y = delListFromUFM x y
130 filterNameEnv x y = filterUFM x y
131 anyNameEnv f x = foldUFM ((||) . f) False x
132 disjointNameEnv x y = isNullUFM (intersectUFM x y)
133
134 lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n)
135
136 -- | Deterministic Name Environment
137 --
138 -- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need
139 -- DNameEnv.
140 type DNameEnv a = UniqDFM a
141
142 emptyDNameEnv :: DNameEnv a
143 emptyDNameEnv = emptyUDFM
144
145 lookupDNameEnv :: DNameEnv a -> Name -> Maybe a
146 lookupDNameEnv = lookupUDFM
147
148 mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b
149 mapDNameEnv = mapUDFM
150
151 alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a
152 alterDNameEnv = alterUDFM