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