never executed always true always false
    1 {-
    2 (c) The University of Glasgow 2006
    3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
    4 -}
    5 
    6 
    7 
    8 module GHC.Types.Var.Set (
    9         -- * Var, Id and TyVar set types
   10         VarSet, IdSet, TyVarSet, CoVarSet, TyCoVarSet,
   11 
   12         -- ** Manipulating these sets
   13         emptyVarSet, unitVarSet, mkVarSet,
   14         extendVarSet, extendVarSetList,
   15         elemVarSet, subVarSet,
   16         unionVarSet, unionVarSets, mapUnionVarSet,
   17         intersectVarSet, intersectsVarSet, disjointVarSet,
   18         isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey,
   19         minusVarSet, filterVarSet, mapVarSet,
   20         anyVarSet, allVarSet,
   21         transCloVarSet, fixVarSet,
   22         lookupVarSet_Directly, lookupVarSet, lookupVarSetByName,
   23         sizeVarSet, seqVarSet,
   24         elemVarSetByKey, partitionVarSet,
   25         pluralVarSet, pprVarSet,
   26         nonDetStrictFoldVarSet,
   27 
   28         -- * Deterministic Var set types
   29         DVarSet, DIdSet, DTyVarSet, DTyCoVarSet,
   30 
   31         -- ** Manipulating these sets
   32         emptyDVarSet, unitDVarSet, mkDVarSet,
   33         extendDVarSet, extendDVarSetList,
   34         elemDVarSet, dVarSetElems, subDVarSet,
   35         unionDVarSet, unionDVarSets, mapUnionDVarSet,
   36         intersectDVarSet, dVarSetIntersectVarSet,
   37         intersectsDVarSet, disjointDVarSet,
   38         isEmptyDVarSet, delDVarSet, delDVarSetList,
   39         minusDVarSet,
   40         nonDetStrictFoldDVarSet,
   41         filterDVarSet, mapDVarSet,
   42         dVarSetMinusVarSet, anyDVarSet, allDVarSet,
   43         transCloDVarSet,
   44         sizeDVarSet, seqDVarSet,
   45         partitionDVarSet,
   46         dVarSetToVarSet,
   47     ) where
   48 
   49 import GHC.Prelude
   50 
   51 import GHC.Types.Var      ( Var, TyVar, CoVar, TyCoVar, Id )
   52 import GHC.Types.Unique
   53 import GHC.Types.Name     ( Name )
   54 import GHC.Types.Unique.Set
   55 import GHC.Types.Unique.DSet
   56 import GHC.Types.Unique.FM( disjointUFM, pluralUFM, pprUFM )
   57 import GHC.Types.Unique.DFM( disjointUDFM, udfmToUfm, anyUDFM, allUDFM )
   58 import GHC.Utils.Outputable (SDoc)
   59 
   60 -- | A non-deterministic Variable Set
   61 --
   62 -- A non-deterministic set of variables.
   63 -- See Note [Deterministic UniqFM] in "GHC.Types.Unique.DFM" for explanation why it's not
   64 -- deterministic and why it matters. Use DVarSet if the set eventually
   65 -- gets converted into a list or folded over in a way where the order
   66 -- changes the generated code, for example when abstracting variables.
   67 type VarSet       = UniqSet Var
   68 
   69 -- | Identifier Set
   70 type IdSet        = UniqSet Id
   71 
   72 -- | Type Variable Set
   73 type TyVarSet     = UniqSet TyVar
   74 
   75 -- | Coercion Variable Set
   76 type CoVarSet     = UniqSet CoVar
   77 
   78 -- | Type or Coercion Variable Set
   79 type TyCoVarSet   = UniqSet TyCoVar
   80 
   81 emptyVarSet     :: VarSet
   82 intersectVarSet :: VarSet -> VarSet -> VarSet
   83 unionVarSet     :: VarSet -> VarSet -> VarSet
   84 unionVarSets    :: [VarSet] -> VarSet
   85 
   86 mapUnionVarSet  :: (a -> VarSet) -> [a] -> VarSet
   87 -- ^ map the function over the list, and union the results
   88 
   89 unitVarSet      :: Var -> VarSet
   90 extendVarSet    :: VarSet -> Var -> VarSet
   91 extendVarSetList:: VarSet -> [Var] -> VarSet
   92 elemVarSet      :: Var -> VarSet -> Bool
   93 delVarSet       :: VarSet -> Var -> VarSet
   94 delVarSetList   :: VarSet -> [Var] -> VarSet
   95 minusVarSet     :: VarSet -> VarSet -> VarSet
   96 isEmptyVarSet   :: VarSet -> Bool
   97 mkVarSet        :: [Var] -> VarSet
   98 lookupVarSet_Directly :: VarSet -> Unique -> Maybe Var
   99 lookupVarSet    :: VarSet -> Var -> Maybe Var
  100                         -- Returns the set element, which may be
  101                         -- (==) to the argument, but not the same as
  102 lookupVarSetByName :: VarSet -> Name -> Maybe Var
  103 sizeVarSet      :: VarSet -> Int
  104 filterVarSet    :: (Var -> Bool) -> VarSet -> VarSet
  105 
  106 delVarSetByKey  :: VarSet -> Unique -> VarSet
  107 elemVarSetByKey :: Unique -> VarSet -> Bool
  108 partitionVarSet :: (Var -> Bool) -> VarSet -> (VarSet, VarSet)
  109 
  110 emptyVarSet     = emptyUniqSet
  111 unitVarSet      = unitUniqSet
  112 extendVarSet    = addOneToUniqSet
  113 extendVarSetList= addListToUniqSet
  114 intersectVarSet = intersectUniqSets
  115 
  116 intersectsVarSet:: VarSet -> VarSet -> Bool     -- True if non-empty intersection
  117 disjointVarSet  :: VarSet -> VarSet -> Bool     -- True if empty intersection
  118 subVarSet       :: VarSet -> VarSet -> Bool     -- True if first arg is subset of second
  119         -- (s1 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty;
  120         -- ditto disjointVarSet, subVarSet
  121 
  122 unionVarSet     = unionUniqSets
  123 unionVarSets    = unionManyUniqSets
  124 elemVarSet      = elementOfUniqSet
  125 minusVarSet     = minusUniqSet
  126 delVarSet       = delOneFromUniqSet
  127 delVarSetList   = delListFromUniqSet
  128 isEmptyVarSet   = isEmptyUniqSet
  129 mkVarSet        = mkUniqSet
  130 lookupVarSet_Directly = lookupUniqSet_Directly
  131 lookupVarSet    = lookupUniqSet
  132 lookupVarSetByName set name = lookupUniqSet_Directly set (getUnique name)
  133 sizeVarSet      = sizeUniqSet
  134 filterVarSet    = filterUniqSet
  135 delVarSetByKey  = delOneFromUniqSet_Directly
  136 elemVarSetByKey = elemUniqSet_Directly
  137 partitionVarSet = partitionUniqSet
  138 
  139 mapUnionVarSet get_set xs = foldr (unionVarSet . get_set) emptyVarSet xs
  140 
  141 -- See comments with type signatures
  142 intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2)
  143 disjointVarSet   s1 s2 = disjointUFM (getUniqSet s1) (getUniqSet s2)
  144 subVarSet        s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2)
  145 
  146 anyVarSet :: (Var -> Bool) -> VarSet -> Bool
  147 anyVarSet = uniqSetAny
  148 
  149 allVarSet :: (Var -> Bool) -> VarSet -> Bool
  150 allVarSet = uniqSetAll
  151 
  152 mapVarSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b
  153 mapVarSet = mapUniqSet
  154 
  155 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
  156 -- If you use this please provide a justification why it doesn't introduce
  157 -- nondeterminism.
  158 nonDetStrictFoldVarSet :: (Var -> a -> a) -> a -> VarSet -> a
  159 nonDetStrictFoldVarSet = nonDetStrictFoldUniqSet
  160 
  161 fixVarSet :: (VarSet -> VarSet)   -- Map the current set to a new set
  162           -> VarSet -> VarSet
  163 -- (fixVarSet f s) repeatedly applies f to the set s,
  164 -- until it reaches a fixed point.
  165 fixVarSet fn vars
  166   | new_vars `subVarSet` vars = vars
  167   | otherwise                 = fixVarSet fn new_vars
  168   where
  169     new_vars = fn vars
  170 
  171 transCloVarSet :: (VarSet -> VarSet)
  172                   -- Map some variables in the set to
  173                   -- extra variables that should be in it
  174                -> VarSet -> VarSet
  175 -- (transCloVarSet f s) repeatedly applies f to new candidates, adding any
  176 -- new variables to s that it finds thereby, until it reaches a fixed point.
  177 --
  178 -- The function fn could be (Var -> VarSet), but we use (VarSet -> VarSet)
  179 -- for efficiency, so that the test can be batched up.
  180 -- It's essential that fn will work fine if given new candidates
  181 -- one at a time; ie  fn {v1,v2} = fn v1 `union` fn v2
  182 -- Use fixVarSet if the function needs to see the whole set all at once
  183 transCloVarSet fn seeds
  184   = go seeds seeds
  185   where
  186     go :: VarSet  -- Accumulating result
  187        -> VarSet  -- Work-list; un-processed subset of accumulating result
  188        -> VarSet
  189     -- Specification: go acc vs = acc `union` transClo fn vs
  190 
  191     go acc candidates
  192        | isEmptyVarSet new_vs = acc
  193        | otherwise            = go (acc `unionVarSet` new_vs) new_vs
  194        where
  195          new_vs = fn candidates `minusVarSet` acc
  196 
  197 seqVarSet :: VarSet -> ()
  198 seqVarSet s = sizeVarSet s `seq` ()
  199 
  200 -- | Determines the pluralisation suffix appropriate for the length of a set
  201 -- in the same way that plural from Outputable does for lists.
  202 pluralVarSet :: VarSet -> SDoc
  203 pluralVarSet = pluralUFM . getUniqSet
  204 
  205 -- | Pretty-print a non-deterministic set.
  206 -- The order of variables is non-deterministic and for pretty-printing that
  207 -- shouldn't be a problem.
  208 -- Having this function helps contain the non-determinism created with
  209 -- nonDetEltsUFM.
  210 -- Passing a list to the pretty-printing function allows the caller
  211 -- to decide on the order of Vars (eg. toposort them) without them having
  212 -- to use nonDetEltsUFM at the call site. This prevents from let-binding
  213 -- non-deterministically ordered lists and reusing them where determinism
  214 -- matters.
  215 pprVarSet :: VarSet          -- ^ The things to be pretty printed
  216           -> ([Var] -> SDoc) -- ^ The pretty printing function to use on the
  217                              -- elements
  218           -> SDoc            -- ^ 'SDoc' where the things have been pretty
  219                              -- printed
  220 pprVarSet = pprUFM . getUniqSet
  221 
  222 -- Deterministic VarSet
  223 -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for explanation why we need
  224 -- DVarSet.
  225 
  226 -- | Deterministic Variable Set
  227 type DVarSet     = UniqDSet Var
  228 
  229 -- | Deterministic Identifier Set
  230 type DIdSet      = UniqDSet Id
  231 
  232 -- | Deterministic Type Variable Set
  233 type DTyVarSet   = UniqDSet TyVar
  234 
  235 -- | Deterministic Type or Coercion Variable Set
  236 type DTyCoVarSet = UniqDSet TyCoVar
  237 
  238 emptyDVarSet :: DVarSet
  239 emptyDVarSet = emptyUniqDSet
  240 
  241 unitDVarSet :: Var -> DVarSet
  242 unitDVarSet = unitUniqDSet
  243 
  244 mkDVarSet :: [Var] -> DVarSet
  245 mkDVarSet = mkUniqDSet
  246 
  247 -- The new element always goes to the right of existing ones.
  248 extendDVarSet :: DVarSet -> Var -> DVarSet
  249 extendDVarSet = addOneToUniqDSet
  250 
  251 elemDVarSet :: Var -> DVarSet -> Bool
  252 elemDVarSet = elementOfUniqDSet
  253 
  254 dVarSetElems :: DVarSet -> [Var]
  255 dVarSetElems = uniqDSetToList
  256 
  257 subDVarSet :: DVarSet -> DVarSet -> Bool
  258 subDVarSet s1 s2 = isEmptyDVarSet (s1 `minusDVarSet` s2)
  259 
  260 unionDVarSet :: DVarSet -> DVarSet -> DVarSet
  261 unionDVarSet = unionUniqDSets
  262 
  263 unionDVarSets :: [DVarSet] -> DVarSet
  264 unionDVarSets = unionManyUniqDSets
  265 
  266 -- | Map the function over the list, and union the results
  267 mapUnionDVarSet  :: (a -> DVarSet) -> [a] -> DVarSet
  268 mapUnionDVarSet get_set xs = foldr (unionDVarSet . get_set) emptyDVarSet xs
  269 
  270 intersectDVarSet :: DVarSet -> DVarSet -> DVarSet
  271 intersectDVarSet = intersectUniqDSets
  272 
  273 dVarSetIntersectVarSet :: DVarSet -> VarSet -> DVarSet
  274 dVarSetIntersectVarSet = uniqDSetIntersectUniqSet
  275 
  276 -- | True if empty intersection
  277 disjointDVarSet :: DVarSet -> DVarSet -> Bool
  278 disjointDVarSet s1 s2 = disjointUDFM (getUniqDSet s1) (getUniqDSet s2)
  279 
  280 -- | True if non-empty intersection
  281 intersectsDVarSet :: DVarSet -> DVarSet -> Bool
  282 intersectsDVarSet s1 s2 = not (s1 `disjointDVarSet` s2)
  283 
  284 isEmptyDVarSet :: DVarSet -> Bool
  285 isEmptyDVarSet = isEmptyUniqDSet
  286 
  287 delDVarSet :: DVarSet -> Var -> DVarSet
  288 delDVarSet = delOneFromUniqDSet
  289 
  290 minusDVarSet :: DVarSet -> DVarSet -> DVarSet
  291 minusDVarSet = minusUniqDSet
  292 
  293 dVarSetMinusVarSet :: DVarSet -> VarSet -> DVarSet
  294 dVarSetMinusVarSet = uniqDSetMinusUniqSet
  295 
  296 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
  297 -- If you use this please provide a justification why it doesn't introduce
  298 -- nondeterminism.
  299 nonDetStrictFoldDVarSet :: (Var -> a -> a) -> a -> DVarSet -> a
  300 nonDetStrictFoldDVarSet = nonDetStrictFoldUniqDSet
  301 
  302 anyDVarSet :: (Var -> Bool) -> DVarSet -> Bool
  303 anyDVarSet p = anyUDFM p . getUniqDSet
  304 
  305 allDVarSet :: (Var -> Bool) -> DVarSet -> Bool
  306 allDVarSet p = allUDFM p . getUniqDSet
  307 
  308 mapDVarSet :: Uniquable b => (a -> b) -> UniqDSet a -> UniqDSet b
  309 mapDVarSet = mapUniqDSet
  310 
  311 filterDVarSet :: (Var -> Bool) -> DVarSet -> DVarSet
  312 filterDVarSet = filterUniqDSet
  313 
  314 sizeDVarSet :: DVarSet -> Int
  315 sizeDVarSet = sizeUniqDSet
  316 
  317 -- | Partition DVarSet according to the predicate given
  318 partitionDVarSet :: (Var -> Bool) -> DVarSet -> (DVarSet, DVarSet)
  319 partitionDVarSet = partitionUniqDSet
  320 
  321 -- | Delete a list of variables from DVarSet
  322 delDVarSetList :: DVarSet -> [Var] -> DVarSet
  323 delDVarSetList = delListFromUniqDSet
  324 
  325 seqDVarSet :: DVarSet -> ()
  326 seqDVarSet s = sizeDVarSet s `seq` ()
  327 
  328 -- | Add a list of variables to DVarSet
  329 extendDVarSetList :: DVarSet -> [Var] -> DVarSet
  330 extendDVarSetList = addListToUniqDSet
  331 
  332 -- | Convert a DVarSet to a VarSet by forgetting the order of insertion
  333 dVarSetToVarSet :: DVarSet -> VarSet
  334 dVarSetToVarSet = unsafeUFMToUniqSet . udfmToUfm . getUniqDSet
  335 
  336 -- | transCloVarSet for DVarSet
  337 transCloDVarSet :: (DVarSet -> DVarSet)
  338                   -- Map some variables in the set to
  339                   -- extra variables that should be in it
  340                 -> DVarSet -> DVarSet
  341 -- (transCloDVarSet f s) repeatedly applies f to new candidates, adding any
  342 -- new variables to s that it finds thereby, until it reaches a fixed point.
  343 --
  344 -- The function fn could be (Var -> DVarSet), but we use (DVarSet -> DVarSet)
  345 -- for efficiency, so that the test can be batched up.
  346 -- It's essential that fn will work fine if given new candidates
  347 -- one at a time; ie  fn {v1,v2} = fn v1 `union` fn v2
  348 transCloDVarSet fn seeds
  349   = go seeds seeds
  350   where
  351     go :: DVarSet  -- Accumulating result
  352        -> DVarSet  -- Work-list; un-processed subset of accumulating result
  353        -> DVarSet
  354     -- Specification: go acc vs = acc `union` transClo fn vs
  355 
  356     go acc candidates
  357        | isEmptyDVarSet new_vs = acc
  358        | otherwise            = go (acc `unionDVarSet` new_vs) new_vs
  359        where
  360          new_vs = fn candidates `minusDVarSet` acc