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 INSTANCE_TYPEABLE0(NameSet,nameSetTc,"NameSet")
53 instance Data NameSet where
54 gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly
55 toConstr _ = abstractConstr "NameSet"
56 gunfold _ _ = error "gunfold"
57 dataTypeOf _ = mkNoRepType "NameSet"
59 emptyNameSet :: NameSet
60 unitNameSet :: Name -> NameSet
61 addListToNameSet :: NameSet -> [Name] -> NameSet
62 addOneToNameSet :: NameSet -> Name -> NameSet
63 mkNameSet :: [Name] -> NameSet
64 unionNameSets :: NameSet -> NameSet -> NameSet
65 unionManyNameSets :: [NameSet] -> NameSet
66 minusNameSet :: NameSet -> NameSet -> NameSet
67 elemNameSet :: Name -> NameSet -> Bool
68 nameSetToList :: NameSet -> [Name]
69 isEmptyNameSet :: NameSet -> Bool
70 delFromNameSet :: NameSet -> Name -> NameSet
71 delListFromNameSet :: NameSet -> [Name] -> NameSet
72 foldNameSet :: (Name -> b -> b) -> b -> NameSet -> b
73 filterNameSet :: (Name -> Bool) -> NameSet -> NameSet
74 intersectNameSet :: NameSet -> NameSet -> NameSet
75 intersectsNameSet :: NameSet -> NameSet -> Bool
76 -- ^ True if there is a non-empty intersection.
77 -- @s1 `intersectsNameSet` s2@ doesn't compute @s2@ if @s1@ is empty
79 isEmptyNameSet = isEmptyUniqSet
80 emptyNameSet = emptyUniqSet
81 unitNameSet = unitUniqSet
83 addListToNameSet = addListToUniqSet
84 addOneToNameSet = addOneToUniqSet
85 unionNameSets = unionUniqSets
86 unionManyNameSets = unionManyUniqSets
87 minusNameSet = minusUniqSet
88 elemNameSet = elementOfUniqSet
89 nameSetToList = uniqSetToList
90 delFromNameSet = delOneFromUniqSet
91 foldNameSet = foldUniqSet
92 filterNameSet = filterUniqSet
93 intersectNameSet = intersectUniqSets
95 delListFromNameSet set ns = foldl delFromNameSet set ns
97 intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))
101 %************************************************************************
103 \subsection{Free variables}
105 %************************************************************************
107 These synonyms are useful when we are thinking of free variables
110 type FreeVars = NameSet
112 plusFV :: FreeVars -> FreeVars -> FreeVars
113 addOneFV :: FreeVars -> Name -> FreeVars
114 unitFV :: Name -> FreeVars
116 plusFVs :: [FreeVars] -> FreeVars
117 mkFVs :: [Name] -> FreeVars
118 delFV :: Name -> FreeVars -> FreeVars
119 delFVs :: [Name] -> FreeVars -> FreeVars
121 isEmptyFVs :: NameSet -> Bool
122 isEmptyFVs = isEmptyNameSet
123 emptyFVs = emptyNameSet
124 plusFVs = unionManyNameSets
125 plusFV = unionNameSets
127 addOneFV = addOneToNameSet
129 delFV n s = delFromNameSet s n
130 delFVs ns s = delListFromNameSet s ns
134 %************************************************************************
138 %************************************************************************
141 -- | A set of names that are defined somewhere
144 -- | A set of names that are used somewhere
147 -- | @(Just ds, us) =>@ The use of any member of the @ds@
148 -- implies that all the @us@ are used too.
149 -- Also, @us@ may mention @ds@.
151 -- @Nothing =>@ Nothing is defined in this group, but
152 -- nevertheless all the uses are essential.
153 -- Used for instance declarations, for example
154 type DefUse = (Maybe Defs, Uses)
156 -- | A number of 'DefUse's in dependency order: earlier 'Defs' scope over later 'Uses'
157 -- In a single (def, use) pair, the defs also scope over the uses
158 type DefUses = [DefUse]
163 usesOnly :: Uses -> DefUses
164 usesOnly uses = [(Nothing, uses)]
166 mkDUs :: [(Defs,Uses)] -> DefUses
167 mkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]
169 plusDU :: DefUses -> DefUses -> DefUses
172 duDefs :: DefUses -> Defs
173 duDefs dus = foldr get emptyNameSet dus
175 get (Nothing, _u1) d2 = d2
176 get (Just d1, _u1) d2 = d1 `unionNameSets` d2
178 allUses :: DefUses -> Uses
179 -- ^ Just like 'allUses', but 'Defs' are not eliminated from the 'Uses' returned
180 allUses dus = foldr get emptyNameSet dus
182 get (_d1, u1) u2 = u1 `unionNameSets` u2
184 duUses :: DefUses -> Uses
185 -- ^ Collect all 'Uses', regardless of whether the group is itself used,
186 -- but remove 'Defs' on the way
188 = foldr get emptyNameSet dus
190 get (Nothing, rhs_uses) uses = rhs_uses `unionNameSets` uses
191 get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSets` uses)
194 findUses :: DefUses -> Uses -> Uses
195 -- ^ Given some 'DefUses' and some 'Uses', find all the uses, transitively.
196 -- The result is a superset of the input 'Uses'; and includes things defined
197 -- in the input 'DefUses' (but only if they are used)
201 get (Nothing, rhs_uses) uses
202 = rhs_uses `unionNameSets` uses
203 get (Just defs, rhs_uses) uses
204 | defs `intersectsNameSet` uses -- Used
205 || any (startsWithUnderscore . nameOccName) (nameSetToList defs)
206 -- At least one starts with an "_",
207 -- so treat the group as used
208 = rhs_uses `unionNameSets` uses
209 | otherwise -- No def is used