VarSet.hs 11.7 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-}
5

6
{-# LANGUAGE CPP #-}
Ian Lynagh's avatar
Ian Lynagh committed
7

8
module VarSet (
batterseapower's avatar
batterseapower committed
9
        -- * Var, Id and TyVar set types
10
        VarSet, IdSet, TyVarSet, CoVarSet, TyCoVarSet,
11 12 13

        -- ** Manipulating these sets
        emptyVarSet, unitVarSet, mkVarSet,
David Feuer's avatar
David Feuer committed
14
        extendVarSet, extendVarSetList,
niteria's avatar
niteria committed
15
        elemVarSet, subVarSet,
16 17 18
        unionVarSet, unionVarSets, mapUnionVarSet,
        intersectVarSet, intersectsVarSet, disjointVarSet,
        isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey,
19
        minusVarSet, filterVarSet, mapVarSet,
20
        anyVarSet, allVarSet,
21
        transCloVarSet, fixVarSet,
David Feuer's avatar
David Feuer committed
22
        lookupVarSet_Directly, lookupVarSet, lookupVarSetByName,
niteria's avatar
niteria committed
23
        sizeVarSet, seqVarSet,
24
        elemVarSetByKey, partitionVarSet,
25
        pluralVarSet, pprVarSet,
26 27

        -- * Deterministic Var set types
28
        DVarSet, DIdSet, DTyVarSet, DTyCoVarSet,
29 30 31

        -- ** Manipulating these sets
        emptyDVarSet, unitDVarSet, mkDVarSet,
32
        extendDVarSet, extendDVarSetList,
33 34
        elemDVarSet, dVarSetElems, subDVarSet,
        unionDVarSet, unionDVarSets, mapUnionDVarSet,
35 36
        intersectDVarSet, dVarSetIntersectVarSet,
        intersectsDVarSet, disjointDVarSet,
37
        isEmptyDVarSet, delDVarSet, delDVarSetList,
38
        minusDVarSet, foldDVarSet, filterDVarSet,
39
        dVarSetMinusVarSet, anyDVarSet, allDVarSet,
40
        transCloDVarSet,
41
        sizeDVarSet, seqDVarSet,
42
        partitionDVarSet,
43
        dVarSetToVarSet,
44 45 46 47
    ) where

#include "HsVersions.h"

48 49
import GhcPrelude

50
import Var      ( Var, TyVar, CoVar, TyCoVar, Id )
Simon Marlow's avatar
Simon Marlow committed
51
import Unique
52
import Name     ( Name )
53
import UniqSet
54
import UniqDSet
55
import UniqFM( disjointUFM, pluralUFM, pprUFM )
56
import UniqDFM( disjointUDFM, udfmToUfm, anyUDFM, allUDFM )
57
import Outputable (SDoc)
58

59 60 61
-- | A non-deterministic Variable Set
--
-- A non-deterministic set of variables.
62 63 64 65
-- See Note [Deterministic UniqFM] in UniqDFM for explanation why it's not
-- deterministic and why it matters. Use DVarSet if the set eventually
-- gets converted into a list or folded over in a way where the order
-- changes the generated code, for example when abstracting variables.
66
type VarSet       = UniqSet Var
67 68

-- | Identifier Set
69
type IdSet        = UniqSet Id
70 71

-- | Type Variable Set
72
type TyVarSet     = UniqSet TyVar
73 74

-- | Coercion Variable Set
75
type CoVarSet     = UniqSet CoVar
76 77

-- | Type or Coercion Variable Set
78
type TyCoVarSet   = UniqSet TyCoVar
79

80 81 82 83
emptyVarSet     :: VarSet
intersectVarSet :: VarSet -> VarSet -> VarSet
unionVarSet     :: VarSet -> VarSet -> VarSet
unionVarSets    :: [VarSet] -> VarSet
84 85

mapUnionVarSet  :: (a -> VarSet) -> [a] -> VarSet
Rik Steenkamp's avatar
Rik Steenkamp committed
86
-- ^ map the function over the list, and union the results
87

88 89
unitVarSet      :: Var -> VarSet
extendVarSet    :: VarSet -> Var -> VarSet
90
extendVarSetList:: VarSet -> [Var] -> VarSet
91 92 93 94 95 96
elemVarSet      :: Var -> VarSet -> Bool
delVarSet       :: VarSet -> Var -> VarSet
delVarSetList   :: VarSet -> [Var] -> VarSet
minusVarSet     :: VarSet -> VarSet -> VarSet
isEmptyVarSet   :: VarSet -> Bool
mkVarSet        :: [Var] -> VarSet
David Feuer's avatar
David Feuer committed
97
lookupVarSet_Directly :: VarSet -> Unique -> Maybe Var
98 99 100
lookupVarSet    :: VarSet -> Var -> Maybe Var
                        -- Returns the set element, which may be
                        -- (==) to the argument, but not the same as
101
lookupVarSetByName :: VarSet -> Name -> Maybe Var
102 103
sizeVarSet      :: VarSet -> Int
filterVarSet    :: (Var -> Bool) -> VarSet -> VarSet
104

105
delVarSetByKey  :: VarSet -> Unique -> VarSet
106
elemVarSetByKey :: Unique -> VarSet -> Bool
107
partitionVarSet :: (Var -> Bool) -> VarSet -> (VarSet, VarSet)
108

109 110 111
emptyVarSet     = emptyUniqSet
unitVarSet      = unitUniqSet
extendVarSet    = addOneToUniqSet
112
extendVarSetList= addListToUniqSet
113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128
intersectVarSet = intersectUniqSets

intersectsVarSet:: VarSet -> VarSet -> Bool     -- True if non-empty intersection
disjointVarSet  :: VarSet -> VarSet -> Bool     -- True if empty intersection
subVarSet       :: VarSet -> VarSet -> Bool     -- True if first arg is subset of second
        -- (s1 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty;
        -- ditto disjointVarSet, subVarSet

unionVarSet     = unionUniqSets
unionVarSets    = unionManyUniqSets
elemVarSet      = elementOfUniqSet
minusVarSet     = minusUniqSet
delVarSet       = delOneFromUniqSet
delVarSetList   = delListFromUniqSet
isEmptyVarSet   = isEmptyUniqSet
mkVarSet        = mkUniqSet
David Feuer's avatar
David Feuer committed
129
lookupVarSet_Directly = lookupUniqSet_Directly
130
lookupVarSet    = lookupUniqSet
131
lookupVarSetByName = lookupUniqSet
132 133 134 135
sizeVarSet      = sizeUniqSet
filterVarSet    = filterUniqSet
delVarSetByKey  = delOneFromUniqSet_Directly
elemVarSetByKey = elemUniqSet_Directly
136
partitionVarSet = partitionUniqSet
137

138 139
mapUnionVarSet get_set xs = foldr (unionVarSet . get_set) emptyVarSet xs

140
-- See comments with type signatures
141
intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2)
David Feuer's avatar
David Feuer committed
142
disjointVarSet   s1 s2 = disjointUFM (getUniqSet s1) (getUniqSet s2)
143
subVarSet        s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2)
144

