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