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