145 146
anyVarSet :: (Var -> Bool) -> VarSet -> Bool
anyVarSet = uniqSetAny
147

148 149
allVarSet :: (Var -> Bool) -> VarSet -> Bool
allVarSet = uniqSetAll
150

151 152
mapVarSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b
mapVarSet = mapUniqSet
niteria's avatar
niteria committed
153

154 155
fixVarSet :: (VarSet -> VarSet)   -- Map the current set to a new set
          -> VarSet -> VarSet
156
-- (fixVarSet f s) repeatedly applies f to the set s,
157 158 159 160 161 162 163
-- until it reaches a fixed point.
fixVarSet fn vars
  | new_vars `subVarSet` vars = vars
  | otherwise                 = fixVarSet fn new_vars
  where
    new_vars = fn vars

164
transCloVarSet :: (VarSet -> VarSet)
165 166
                  -- Map some variables in the set to
                  -- extra variables that should be in it
167
               -> VarSet -> VarSet
168 169 170 171 172 173 174 175
-- (transCloVarSet f s) repeatedly applies f to new candidates, adding any
-- new variables to s that it finds thereby, until it reaches a fixed point.
--
-- The function fn could be (Var -> VarSet), but we use (VarSet -> VarSet)
-- for efficiency, so that the test can be batched up.
-- It's essential that fn will work fine if given new candidates
-- one at at time; ie  fn {v1,v2} = fn v1 `union` fn v2
-- Use fixVarSet if the function needs to see the whole set all at once
176 177 178 179 180 181 182
transCloVarSet fn seeds
  = go seeds seeds
  where
    go :: VarSet  -- Accumulating result
       -> VarSet  -- Work-list; un-processed subset of accumulating result
       -> VarSet
    -- Specification: go acc vs = acc `union` transClo fn vs
