Add uniqSetAny and uniqSetAll and use them
[ghc.git] / compiler / basicTypes / NameSet.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1998
4 -}
5
6 {-# LANGUAGE CPP #-}
7 module NameSet (
8 -- * Names set type
9 NameSet,
10
11 -- ** Manipulating these sets
12 emptyNameSet, unitNameSet, mkNameSet, unionNameSet, unionNameSets,
13 minusNameSet, elemNameSet, nameSetElems, extendNameSet, extendNameSetList,
14 delFromNameSet, delListFromNameSet, isEmptyNameSet, foldNameSet, filterNameSet,
15 intersectsNameSet, intersectNameSet,
16 nameSetAny, nameSetAll,
17
18 -- * Free variables
19 FreeVars,
20
21 -- ** Manipulating sets of free variables
22 isEmptyFVs, emptyFVs, plusFVs, plusFV,
23 mkFVs, addOneFV, unitFV, delFV, delFVs,
24 intersectFVs,
25
26 -- * Defs and uses
27 Defs, Uses, DefUse, DefUses,
28
29 -- ** Manipulating defs and uses
30 emptyDUs, usesOnly, mkDUs, plusDU,
31 findUses, duDefs, duUses, allUses
32 ) where
33
34 #include "HsVersions.h"
35
36 import Name
37 import UniqSet
38
39 {-
40 ************************************************************************
41 * *
42 \subsection[Sets of names}
43 * *
44 ************************************************************************
45 -}
46
47 type NameSet = UniqSet Name
48
49 emptyNameSet :: NameSet
50 unitNameSet :: Name -> NameSet
51 extendNameSetList :: NameSet -> [Name] -> NameSet
52 extendNameSet :: NameSet -> Name -> NameSet
53 mkNameSet :: [Name] -> NameSet
54 unionNameSet :: NameSet -> NameSet -> NameSet
55 unionNameSets :: [NameSet] -> NameSet
56 minusNameSet :: NameSet -> NameSet -> NameSet
57 elemNameSet :: Name -> NameSet -> Bool
58 nameSetElems :: NameSet -> [Name]
59 isEmptyNameSet :: NameSet -> Bool
60 delFromNameSet :: NameSet -> Name -> NameSet
61 delListFromNameSet :: NameSet -> [Name] -> NameSet
62 foldNameSet :: (Name -> b -> b) -> b -> NameSet -> b
63 filterNameSet :: (Name -> Bool) -> NameSet -> NameSet
64 intersectNameSet :: NameSet -> NameSet -> NameSet
65 intersectsNameSet :: NameSet -> NameSet -> Bool
66 -- ^ True if there is a non-empty intersection.
67 -- @s1 `intersectsNameSet` s2@ doesn't compute @s2@ if @s1@ is empty
68
69 isEmptyNameSet = isEmptyUniqSet
70 emptyNameSet = emptyUniqSet
71 unitNameSet = unitUniqSet
72 mkNameSet = mkUniqSet
73 extendNameSetList = addListToUniqSet
74 extendNameSet = addOneToUniqSet
75 unionNameSet = unionUniqSets
76 unionNameSets = unionManyUniqSets
77 minusNameSet = minusUniqSet
78 elemNameSet = elementOfUniqSet
79 nameSetElems = uniqSetToList
80 delFromNameSet = delOneFromUniqSet
81 foldNameSet = foldUniqSet
82 filterNameSet = filterUniqSet
83 intersectNameSet = intersectUniqSets
84
85 delListFromNameSet set ns = foldl delFromNameSet set ns
86
87 intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))
88
89 nameSetAny :: (Name -> Bool) -> NameSet -> Bool
90 nameSetAny = uniqSetAny
91
92 nameSetAll :: (Name -> Bool) -> NameSet -> Bool
93 nameSetAll = uniqSetAll
94
95 {-
96 ************************************************************************
97 * *
98 \subsection{Free variables}
99 * *
100 ************************************************************************
101
102 These synonyms are useful when we are thinking of free variables
103 -}
104
105 type FreeVars = NameSet
106
107 plusFV :: FreeVars -> FreeVars -> FreeVars
108 addOneFV :: FreeVars -> Name -> FreeVars
109 unitFV :: Name -> FreeVars
110 emptyFVs :: FreeVars
111 plusFVs :: [FreeVars] -> FreeVars
112 mkFVs :: [Name] -> FreeVars
113 delFV :: Name -> FreeVars -> FreeVars
114 delFVs :: [Name] -> FreeVars -> FreeVars
115 intersectFVs :: FreeVars -> FreeVars -> FreeVars
116
117 isEmptyFVs :: NameSet -> Bool
118 isEmptyFVs = isEmptyNameSet
119 emptyFVs = emptyNameSet
120 plusFVs = unionNameSets
121 plusFV = unionNameSet
122 mkFVs = mkNameSet
123 addOneFV = extendNameSet
124 unitFV = unitNameSet
125 delFV n s = delFromNameSet s n
126 delFVs ns s = delListFromNameSet s ns
127 intersectFVs = intersectNameSet
128
129 {-
130 ************************************************************************
131 * *
132 Defs and uses
133 * *
134 ************************************************************************
135 -}
136
137 -- | A set of names that are defined somewhere
138 type Defs = NameSet
139
140 -- | A set of names that are used somewhere
141 type Uses = NameSet
142
143 -- | @(Just ds, us) =>@ The use of any member of the @ds@
144 -- implies that all the @us@ are used too.
145 -- Also, @us@ may mention @ds@.
146 --
147 -- @Nothing =>@ Nothing is defined in this group, but
148 -- nevertheless all the uses are essential.
149 -- Used for instance declarations, for example
150 type DefUse = (Maybe Defs, Uses)
151
152 -- | A number of 'DefUse's in dependency order: earlier 'Defs' scope over later 'Uses'
153 -- In a single (def, use) pair, the defs also scope over the uses
154 type DefUses = [DefUse]
155
156 emptyDUs :: DefUses
157 emptyDUs = []
158
159 usesOnly :: Uses -> DefUses
160 usesOnly uses = [(Nothing, uses)]
161
162 mkDUs :: [(Defs,Uses)] -> DefUses
163 mkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]
164
165 plusDU :: DefUses -> DefUses -> DefUses
166 plusDU = (++)
167
168 duDefs :: DefUses -> Defs
169 duDefs dus = foldr get emptyNameSet dus
170 where
171 get (Nothing, _u1) d2 = d2
172 get (Just d1, _u1) d2 = d1 `unionNameSet` d2
173
174 allUses :: DefUses -> Uses
175 -- ^ Just like 'duUses', but 'Defs' are not eliminated from the 'Uses' returned
176 allUses dus = foldr get emptyNameSet dus
177 where
178 get (_d1, u1) u2 = u1 `unionNameSet` u2
179
180 duUses :: DefUses -> Uses
181 -- ^ Collect all 'Uses', regardless of whether the group is itself used,
182 -- but remove 'Defs' on the way
183 duUses dus = foldr get emptyNameSet dus
184 where
185 get (Nothing, rhs_uses) uses = rhs_uses `unionNameSet` uses
186 get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSet` uses)
187 `minusNameSet` defs
188
189 findUses :: DefUses -> Uses -> Uses
190 -- ^ Given some 'DefUses' and some 'Uses', find all the uses, transitively.
191 -- The result is a superset of the input 'Uses'; and includes things defined
192 -- in the input 'DefUses' (but only if they are used)
193 findUses dus uses
194 = foldr get uses dus
195 where
196 get (Nothing, rhs_uses) uses
197 = rhs_uses `unionNameSet` uses
198 get (Just defs, rhs_uses) uses
199 | defs `intersectsNameSet` uses -- Used
200 || any (startsWithUnderscore . nameOccName) (nameSetElems defs)
201 -- At least one starts with an "_",
202 -- so treat the group as used
203 = rhs_uses `unionNameSet` uses
204 | otherwise -- No def is used
205 = uses