Spelling fixes in comments [ci skip]
[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, extendNameSet, extendNameSetList,
14 delFromNameSet, delListFromNameSet, isEmptyNameSet, filterNameSet,
15 intersectsNameSet, intersectNameSet,
16 nameSetAny, nameSetAll, nameSetElemsStable,
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 import UniqFM
39 import Data.List (sortBy)
40
41 {-
42 ************************************************************************
43 * *
44 \subsection[Sets of names}
45 * *
46 ************************************************************************
47 -}
48
49 type NameSet = UniqSet Name
50
51 emptyNameSet :: NameSet
52 unitNameSet :: Name -> NameSet
53 extendNameSetList :: NameSet -> [Name] -> NameSet
54 extendNameSet :: NameSet -> Name -> NameSet
55 mkNameSet :: [Name] -> NameSet
56 unionNameSet :: NameSet -> NameSet -> NameSet
57 unionNameSets :: [NameSet] -> NameSet
58 minusNameSet :: NameSet -> NameSet -> NameSet
59 elemNameSet :: Name -> NameSet -> Bool
60 isEmptyNameSet :: NameSet -> Bool
61 delFromNameSet :: NameSet -> Name -> NameSet
62 delListFromNameSet :: NameSet -> [Name] -> NameSet
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 delFromNameSet = delOneFromUniqSet
80 filterNameSet = filterUniqSet
81 intersectNameSet = intersectUniqSets
82
83 delListFromNameSet set ns = foldl delFromNameSet set ns
84
85 intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))
86
87 nameSetAny :: (Name -> Bool) -> NameSet -> Bool
88 nameSetAny = uniqSetAny
89
90 nameSetAll :: (Name -> Bool) -> NameSet -> Bool
91 nameSetAll = uniqSetAll
92
93 -- | Get the elements of a NameSet with some stable ordering.
94 -- This only works for Names that originate in the source code or have been
95 -- tidied.
96 -- See Note [Deterministic UniqFM] to learn about nondeterminism
97 nameSetElemsStable :: NameSet -> [Name]
98 nameSetElemsStable ns =
99 sortBy stableNameCmp $ nonDetEltsUFM ns
100 -- It's OK to use nonDetEltsUFM here because we immediately sort
101 -- with stableNameCmp
102
103 {-
104 ************************************************************************
105 * *
106 \subsection{Free variables}
107 * *
108 ************************************************************************
109
110 These synonyms are useful when we are thinking of free variables
111 -}
112
113 type FreeVars = NameSet
114
115 plusFV :: FreeVars -> FreeVars -> FreeVars
116 addOneFV :: FreeVars -> Name -> FreeVars
117 unitFV :: Name -> FreeVars
118 emptyFVs :: FreeVars
119 plusFVs :: [FreeVars] -> FreeVars
120 mkFVs :: [Name] -> FreeVars
121 delFV :: Name -> FreeVars -> FreeVars
122 delFVs :: [Name] -> FreeVars -> FreeVars
123 intersectFVs :: FreeVars -> FreeVars -> FreeVars
124
125 isEmptyFVs :: NameSet -> Bool
126 isEmptyFVs = isEmptyNameSet
127 emptyFVs = emptyNameSet
128 plusFVs = unionNameSets
129 plusFV = unionNameSet
130 mkFVs = mkNameSet
131 addOneFV = extendNameSet
132 unitFV = unitNameSet
133 delFV n s = delFromNameSet s n
134 delFVs ns s = delListFromNameSet s ns
135 intersectFVs = intersectNameSet
136
137 {-
138 ************************************************************************
139 * *
140 Defs and uses
141 * *
142 ************************************************************************
143 -}
144
145 -- | A set of names that are defined somewhere
146 type Defs = NameSet
147
148 -- | A set of names that are used somewhere
149 type Uses = NameSet
150
151 -- | @(Just ds, us) =>@ The use of any member of the @ds@
152 -- implies that all the @us@ are used too.
153 -- Also, @us@ may mention @ds@.
154 --
155 -- @Nothing =>@ Nothing is defined in this group, but
156 -- nevertheless all the uses are essential.
157 -- Used for instance declarations, for example
158 type DefUse = (Maybe Defs, Uses)
159
160 -- | A number of 'DefUse's in dependency order: earlier 'Defs' scope over later 'Uses'
161 -- In a single (def, use) pair, the defs also scope over the uses
162 type DefUses = [DefUse]
163
164 emptyDUs :: DefUses
165 emptyDUs = []
166
167 usesOnly :: Uses -> DefUses
168 usesOnly uses = [(Nothing, uses)]
169
170 mkDUs :: [(Defs,Uses)] -> DefUses
171 mkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]
172
173 plusDU :: DefUses -> DefUses -> DefUses
174 plusDU = (++)
175
176 duDefs :: DefUses -> Defs
177 duDefs dus = foldr get emptyNameSet dus
178 where
179 get (Nothing, _u1) d2 = d2
180 get (Just d1, _u1) d2 = d1 `unionNameSet` d2
181
182 allUses :: DefUses -> Uses
183 -- ^ Just like 'duUses', but 'Defs' are not eliminated from the 'Uses' returned
184 allUses dus = foldr get emptyNameSet dus
185 where
186 get (_d1, u1) u2 = u1 `unionNameSet` u2
187
188 duUses :: DefUses -> Uses
189 -- ^ Collect all 'Uses', regardless of whether the group is itself used,
190 -- but remove 'Defs' on the way
191 duUses dus = foldr get emptyNameSet dus
192 where
193 get (Nothing, rhs_uses) uses = rhs_uses `unionNameSet` uses
194 get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSet` uses)
195 `minusNameSet` defs
196
197 findUses :: DefUses -> Uses -> Uses
198 -- ^ Given some 'DefUses' and some 'Uses', find all the uses, transitively.
199 -- The result is a superset of the input 'Uses'; and includes things defined
200 -- in the input 'DefUses' (but only if they are used)
201 findUses dus uses
202 = foldr get uses dus
203 where
204 get (Nothing, rhs_uses) uses
205 = rhs_uses `unionNameSet` uses
206 get (Just defs, rhs_uses) uses
207 | defs `intersectsNameSet` uses -- Used
208 || nameSetAny (startsWithUnderscore . nameOccName) defs
209 -- At least one starts with an "_",
210 -- so treat the group as used
211 = rhs_uses `unionNameSet` uses
212 | otherwise -- No def is used
213 = uses