Kill non-deterministic foldUFM in TrieMap and TcAppMap
[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 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 Unique
39 import UniqFM
40 import UniqDFM
41 import Maybes
42
43 {-
44 ************************************************************************
45 * *
46 \subsection{Name environment}
47 * *
48 ************************************************************************
49 -}
50
51 depAnal :: (node -> [Name]) -- Defs
52 -> (node -> [Name]) -- Uses
53 -> [node]
54 -> [SCC node]
55 -- Peform dependency analysis on a group of definitions,
56 -- where each definition may define more than one Name
57 --
58 -- The get_defs and get_uses functions are called only once per node
59 depAnal get_defs get_uses nodes
60 = stronglyConnCompFromEdgedVertices (map mk_node keyed_nodes)
61 where
62 keyed_nodes = nodes `zip` [(1::Int)..]
63 mk_node (node, key) = (node, key, mapMaybe (lookupNameEnv key_map) (get_uses node))
64
65 key_map :: NameEnv Int -- Maps a Name to the key of the decl that defines it
66 key_map = mkNameEnv [(name,key) | (node, key) <- keyed_nodes, name <- get_defs node]
67
68 {-
69 ************************************************************************
70 * *
71 \subsection{Name environment}
72 * *
73 ************************************************************************
74 -}
75
76 type NameEnv a = UniqFM a -- Domain is Name
77
78 emptyNameEnv :: NameEnv a
79 isEmptyNameEnv :: NameEnv a -> Bool
80 mkNameEnv :: [(Name,a)] -> NameEnv a
81 nameEnvElts :: NameEnv a -> [a]
82 nameEnvUniqueElts :: NameEnv a -> [(Unique, a)]
83 alterNameEnv :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a
84 extendNameEnv_C :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
85 extendNameEnv_Acc :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b
86 extendNameEnv :: NameEnv a -> Name -> a -> NameEnv a
87 plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a
88 plusNameEnv_C :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
89 extendNameEnvList :: NameEnv a -> [(Name,a)] -> NameEnv a
90 extendNameEnvList_C :: (a->a->a) -> NameEnv a -> [(Name,a)] -> NameEnv a
91 delFromNameEnv :: NameEnv a -> Name -> NameEnv a
92 delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a
93 elemNameEnv :: Name -> NameEnv a -> Bool
94 unitNameEnv :: Name -> a -> NameEnv a
95 lookupNameEnv :: NameEnv a -> Name -> Maybe a
96 lookupNameEnv_NF :: NameEnv a -> Name -> a
97 filterNameEnv :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
98 anyNameEnv :: (elt -> Bool) -> NameEnv elt -> Bool
99 mapNameEnv :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
100 disjointNameEnv :: NameEnv a -> NameEnv a -> Bool
101
102 nameEnvElts x = eltsUFM x
103 emptyNameEnv = emptyUFM
104 isEmptyNameEnv = isNullUFM
105 unitNameEnv x y = unitUFM x y
106 extendNameEnv x y z = addToUFM x y z
107 extendNameEnvList x l = addListToUFM x l
108 lookupNameEnv x y = lookupUFM x y
109 alterNameEnv = alterUFM
110 mkNameEnv l = listToUFM l
111 elemNameEnv x y = elemUFM x y
112 plusNameEnv x y = plusUFM x y
113 plusNameEnv_C f x y = plusUFM_C f x y
114 extendNameEnv_C f x y z = addToUFM_C f x y z
115 mapNameEnv f x = mapUFM f x
116 nameEnvUniqueElts x = ufmToList x
117 extendNameEnv_Acc x y z a b = addToUFM_Acc x y z a b
118 extendNameEnvList_C x y z = addListToUFM_C x y z
119 delFromNameEnv x y = delFromUFM x y
120 delListFromNameEnv x y = delListFromUFM x y
121 filterNameEnv x y = filterUFM x y
122 anyNameEnv f x = foldUFM ((||) . f) False x
123 disjointNameEnv x y = isNullUFM (intersectUFM x y)
124
125 lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n)
126
127 -- Deterministic NameEnv
128 -- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need
129 -- DNameEnv.
130 type DNameEnv a = UniqDFM a
131
132 emptyDNameEnv :: DNameEnv a
133 emptyDNameEnv = emptyUDFM
134
135 lookupDNameEnv :: DNameEnv a -> Name -> Maybe a
136 lookupDNameEnv = lookupUDFM
137
138 mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b
139 mapDNameEnv = mapUDFM
140
141 alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a
142 alterDNameEnv = alterUDFM