2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1998
8 -- The above warning supression flag is a temporary kludge.
9 -- While working on this module you are encouraged to remove it and fix
10 -- any warnings in the module. See
11 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
17 emptyNameSet, unitNameSet, mkNameSet, unionNameSets, unionManyNameSets,
18 minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet,
19 delFromNameSet, delListFromNameSet, isEmptyNameSet, foldNameSet, filterNameSet,
20 intersectsNameSet, intersectNameSet,
23 FreeVars, isEmptyFVs, emptyFVs, plusFVs, plusFV,
24 mkFVs, addOneFV, unitFV, delFV, delFVs,
27 Defs, Uses, DefUse, DefUses,
28 emptyDUs, usesOnly, mkDUs, plusDU,
29 findUses, duDefs, duUses, allUses
32 #include "HsVersions.h"
38 %************************************************************************
40 \subsection[Sets of names}
42 %************************************************************************
45 type NameSet = UniqSet Name
46 emptyNameSet :: NameSet
47 unitNameSet :: Name -> NameSet
48 addListToNameSet :: NameSet -> [Name] -> NameSet
49 addOneToNameSet :: NameSet -> Name -> NameSet
50 mkNameSet :: [Name] -> NameSet
51 unionNameSets :: NameSet -> NameSet -> NameSet
52 unionManyNameSets :: [NameSet] -> NameSet
53 minusNameSet :: NameSet -> NameSet -> NameSet
54 elemNameSet :: Name -> NameSet -> Bool
55 nameSetToList :: NameSet -> [Name]
56 isEmptyNameSet :: NameSet -> Bool
57 delFromNameSet :: NameSet -> Name -> NameSet
58 delListFromNameSet :: NameSet -> [Name] -> NameSet
59 foldNameSet :: (Name -> b -> b) -> b -> NameSet -> b
60 filterNameSet :: (Name -> Bool) -> NameSet -> NameSet
61 intersectNameSet :: NameSet -> NameSet -> NameSet
62 intersectsNameSet :: NameSet -> NameSet -> Bool -- True if non-empty intersection
63 -- (s1 `intersectsNameSet` s2) doesn't compute s2 if s1 is empty
65 isEmptyNameSet = isEmptyUniqSet
66 emptyNameSet = emptyUniqSet
67 unitNameSet = unitUniqSet
69 addListToNameSet = addListToUniqSet
70 addOneToNameSet = addOneToUniqSet
71 unionNameSets = unionUniqSets
72 unionManyNameSets = unionManyUniqSets
73 minusNameSet = minusUniqSet
74 elemNameSet = elementOfUniqSet
75 nameSetToList = uniqSetToList
76 delFromNameSet = delOneFromUniqSet
77 foldNameSet = foldUniqSet
78 filterNameSet = filterUniqSet
79 intersectNameSet = intersectUniqSets
81 delListFromNameSet set ns = foldl delFromNameSet set ns
83 intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))
87 %************************************************************************
89 \subsection{Free variables}
91 %************************************************************************
93 These synonyms are useful when we are thinking of free variables
96 type FreeVars = NameSet
98 plusFV :: FreeVars -> FreeVars -> FreeVars
99 addOneFV :: FreeVars -> Name -> FreeVars
100 unitFV :: Name -> FreeVars
102 plusFVs :: [FreeVars] -> FreeVars
103 mkFVs :: [Name] -> FreeVars
104 delFV :: Name -> FreeVars -> FreeVars
105 delFVs :: [Name] -> FreeVars -> FreeVars
107 isEmptyFVs = isEmptyNameSet
108 emptyFVs = emptyNameSet
109 plusFVs = unionManyNameSets
110 plusFV = unionNameSets
112 addOneFV = addOneToNameSet
114 delFV n s = delFromNameSet s n
115 delFVs ns s = delListFromNameSet s ns
119 %************************************************************************
123 %************************************************************************
129 type DefUses = [DefUse]
130 -- In dependency order: earlier Defs scope over later Uses
132 type DefUse = (Maybe Defs, Uses)
133 -- For items (Just ds, us), the use of any member
134 -- of the ds implies that all the us are used too
136 -- Also, us may mention ds
138 -- Nothing => Nothing defined in this group, but
139 -- nevertheless all the uses are essential.
140 -- Used for instance declarations, for example
145 usesOnly :: Uses -> DefUses
146 usesOnly uses = [(Nothing, uses)]
148 mkDUs :: [(Defs,Uses)] -> DefUses
149 mkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]
151 plusDU :: DefUses -> DefUses -> DefUses
154 duDefs :: DefUses -> Defs
155 duDefs dus = foldr get emptyNameSet dus
157 get (Nothing, u1) d2 = d2
158 get (Just d1, u1) d2 = d1 `unionNameSets` d2
160 duUses :: DefUses -> Uses
161 -- Just like allUses, but defs are not eliminated
162 duUses dus = foldr get emptyNameSet dus
164 get (d1, u1) u2 = u1 `unionNameSets` u2
166 allUses :: DefUses -> Uses
167 -- Collect all uses, regardless of
168 -- whether the group is itself used,
169 -- but remove defs on the way
171 = foldr get emptyNameSet dus
173 get (Nothing, rhs_uses) uses = rhs_uses `unionNameSets` uses
174 get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSets` uses)
177 findUses :: DefUses -> Uses -> Uses
178 -- Given some DefUses and some Uses,
179 -- find all the uses, transitively.
180 -- The result is a superset of the input uses;
181 -- and includes things defined in the input DefUses
182 -- (but only if they are used)
186 get (Nothing, rhs_uses) uses
187 = rhs_uses `unionNameSets` uses
188 get (Just defs, rhs_uses) uses
189 | defs `intersectsNameSet` uses -- Used
190 || not (all (reportIfUnused . nameOccName) (nameSetToList defs))
191 -- At least one starts with an "_",
192 -- so treat the group as used
193 = rhs_uses `unionNameSets` uses
194 | otherwise -- No def is used