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