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