2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1998
11 -- ** Manipulating these sets
12 emptyNameSet, unitNameSet, mkNameSet, unionNameSets, unionManyNameSets,
13 minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet,
14 delFromNameSet, delListFromNameSet, isEmptyNameSet, foldNameSet, filterNameSet,
15 intersectsNameSet, intersectNameSet,
20 -- ** Manipulating sets of free variables
21 isEmptyFVs, emptyFVs, plusFVs, plusFV,
22 mkFVs, addOneFV, unitFV, delFV, delFVs,
25 Defs, Uses, DefUse, DefUses,
27 -- ** Manipulating defs and uses
28 emptyDUs, usesOnly, mkDUs, plusDU,
29 findUses, duDefs, duUses, allUses
32 #include "HsVersions.h"
42 %************************************************************************
44 \subsection[Sets of names}
46 %************************************************************************
49 type NameSet = UniqSet Name
51 -- TODO: These Data/Typeable instances look very dubious. Surely either
52 -- UniqFM should have the instances, or this should be a newtype?
55 nameSetTc = mkTyCon "NameSet"
56 instance Typeable NameSet where { typeOf _ = mkTyConApp nameSetTc [] }
58 instance Data NameSet where
59 gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly
60 toConstr _ = abstractConstr "NameSet"
61 gunfold _ _ = error "gunfold"
62 dataTypeOf _ = mkNoRepType "NameSet"
64 emptyNameSet :: NameSet
65 unitNameSet :: Name -> NameSet
66 addListToNameSet :: NameSet -> [Name] -> NameSet
67 addOneToNameSet :: NameSet -> Name -> NameSet
68 mkNameSet :: [Name] -> NameSet
69 unionNameSets :: NameSet -> NameSet -> NameSet
70 unionManyNameSets :: [NameSet] -> NameSet
71 minusNameSet :: NameSet -> NameSet -> NameSet
72 elemNameSet :: Name -> NameSet -> Bool
73 nameSetToList :: NameSet -> [Name]
74 isEmptyNameSet :: NameSet -> Bool
75 delFromNameSet :: NameSet -> Name -> NameSet
76 delListFromNameSet :: NameSet -> [Name] -> NameSet
77 foldNameSet :: (Name -> b -> b) -> b -> NameSet -> b
78 filterNameSet :: (Name -> Bool) -> NameSet -> NameSet
79 intersectNameSet :: NameSet -> NameSet -> NameSet
80 intersectsNameSet :: NameSet -> NameSet -> Bool
81 -- ^ True if there is a non-empty intersection.
82 -- @s1 `intersectsNameSet` s2@ doesn't compute @s2@ if @s1@ is empty
84 isEmptyNameSet = isEmptyUniqSet
85 emptyNameSet = emptyUniqSet
86 unitNameSet = unitUniqSet
88 addListToNameSet = addListToUniqSet
89 addOneToNameSet = addOneToUniqSet
90 unionNameSets = unionUniqSets
91 unionManyNameSets = unionManyUniqSets
92 minusNameSet = minusUniqSet
93 elemNameSet = elementOfUniqSet
94 nameSetToList = uniqSetToList
95 delFromNameSet = delOneFromUniqSet
96 foldNameSet = foldUniqSet
97 filterNameSet = filterUniqSet
98 intersectNameSet = intersectUniqSets
100 delListFromNameSet set ns = foldl delFromNameSet set ns
102 intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))
106 %************************************************************************
108 \subsection{Free variables}
110 %************************************************************************
112 These synonyms are useful when we are thinking of free variables
115 type FreeVars = NameSet
117 plusFV :: FreeVars -> FreeVars -> FreeVars
118 addOneFV :: FreeVars -> Name -> FreeVars
119 unitFV :: Name -> FreeVars
121 plusFVs :: [FreeVars] -> FreeVars
122 mkFVs :: [Name] -> FreeVars
123 delFV :: Name -> FreeVars -> FreeVars
124 delFVs :: [Name] -> FreeVars -> FreeVars
126 isEmptyFVs :: NameSet -> Bool
127 isEmptyFVs = isEmptyNameSet
128 emptyFVs = emptyNameSet
129 plusFVs = unionManyNameSets
130 plusFV = unionNameSets
132 addOneFV = addOneToNameSet
134 delFV n s = delFromNameSet s n
135 delFVs ns s = delListFromNameSet s ns
139 %************************************************************************
143 %************************************************************************
146 -- | A set of names that are defined somewhere
149 -- | A set of names that are used somewhere
152 -- | @(Just ds, us) =>@ The use of any member of the @ds@
153 -- implies that all the @us@ are used too.
154 -- Also, @us@ may mention @ds@.
156 -- @Nothing =>@ Nothing is defined in this group, but
157 -- nevertheless all the uses are essential.
158 -- Used for instance declarations, for example
159 type DefUse = (Maybe Defs, Uses)
161 -- | A number of 'DefUse's in dependency order: earlier 'Defs' scope over later 'Uses'
162 -- In a single (def, use) pair, the defs also scope over the uses
163 type DefUses = [DefUse]
168 usesOnly :: Uses -> DefUses
169 usesOnly uses = [(Nothing, uses)]
171 mkDUs :: [(Defs,Uses)] -> DefUses
172 mkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]
174 plusDU :: DefUses -> DefUses -> DefUses
177 duDefs :: DefUses -> Defs
178 duDefs dus = foldr get emptyNameSet dus
180 get (Nothing, _u1) d2 = d2
181 get (Just d1, _u1) d2 = d1 `unionNameSets` d2
183 allUses :: DefUses -> Uses
184 -- ^ Just like 'duUses', but 'Defs' are not eliminated from the 'Uses' returned
185 allUses dus = foldr get emptyNameSet dus
187 get (_d1, u1) u2 = u1 `unionNameSets` u2
189 duUses :: DefUses -> Uses
190 -- ^ Collect all 'Uses', regardless of whether the group is itself used,
191 -- but remove 'Defs' on the way
192 duUses dus = foldr get emptyNameSet dus
194 get (Nothing, rhs_uses) uses = rhs_uses `unionNameSets` uses
195 get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSets` uses)
198 findUses :: DefUses -> Uses -> Uses
199 -- ^ Given some 'DefUses' and some 'Uses', find all the uses, transitively.
200 -- The result is a superset of the input 'Uses'; and includes things defined
201 -- in the input 'DefUses' (but only if they are used)
205 get (Nothing, rhs_uses) uses
206 = rhs_uses `unionNameSets` uses
207 get (Just defs, rhs_uses) uses
208 | defs `intersectsNameSet` uses -- Used
209 || any (startsWithUnderscore . nameOccName) (nameSetToList defs)
210 -- At least one starts with an "_",
211 -- so treat the group as used
212 = rhs_uses `unionNameSets` uses
213 | otherwise -- No def is used