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