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