compiler/basicTypes/NameSet.lhs

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