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