Smarter HsType pretty-print for promoted datacons
[ghc.git] / compiler / basicTypes / NameSet.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1998
4 -}
5
6 {-# LANGUAGE CPP #-}
7 module NameSet (
8 -- * Names set type
9 NameSet,
10
11 -- ** Manipulating these sets
12 emptyNameSet, unitNameSet, mkNameSet, unionNameSet, unionNameSets,
13 minusNameSet, elemNameSet, extendNameSet, extendNameSetList,
14 delFromNameSet, delListFromNameSet, isEmptyNameSet, filterNameSet,
15 intersectsNameSet, intersectNameSet,
16 nameSetAny, nameSetAll, nameSetElemsStable,
17
18 -- * Free variables
19 FreeVars,
20
21 -- ** Manipulating sets of free variables
22 isEmptyFVs, emptyFVs, plusFVs, plusFV,
23 mkFVs, addOneFV, unitFV, delFV, delFVs,
24 intersectFVs,
25
26 -- * Defs and uses
27 Defs, Uses, DefUse, DefUses,
28
29 -- ** Manipulating defs and uses
30 emptyDUs, usesOnly, mkDUs, plusDU,
31 findUses, duDefs, duUses, allUses
32 ) where
33
34 #include "HsVersions.h"
35
36 import GhcPrelude
37
38 import Name
39 import UniqSet
40 import Data.List (sortBy)
41
42 {-
43 ************************************************************************
44 * *
45 \subsection[Sets of names}
46 * *
47 ************************************************************************
48 -}
49
50 type NameSet = UniqSet Name
51
52 emptyNameSet :: NameSet
53 unitNameSet :: Name -> NameSet
54 extendNameSetList :: NameSet -> [Name] -> NameSet
55 extendNameSet :: NameSet -> Name -> NameSet
56 mkNameSet :: [Name] -> NameSet
57 unionNameSet :: NameSet -> NameSet -> NameSet
58 unionNameSets :: [NameSet] -> NameSet
59 minusNameSet :: NameSet -> NameSet -> NameSet
60 elemNameSet :: Name -> NameSet -> Bool
61 isEmptyNameSet :: NameSet -> Bool
62 delFromNameSet :: NameSet -> Name -> NameSet
63 delListFromNameSet :: NameSet -> [Name] -> NameSet
64 filterNameSet :: (Name -> Bool) -> NameSet -> NameSet
65 intersectNameSet :: NameSet -> NameSet -> NameSet
66 intersectsNameSet :: NameSet -> NameSet -> Bool
67 -- ^ True if there is a non-empty intersection.
68 -- @s1 `intersectsNameSet` s2@ doesn't compute @s2@ if @s1@ is empty
69
70 isEmptyNameSet = isEmptyUniqSet
71 emptyNameSet = emptyUniqSet
72 unitNameSet = unitUniqSet
73 mkNameSet = mkUniqSet
74 extendNameSetList = addListToUniqSet
75 extendNameSet = addOneToUniqSet
76 unionNameSet = unionUniqSets
77 unionNameSets = unionManyUniqSets
78 minusNameSet = minusUniqSet
79 elemNameSet = elementOfUniqSet
80 delFromNameSet = delOneFromUniqSet
81 filterNameSet = filterUniqSet
82 intersectNameSet = intersectUniqSets
83
84 delListFromNameSet set ns = foldl' delFromNameSet set ns
85
86 intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))
87
88 nameSetAny :: (Name -> Bool) -> NameSet -> Bool
89 nameSetAny = uniqSetAny
90
91 nameSetAll :: (Name -> Bool) -> NameSet -> Bool
92 nameSetAll = uniqSetAll
93
94 -- | Get the elements of a NameSet with some stable ordering.
95 -- This only works for Names that originate in the source code or have been
96 -- tidied.
97 -- See Note [Deterministic UniqFM] to learn about nondeterminism
98 nameSetElemsStable :: NameSet -> [Name]
99 nameSetElemsStable ns =
100 sortBy stableNameCmp $ nonDetEltsUniqSet ns
101 -- It's OK to use nonDetEltsUniqSet here because we immediately sort
102 -- with stableNameCmp
103
104 {-
105 ************************************************************************
106 * *
107 \subsection{Free variables}
108 * *
109 ************************************************************************
110
111 These synonyms are useful when we are thinking of free variables
112 -}
113
114 type FreeVars = NameSet
115
116 plusFV :: FreeVars -> FreeVars -> FreeVars
117 addOneFV :: FreeVars -> Name -> FreeVars
118 unitFV :: Name -> FreeVars
119 emptyFVs :: FreeVars
120 plusFVs :: [FreeVars] -> FreeVars
121 mkFVs :: [Name] -> FreeVars
122 delFV :: Name -> FreeVars -> FreeVars
123 delFVs :: [Name] -> FreeVars -> FreeVars
124 intersectFVs :: FreeVars -> FreeVars -> FreeVars
125
126 isEmptyFVs :: NameSet -> Bool
127 isEmptyFVs = isEmptyNameSet
128 emptyFVs = emptyNameSet
129 plusFVs = unionNameSets
130 plusFV = unionNameSet
131 mkFVs = mkNameSet
132 addOneFV = extendNameSet
133 unitFV = unitNameSet
134 delFV n s = delFromNameSet s n
135 delFVs ns s = delListFromNameSet s ns
136 intersectFVs = intersectNameSet
137
138 {-
139 ************************************************************************
140 * *
141 Defs and uses
142 * *
143 ************************************************************************
144 -}
145
146 -- | A set of names that are defined somewhere
147 type Defs = NameSet
148
149 -- | A set of names that are used somewhere
150 type Uses = NameSet
151
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@.
155 --
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)
160
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]
164
165 emptyDUs :: DefUses
166 emptyDUs = []
167
168 usesOnly :: Uses -> DefUses
169 usesOnly uses = [(Nothing, uses)]
170
171 mkDUs :: [(Defs,Uses)] -> DefUses
172 mkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]
173
174 plusDU :: DefUses -> DefUses -> DefUses
175 plusDU = (++)
176
177 duDefs :: DefUses -> Defs
178 duDefs dus = foldr get emptyNameSet dus
179 where
180 get (Nothing, _u1) d2 = d2
181 get (Just d1, _u1) d2 = d1 `unionNameSet` d2
182
183 allUses :: DefUses -> Uses
184 -- ^ Just like 'duUses', but 'Defs' are not eliminated from the 'Uses' returned
185 allUses dus = foldr get emptyNameSet dus
186 where
187 get (_d1, u1) u2 = u1 `unionNameSet` u2
188
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
193 where
194 get (Nothing, rhs_uses) uses = rhs_uses `unionNameSet` uses
195 get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSet` uses)
196 `minusNameSet` defs
197
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)
202 findUses dus uses
203 = foldr get uses dus
204 where
205 get (Nothing, rhs_uses) uses
206 = rhs_uses `unionNameSet` uses
207 get (Just defs, rhs_uses) uses
208 | defs `intersectsNameSet` uses -- Used
209 || nameSetAny (startsWithUnderscore . nameOccName) defs
210 -- At least one starts with an "_",
211 -- so treat the group as used
212 = rhs_uses `unionNameSet` uses
213 | otherwise -- No def is used
214 = uses