never executed always true always false
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
9 {-# LANGUAGE BangPatterns #-}
10 {-# LANGUAGE ScopedTypeVariables #-}
11
12 module GHC.Types.Name.Env (
13 -- * Var, Id and TyVar environments (maps)
14 NameEnv,
15
16 -- ** Manipulating these environments
17 mkNameEnv, mkNameEnvWith,
18 emptyNameEnv, isEmptyNameEnv,
19 unitNameEnv, nonDetNameEnvElts,
20 extendNameEnv_C, extendNameEnv_Acc, extendNameEnv,
21 extendNameEnvList, extendNameEnvList_C,
22 filterNameEnv, anyNameEnv,
23 plusNameEnv, plusNameEnv_C, plusNameEnv_CD, plusNameEnv_CD2, alterNameEnv,
24 lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,
25 elemNameEnv, mapNameEnv, disjointNameEnv,
26 seqEltsNameEnv,
27
28 DNameEnv,
29
30 emptyDNameEnv,
31 lookupDNameEnv,
32 delFromDNameEnv, filterDNameEnv,
33 mapDNameEnv,
34 adjustDNameEnv, alterDNameEnv, extendDNameEnv,
35 eltsDNameEnv, extendDNameEnv_C,
36 -- ** Dependency analysis
37 depAnal
38 ) where
39
40 import GHC.Prelude
41
42 import GHC.Data.Graph.Directed
43 import GHC.Types.Name
44 import GHC.Types.Unique.FM
45 import GHC.Types.Unique.DFM
46 import GHC.Data.Maybe
47
48 {-
49 ************************************************************************
50 * *
51 \subsection{Name environment}
52 * *
53 ************************************************************************
54 -}
55
56 {-
57 Note [depAnal determinism]
58 ~~~~~~~~~~~~~~~~~~~~~~~~~~
59 depAnal is deterministic provided it gets the nodes in a deterministic order.
60 The order of lists that get_defs and get_uses return doesn't matter, as these
61 are only used to construct the edges, and stronglyConnCompFromEdgedVertices is
62 deterministic even when the edges are not in deterministic order as explained
63 in Note [Deterministic SCC] in GHC.Data.Graph.Directed.
64 -}
65
66 depAnal :: forall node.
67 (node -> [Name]) -- Defs
68 -> (node -> [Name]) -- Uses
69 -> [node]
70 -> [SCC node]
71 -- Perform dependency analysis on a group of definitions,
72 -- where each definition may define more than one Name
73 --
74 -- The get_defs and get_uses functions are called only once per node
75 depAnal get_defs get_uses nodes
76 = stronglyConnCompFromEdgedVerticesUniq graph_nodes
77 where
78 graph_nodes = (map mk_node keyed_nodes) :: [Node Int node]
79 keyed_nodes = nodes `zip` [(1::Int)..]
80 mk_node (node, key) =
81 let !edges = (mapMaybe (lookupNameEnv key_map) (get_uses node))
82 in DigraphNode node key edges
83
84 key_map :: NameEnv Int -- Maps a Name to the key of the decl that defines it
85 key_map = mkNameEnv [(name,key) | (node, key) <- keyed_nodes, name <- get_defs node]
86
87 {-
88 ************************************************************************
89 * *
90 \subsection{Name environment}
91 * *
92 ************************************************************************
93 -}
94
95 -- | Name Environment
96 type NameEnv a = UniqFM Name a -- Domain is Name
97
98 emptyNameEnv :: NameEnv a
99 isEmptyNameEnv :: NameEnv a -> Bool
100 mkNameEnv :: [(Name,a)] -> NameEnv a
101 mkNameEnvWith :: (a -> Name) -> [a] -> NameEnv a
102 nonDetNameEnvElts :: NameEnv a -> [a]
103 alterNameEnv :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a
104 extendNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
105 extendNameEnv_Acc :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b
106 extendNameEnv :: NameEnv a -> Name -> a -> NameEnv a
107 plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a
108 plusNameEnv_C :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
109 plusNameEnv_CD :: (a->a->a) -> NameEnv a -> a -> NameEnv a -> a -> NameEnv a
110 plusNameEnv_CD2 :: (Maybe a->Maybe a->a) -> NameEnv a -> NameEnv a -> NameEnv a
111 extendNameEnvList :: NameEnv a -> [(Name,a)] -> NameEnv a
112 extendNameEnvList_C :: (a->a->a) -> NameEnv a -> [(Name,a)] -> NameEnv a
113 delFromNameEnv :: NameEnv a -> Name -> NameEnv a
114 delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a
115 elemNameEnv :: Name -> NameEnv a -> Bool
116 unitNameEnv :: Name -> a -> NameEnv a
117 lookupNameEnv :: NameEnv a -> Name -> Maybe a
118 lookupNameEnv_NF :: NameEnv a -> Name -> a
119 filterNameEnv :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
120 anyNameEnv :: (elt -> Bool) -> NameEnv elt -> Bool
121 mapNameEnv :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
122 disjointNameEnv :: NameEnv a -> NameEnv a -> Bool
123 seqEltsNameEnv :: (elt -> ()) -> NameEnv elt -> ()
124
125 nonDetNameEnvElts x = nonDetEltsUFM x
126 emptyNameEnv = emptyUFM
127 isEmptyNameEnv = isNullUFM
128 unitNameEnv x y = unitUFM x y
129 extendNameEnv x y z = addToUFM x y z
130 extendNameEnvList x l = addListToUFM x l
131 lookupNameEnv x y = lookupUFM x y
132 alterNameEnv = alterUFM
133 mkNameEnv l = listToUFM l
134 mkNameEnvWith f = mkNameEnv . map (\a -> (f a, a))
135 elemNameEnv x y = elemUFM x y
136 plusNameEnv x y = plusUFM x y
137 plusNameEnv_C f x y = plusUFM_C f x y
138 {-# INLINE plusNameEnv_CD #-}
139 plusNameEnv_CD f x d y b = plusUFM_CD f x d y b
140 plusNameEnv_CD2 f x y = plusUFM_CD2 f x y
141 extendNameEnv_C f x y z = addToUFM_C f x y z
142 mapNameEnv f x = mapUFM f x
143 extendNameEnv_Acc x y z a b = addToUFM_Acc x y z a b
144 extendNameEnvList_C x y z = addListToUFM_C x y z
145 delFromNameEnv x y = delFromUFM x y
146 delListFromNameEnv x y = delListFromUFM x y
147 filterNameEnv x y = filterUFM x y
148 anyNameEnv f x = foldUFM ((||) . f) False x
149 disjointNameEnv x y = disjointUFM x y
150 seqEltsNameEnv seqElt x = seqEltsUFM seqElt x
151
152 lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n)
153
154 -- | Deterministic Name Environment
155 --
156 -- See Note [Deterministic UniqFM] in "GHC.Types.Unique.DFM" for explanation why
157 -- we need DNameEnv.
158 type DNameEnv a = UniqDFM Name a
159
160 emptyDNameEnv :: DNameEnv a
161 emptyDNameEnv = emptyUDFM
162
163 lookupDNameEnv :: DNameEnv a -> Name -> Maybe a
164 lookupDNameEnv = lookupUDFM
165
166 delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a
167 delFromDNameEnv = delFromUDFM
168
169 filterDNameEnv :: (a -> Bool) -> DNameEnv a -> DNameEnv a
170 filterDNameEnv = filterUDFM
171
172 mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b
173 mapDNameEnv = mapUDFM
174
175 adjustDNameEnv :: (a -> a) -> DNameEnv a -> Name -> DNameEnv a
176 adjustDNameEnv = adjustUDFM
177
178 alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a
179 alterDNameEnv = alterUDFM
180
181 extendDNameEnv :: DNameEnv a -> Name -> a -> DNameEnv a
182 extendDNameEnv = addToUDFM
183
184 extendDNameEnv_C :: (a -> a -> a) -> DNameEnv a -> Name -> a -> DNameEnv a
185 extendDNameEnv_C = addToUDFM_C
186
187 eltsDNameEnv :: DNameEnv a -> [a]
188 eltsDNameEnv = eltsUDFM