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