compiler/basicTypes/NameSet.lhs

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