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 type DefUses = [DefUse]
 158
 159 emptyDUs :: DefUses
 160 emptyDUs = []
 161
 162 usesOnly :: Uses -> DefUses
 163 usesOnly uses = [(Nothing, uses)]
 164
 165 mkDUs :: [(Defs,Uses)] -> DefUses
 166 mkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]
 167
 168 plusDU :: DefUses -> DefUses -> DefUses
 169 plusDU = (++)
 170
 171 duDefs :: DefUses -> Defs
 172 duDefs dus = foldr get emptyNameSet dus
 173   where
 174     get (Nothing, _u1) d2 = d2
 175     get (Just d1, _u1) d2 = d1 `unionNameSets` d2
 176
 177 duUses :: DefUses -> Uses
 178 -- ^ Just like 'allUses', but 'Defs' are not eliminated from the 'Uses' returned
 179 duUses dus = foldr get emptyNameSet dus
 180   where
 181     get (_d1, u1) u2 = u1 `unionNameSets` u2
 182
 183 allUses :: DefUses -> Uses
 184 -- ^ Collect all 'Uses', regardless of whether the group is itself used,
 185 -- but remove 'Defs' on the way
 186 allUses dus
 187   = foldr get emptyNameSet dus
 188   where
 189     get (Nothing,   rhs_uses) uses = rhs_uses `unionNameSets` uses
 190     get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSets` uses)
 191                                      `minusNameSet` defs
 192
 193 findUses :: DefUses -> Uses -> Uses
 194 -- ^ Given some 'DefUses' and some 'Uses', find all the uses, transitively.
 195 -- The result is a superset of the input 'Uses'; and includes things defined
 196 -- in the input 'DefUses' (but only if they are used)
 197 findUses dus uses
 198   = foldr get uses dus
 199   where
 200     get (Nothing, rhs_uses) uses
 201         = rhs_uses `unionNameSets` uses
 202     get (Just defs, rhs_uses) uses
 203         | defs `intersectsNameSet` uses         -- Used
 204         || any (startsWithUnderscore . nameOccName) (nameSetToList defs)
 205                 -- At least one starts with an "_",
 206                 -- so treat the group as used
 207         = rhs_uses `unionNameSets` uses
 208         | otherwise     -- No def is used
 209         = uses
 210 \end{code}