never executed always true always false
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1998
4 -}
5
6
7 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
8 module GHC.Types.Name.Set (
9 -- * Names set type
10 NameSet,
11
12 -- ** Manipulating these sets
13 emptyNameSet, unitNameSet, mkNameSet, unionNameSet, unionNameSets,
14 minusNameSet, elemNameSet, extendNameSet, extendNameSetList,
15 delFromNameSet, delListFromNameSet, isEmptyNameSet, filterNameSet,
16 intersectsNameSet, disjointNameSet, intersectNameSet,
17 nameSetAny, nameSetAll, nameSetElemsStable,
18
19 -- * Free variables
20 FreeVars,
21
22 -- ** Manipulating sets of free variables
23 isEmptyFVs, emptyFVs, plusFVs, plusFV,
24 mkFVs, addOneFV, unitFV, delFV, delFVs,
25 intersectFVs,
26
27 -- * Defs and uses
28 Defs, Uses, DefUse, DefUses,
29
30 -- ** Manipulating defs and uses
31 emptyDUs, usesOnly, mkDUs, plusDU,
32 findUses, duDefs, duUses, allUses,
33
34 -- * Non-CAFfy names
35 NonCaffySet(..)
36 ) where
37
38 import GHC.Prelude
39
40 import GHC.Types.Name
41 import GHC.Data.OrdList
42 import GHC.Types.Unique.Set
43 import Data.List (sortBy)
44
45 {-
46 ************************************************************************
47 * *
48 \subsection[Sets of names}
49 * *
50 ************************************************************************
51 -}
52
53 type NameSet = UniqSet Name
54
55 emptyNameSet :: NameSet
56 unitNameSet :: Name -> NameSet
57 extendNameSetList :: NameSet -> [Name] -> NameSet
58 extendNameSet :: NameSet -> Name -> NameSet
59 mkNameSet :: [Name] -> NameSet
60 unionNameSet :: NameSet -> NameSet -> NameSet
61 unionNameSets :: [NameSet] -> NameSet
62 minusNameSet :: NameSet -> NameSet -> NameSet
63 elemNameSet :: Name -> NameSet -> Bool
64 isEmptyNameSet :: NameSet -> Bool
65 delFromNameSet :: NameSet -> Name -> NameSet
66 delListFromNameSet :: NameSet -> [Name] -> NameSet
67 filterNameSet :: (Name -> Bool) -> NameSet -> NameSet
68 intersectNameSet :: NameSet -> NameSet -> NameSet
69 intersectsNameSet :: NameSet -> NameSet -> Bool
70 disjointNameSet :: 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 extendNameSetList = addListToUniqSet
79 extendNameSet = addOneToUniqSet
80 unionNameSet = unionUniqSets
81 unionNameSets = unionManyUniqSets
82 minusNameSet = minusUniqSet
83 elemNameSet = elementOfUniqSet
84 delFromNameSet = delOneFromUniqSet
85 filterNameSet = filterUniqSet
86 intersectNameSet = intersectUniqSets
87 disjointNameSet = disjointUniqSets
88
89 delListFromNameSet set ns = foldl' delFromNameSet set ns
90
91 intersectsNameSet s1 s2 = not (s1 `disjointNameSet` s2)
92
93 nameSetAny :: (Name -> Bool) -> NameSet -> Bool
94 nameSetAny = uniqSetAny
95
96 nameSetAll :: (Name -> Bool) -> NameSet -> Bool
97 nameSetAll = uniqSetAll
98
99 -- | Get the elements of a NameSet with some stable ordering.
100 -- This only works for Names that originate in the source code or have been
101 -- tidied.
102 -- See Note [Deterministic UniqFM] to learn about nondeterminism
103 nameSetElemsStable :: NameSet -> [Name]
104 nameSetElemsStable ns =
105 sortBy stableNameCmp $ nonDetEltsUniqSet ns
106 -- It's OK to use nonDetEltsUniqSet here because we immediately sort
107 -- with stableNameCmp
108
109 {-
110 ************************************************************************
111 * *
112 \subsection{Free variables}
113 * *
114 ************************************************************************
115
116 These synonyms are useful when we are thinking of free variables
117 -}
118
119 type FreeVars = NameSet
120
121 plusFV :: FreeVars -> FreeVars -> FreeVars
122 addOneFV :: FreeVars -> Name -> FreeVars
123 unitFV :: Name -> FreeVars
124 emptyFVs :: FreeVars
125 plusFVs :: [FreeVars] -> FreeVars
126 mkFVs :: [Name] -> FreeVars
127 delFV :: Name -> FreeVars -> FreeVars
128 delFVs :: [Name] -> FreeVars -> FreeVars
129 intersectFVs :: FreeVars -> FreeVars -> FreeVars
130
131 isEmptyFVs :: NameSet -> Bool
132 isEmptyFVs = isEmptyNameSet
133 emptyFVs = emptyNameSet
134 plusFVs = unionNameSets
135 plusFV = unionNameSet
136 mkFVs = mkNameSet
137 addOneFV = extendNameSet
138 unitFV = unitNameSet
139 delFV n s = delFromNameSet s n
140 delFVs ns s = delListFromNameSet s ns
141 intersectFVs = intersectNameSet
142
143 {-
144 ************************************************************************
145 * *
146 Defs and uses
147 * *
148 ************************************************************************
149 -}
150
151 -- | A set of names that are defined somewhere
152 type Defs = NameSet
153
154 -- | A set of names that are used somewhere
155 type Uses = NameSet
156
157 -- | @(Just ds, us) =>@ The use of any member of the @ds@
158 -- implies that all the @us@ are used too.
159 -- Also, @us@ may mention @ds@.
160 --
161 -- @Nothing =>@ Nothing is defined in this group, but
162 -- nevertheless all the uses are essential.
163 -- Used for instance declarations, for example
164 type DefUse = (Maybe Defs, Uses)
165
166 -- | A number of 'DefUse's in dependency order: earlier 'Defs' scope over later 'Uses'
167 -- In a single (def, use) pair, the defs also scope over the uses
168 type DefUses = OrdList DefUse
169
170 emptyDUs :: DefUses
171 emptyDUs = nilOL
172
173 usesOnly :: Uses -> DefUses
174 usesOnly uses = unitOL (Nothing, uses)
175
176 mkDUs :: [(Defs,Uses)] -> DefUses
177 mkDUs pairs = toOL [(Just defs, uses) | (defs,uses) <- pairs]
178
179 plusDU :: DefUses -> DefUses -> DefUses
180 plusDU = appOL
181
182 duDefs :: DefUses -> Defs
183 duDefs dus = foldr get emptyNameSet dus
184 where
185 get (Nothing, _u1) d2 = d2
186 get (Just d1, _u1) d2 = d1 `unionNameSet` d2
187
188 allUses :: DefUses -> Uses
189 -- ^ Just like 'duUses', but 'Defs' are not eliminated from the 'Uses' returned
190 allUses dus = foldr get emptyNameSet dus
191 where
192 get (_d1, u1) u2 = u1 `unionNameSet` u2
193
194 duUses :: DefUses -> Uses
195 -- ^ Collect all 'Uses', regardless of whether the group is itself used,
196 -- but remove 'Defs' on the way
197 duUses dus = foldr get emptyNameSet dus
198 where
199 get (Nothing, rhs_uses) uses = rhs_uses `unionNameSet` uses
200 get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSet` uses)
201 `minusNameSet` defs
202
203 findUses :: DefUses -> Uses -> Uses
204 -- ^ Given some 'DefUses' and some 'Uses', find all the uses, transitively.
205 -- The result is a superset of the input 'Uses'; and includes things defined
206 -- in the input 'DefUses' (but only if they are used)
207 findUses dus uses
208 = foldr get uses dus
209 where
210 get (Nothing, rhs_uses) uses
211 = rhs_uses `unionNameSet` uses
212 get (Just defs, rhs_uses) uses
213 | defs `intersectsNameSet` uses -- Used
214 || nameSetAny (startsWithUnderscore . nameOccName) defs
215 -- At least one starts with an "_",
216 -- so treat the group as used
217 = rhs_uses `unionNameSet` uses
218 | otherwise -- No def is used
219 = uses
220
221 -- | 'Id's which have no CAF references. This is a result of analysis of C--.
222 -- It is always safe to use an empty 'NonCaffySet'. TODO Refer to Note.
223 newtype NonCaffySet = NonCaffySet NameSet
224 deriving (Semigroup, Monoid)