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