183

184 185 186 187 188
    go acc candidates
       | isEmptyVarSet new_vs = acc
       | otherwise            = go (acc `unionVarSet` new_vs) new_vs
       where
         new_vs = fn candidates `minusVarSet` acc
189

190 191
seqVarSet :: VarSet -> ()
seqVarSet s = sizeVarSet s `seq` ()
192

193 194 195
-- | Determines the pluralisation suffix appropriate for the length of a set
-- in the same way that plural from Outputable does for lists.
pluralVarSet :: VarSet -> SDoc
David Feuer's avatar
David Feuer committed
196
pluralVarSet = pluralUFM . getUniqSet
197 198 199 200 201

-- | Pretty-print a non-deterministic set.
-- The order of variables is non-deterministic and for pretty-printing that
-- shouldn't be a problem.
-- Having this function helps contain the non-determinism created with
niteria's avatar
niteria committed
202
-- nonDetEltsUFM.
niteria's avatar
niteria committed
203 204
-- Passing a list to the pretty-printing function allows the caller
-- to decide on the order of Vars (eg. toposort them) without them having
niteria's avatar
niteria committed
205
-- to use nonDetEltsUFM at the call site. This prevents from let-binding
niteria's avatar
niteria committed
206 207
-- non-deterministically ordered lists and reusing them where determinism
-- matters.
208 209
pprVarSet :: VarSet          -- ^ The things to be pretty printed
          -> ([Var] -> SDoc) -- ^ The pretty printing function to use on the
210 211 212
                             -- elements
          -> SDoc            -- ^ 'SDoc' where the things have been pretty
                             -- printed
David Feuer's avatar
David Feuer committed
213
pprVarSet = pprUFM . getUniqSet
214

215 216 217 218
-- Deterministic VarSet
-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need
-- DVarSet.

219
-- | Deterministic Variable Set
220
type DVarSet     = UniqDSet Var
221 222

-- | Deterministic Identifier Set
223
type DIdSet      = UniqDSet Id
224 225

-- | Deterministic Type Variable Set
226
type DTyVarSet   = UniqDSet TyVar
227 228

-- | Deterministic Type or Coercion Variable Set
229
type DTyCoVarSet = UniqDSet TyCoVar
230 231 232 233 234 235 236 237 238 239

emptyDVarSet :: DVarSet
emptyDVarSet = emptyUniqDSet

unitDVarSet :: Var -> DVarSet
unitDVarSet = unitUniqDSet

mkDVarSet :: [Var] -> DVarSet
mkDVarSet = mkUniqDSet

Tobias Dammers's avatar
Tobias Dammers committed
240
-- The new element always goes to the right of existing ones.
241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265
extendDVarSet :: DVarSet -> Var -> DVarSet
extendDVarSet = addOneToUniqDSet

elemDVarSet :: Var -> DVarSet -> Bool
elemDVarSet = elementOfUniqDSet

dVarSetElems :: DVarSet -> [Var]
dVarSetElems = uniqDSetToList

subDVarSet :: DVarSet -> DVarSet -> Bool
subDVarSet s1 s2 = isEmptyDVarSet (s1 `minusDVarSet` s2)

unionDVarSet :: DVarSet -> DVarSet -> DVarSet
unionDVarSet = unionUniqDSets

unionDVarSets :: [DVarSet] -> DVarSet
unionDVarSets = unionManyUniqDSets

-- | Map the function over the list, and union the results
mapUnionDVarSet  :: (a -> DVarSet) -> [a] -> DVarSet
mapUnionDVarSet get_set xs = foldr (unionDVarSet . get_set) emptyDVarSet xs

