1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
%
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%
\section[NameSet]{@NameSets@}
\begin{code}
module NameSet (
-- Sets of Names
NameSet,
emptyNameSet, unitNameSet, mkNameSet, unionNameSets, unionManyNameSets,
minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet,
delFromNameSet, delListFromNameSet, isEmptyNameSet, foldNameSet, filterNameSet,
intersectsNameSet, intersectNameSet,
-- Free variables
FreeVars, isEmptyFVs, emptyFVs, plusFVs, plusFV,
mkFVs, addOneFV, unitFV, delFV, delFVs,
-- Defs and uses
Defs, Uses, DefUse, DefUses,
emptyDUs, usesOnly, mkDUs, plusDU,
findUses, duDefs, duUses
) where
#include "HsVersions.h"
import Name
import UniqSet
\end{code}
%************************************************************************
%* *
\subsection[Sets of names}
%* *
%************************************************************************
\begin{code}
type NameSet = UniqSet Name
emptyNameSet :: NameSet
unitNameSet :: Name -> NameSet
addListToNameSet :: NameSet -> [Name] -> NameSet
addOneToNameSet :: NameSet -> Name -> NameSet
mkNameSet :: [Name] -> NameSet
unionNameSets :: NameSet -> NameSet -> NameSet
unionManyNameSets :: [NameSet] -> NameSet
minusNameSet :: NameSet -> NameSet -> NameSet
elemNameSet :: Name -> NameSet -> Bool
nameSetToList :: NameSet -> [Name]
isEmptyNameSet :: NameSet -> Bool
delFromNameSet :: NameSet -> Name -> NameSet
delListFromNameSet :: NameSet -> [Name] -> NameSet
foldNameSet :: (Name -> b -> b) -> b -> NameSet -> b
filterNameSet :: (Name -> Bool) -> NameSet -> NameSet
intersectNameSet :: NameSet -> NameSet -> NameSet
intersectsNameSet :: NameSet -> NameSet -> Bool -- True if non-empty intersection
-- (s1 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty
isEmptyNameSet = isEmptyUniqSet
emptyNameSet = emptyUniqSet
unitNameSet = unitUniqSet
mkNameSet = mkUniqSet
addListToNameSet = addListToUniqSet
addOneToNameSet = addOneToUniqSet
unionNameSets = unionUniqSets
unionManyNameSets = unionManyUniqSets
minusNameSet = minusUniqSet
elemNameSet = elementOfUniqSet
nameSetToList = uniqSetToList
delFromNameSet = delOneFromUniqSet
foldNameSet = foldUniqSet
filterNameSet = filterUniqSet
intersectNameSet = intersectUniqSets
delListFromNameSet set ns = foldl delFromNameSet set ns
intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))
\end{code}
%************************************************************************
%* *
\subsection{Free variables}
%* *
%************************************************************************
These synonyms are useful when we are thinking of free variables
\begin{code}
type FreeVars = NameSet
plusFV :: FreeVars -> FreeVars -> FreeVars
addOneFV :: FreeVars -> Name -> FreeVars
unitFV :: Name -> FreeVars
emptyFVs :: FreeVars
plusFVs :: [FreeVars] -> FreeVars
mkFVs :: [Name] -> FreeVars
delFV :: Name -> FreeVars -> FreeVars
delFVs :: [Name] -> FreeVars -> FreeVars
isEmptyFVs = isEmptyNameSet
emptyFVs = emptyNameSet
plusFVs = unionManyNameSets
plusFV = unionNameSets
mkFVs = mkNameSet
addOneFV = addOneToNameSet
unitFV = unitNameSet
delFV n s = delFromNameSet s n
delFVs ns s = delListFromNameSet s ns
\end{code}
%************************************************************************
%* *
Defs and uses
%* *
%************************************************************************
\begin{code}
type Defs = NameSet
type Uses = NameSet
type DefUse = (Maybe Defs, Uses)
type DefUses = [DefUse]
-- In dependency order: earlier Defs scope over later Uses
-- For items (Just ds, us), the use of any member
-- of the ds implies that all the us are used too
--
-- Also, us may mention ds
--
-- Nothing => Nothing defined in this group, but
-- nevertheless all the uses are essential.
-- Used for instance declarations, for example
emptyDUs :: DefUses
emptyDUs = []
usesOnly :: Uses -> DefUses
usesOnly uses = [(Nothing, uses)]
mkDUs :: [(Defs,Uses)] -> DefUses
mkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]
plusDU :: DefUses -> DefUses -> DefUses
plusDU = (++)
allUses :: DefUses -> Uses -> Uses
-- Collect all uses, removing defs
allUses dus uses
= foldr get emptyNameSet dus
where
get (Nothing, rhs_uses) uses = rhs_uses `unionNameSets` uses
get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSets` uses)
`minusNameSet` defs
findUses :: DefUses -> Uses -> Uses
-- Given some DefUses and some Uses,
-- find all the uses, transitively.
-- The result is a superset of the input uses;
-- and includes things defined in the input DefUses
-- (if they are used, of course)
findUses dus uses
= foldr get uses dus
where
get (Nothing, rhs_uses) uses
= rhs_uses `unionNameSets` uses
get (Just defs, rhs_uses) uses
| defs `intersectsNameSet` uses
= rhs_uses `unionNameSets` uses
| otherwise -- No def is used
= uses
duDefs :: DefUses -> Defs
duDefs dus = foldr get emptyNameSet dus
where
get (Nothing, u1) d2 = d2
get (Just d1, u1) d2 = d1 `unionNameSets` d2
duUses :: DefUses -> Uses
-- Defs are not eliminated
duUses dus = foldr get emptyNameSet dus
where
get (d1, u1) u2 = u1 `unionNameSets` u2
\end{code}
|