intersectDVarSet :: DVarSet -> DVarSet -> DVarSet
intersectDVarSet = intersectUniqDSets

266 267 268
dVarSetIntersectVarSet :: DVarSet -> VarSet -> DVarSet
dVarSetIntersectVarSet = uniqDSetIntersectUniqSet

269 270 271 272 273 274 275 276
-- | True if empty intersection
disjointDVarSet :: DVarSet -> DVarSet -> Bool
disjointDVarSet s1 s2 = disjointUDFM s1 s2

-- | True if non-empty intersection
intersectsDVarSet :: DVarSet -> DVarSet -> Bool
intersectsDVarSet s1 s2 = not (s1 `disjointDVarSet` s2)

277 278 279 280 281 282 283 284 285
isEmptyDVarSet :: DVarSet -> Bool
isEmptyDVarSet = isEmptyUniqDSet

delDVarSet :: DVarSet -> Var -> DVarSet
delDVarSet = delOneFromUniqDSet

minusDVarSet :: DVarSet -> DVarSet -> DVarSet
minusDVarSet = minusUniqDSet

286 287 288
dVarSetMinusVarSet :: DVarSet -> VarSet -> DVarSet
dVarSetMinusVarSet = uniqDSetMinusUniqSet

289 290 291
foldDVarSet :: (Var -> a -> a) -> a -> DVarSet -> a
foldDVarSet = foldUniqDSet

292 293 294 295 296 297
anyDVarSet :: (Var -> Bool) -> DVarSet -> Bool
anyDVarSet = anyUDFM

allDVarSet :: (Var -> Bool) -> DVarSet -> Bool
allDVarSet = allUDFM

298 299 300 301 302 303
filterDVarSet :: (Var -> Bool) -> DVarSet -> DVarSet
filterDVarSet = filterUniqDSet

sizeDVarSet :: DVarSet -> Int
sizeDVarSet = sizeUniqDSet

304 305 306 307 308 309 310 311
-- | Partition DVarSet according to the predicate given
partitionDVarSet :: (Var -> Bool) -> DVarSet -> (DVarSet, DVarSet)
partitionDVarSet = partitionUniqDSet

-- | Delete a list of variables from DVarSet
delDVarSetList :: DVarSet -> [Var] -> DVarSet
delDVarSetList = delListFromUniqDSet

312 313
seqDVarSet :: DVarSet -> ()
seqDVarSet s = sizeDVarSet s `seq` ()
314 315 316 317 318

-- | Add a list of variables to DVarSet
extendDVarSetList :: DVarSet -> [Var] -> DVarSet
extendDVarSetList = addListToUniqDSet

319 320
-- | Convert a DVarSet to a VarSet by forgeting the order of insertion
dVarSetToVarSet :: DVarSet -> VarSet
David Feuer's avatar
David Feuer committed
321
dVarSetToVarSet = unsafeUFMToUniqSet . udfmToUfm
322

323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347
-- | transCloVarSet for DVarSet
transCloDVarSet :: (DVarSet -> DVarSet)
                  -- Map some variables in the set to
                  -- extra variables that should be in it
                -> DVarSet -> DVarSet
-- (transCloDVarSet f s) repeatedly applies f to new candidates, adding any
-- new variables to s that it finds thereby, until it reaches a fixed point.
--
-- The function fn could be (Var -> DVarSet), but we use (DVarSet -> DVarSet)
-- for efficiency, so that the test can be batched up.
-- It's essential that fn will work fine if given new candidates
-- one at at time; ie  fn {v1,v2} = fn v1 `union` fn v2
transCloDVarSet fn seeds
  = go seeds seeds
  where
    go :: DVarSet  -- Accumulating result
       -> DVarSet  -- Work-list; un-processed subset of accumulating result
       -> DVarSet
    -- Specification: go acc vs = acc `union` transClo fn vs

    go acc candidates
       | isEmptyDVarSet new_vs = acc
       | otherwise            = go (acc `unionDVarSet` new_vs) new_vs
       where
         new_vs = fn candidates `minusDVarSet` acc