never executed always true always false
    1 {-
    2 (c) The University of Glasgow 2006
    3 (c) The GRASP/AQUA Project, Glasgow University, 1998
    4 -}
    5 
    6 
    7 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    8 module GHC.Types.Name.Set (
    9         -- * Names set type
   10         NameSet,
   11 
   12         -- ** Manipulating these sets
   13         emptyNameSet, unitNameSet, mkNameSet, unionNameSet, unionNameSets,
   14         minusNameSet, elemNameSet, extendNameSet, extendNameSetList,
   15         delFromNameSet, delListFromNameSet, isEmptyNameSet, filterNameSet,
   16         intersectsNameSet, disjointNameSet, intersectNameSet,
   17         nameSetAny, nameSetAll, nameSetElemsStable,
   18 
   19         -- * Free variables
   20         FreeVars,
   21 
   22         -- ** Manipulating sets of free variables
   23         isEmptyFVs, emptyFVs, plusFVs, plusFV,
   24         mkFVs, addOneFV, unitFV, delFV, delFVs,
   25         intersectFVs,
   26 
   27         -- * Defs and uses
   28         Defs, Uses, DefUse, DefUses,
   29 
   30         -- ** Manipulating defs and uses
   31         emptyDUs, usesOnly, mkDUs, plusDU,
   32         findUses, duDefs, duUses, allUses,
   33 
   34         -- * Non-CAFfy names
   35         NonCaffySet(..)
   36     ) where
   37 
   38 import GHC.Prelude
   39 
   40 import GHC.Types.Name
   41 import GHC.Data.OrdList
   42 import GHC.Types.Unique.Set
   43 import Data.List (sortBy)
   44 
   45 {-
   46 ************************************************************************
   47 *                                                                      *
   48 \subsection[Sets of names}
   49 *                                                                      *
   50 ************************************************************************
   51 -}
   52 
   53 type NameSet = UniqSet Name
   54 
   55 emptyNameSet       :: NameSet
   56 unitNameSet        :: Name -> NameSet
   57 extendNameSetList   :: NameSet -> [Name] -> NameSet
   58 extendNameSet    :: NameSet -> Name -> NameSet
   59 mkNameSet          :: [Name] -> NameSet
   60 unionNameSet      :: NameSet -> NameSet -> NameSet
   61 unionNameSets  :: [NameSet] -> NameSet
   62 minusNameSet       :: NameSet -> NameSet -> NameSet
   63 elemNameSet        :: Name -> NameSet -> Bool
   64 isEmptyNameSet     :: NameSet -> Bool
   65 delFromNameSet     :: NameSet -> Name -> NameSet
   66 delListFromNameSet :: NameSet -> [Name] -> NameSet
   67 filterNameSet      :: (Name -> Bool) -> NameSet -> NameSet
   68 intersectNameSet   :: NameSet -> NameSet -> NameSet
   69 intersectsNameSet  :: NameSet -> NameSet -> Bool
   70 disjointNameSet    :: NameSet -> NameSet -> Bool
   71 -- ^ True if there is a non-empty intersection.
   72 -- @s1 `intersectsNameSet` s2@ doesn't compute @s2@ if @s1@ is empty
   73 
   74 isEmptyNameSet    = isEmptyUniqSet
   75 emptyNameSet      = emptyUniqSet
   76 unitNameSet       = unitUniqSet
   77 mkNameSet         = mkUniqSet
   78 extendNameSetList  = addListToUniqSet
   79 extendNameSet   = addOneToUniqSet
   80 unionNameSet     = unionUniqSets
   81 unionNameSets = unionManyUniqSets
   82 minusNameSet      = minusUniqSet
   83 elemNameSet       = elementOfUniqSet
   84 delFromNameSet    = delOneFromUniqSet
   85 filterNameSet     = filterUniqSet
   86 intersectNameSet  = intersectUniqSets
   87 disjointNameSet   = disjointUniqSets
   88 
   89 delListFromNameSet set ns = foldl' delFromNameSet set ns
   90 
   91 intersectsNameSet s1 s2 = not (s1 `disjointNameSet` s2)
   92 
   93 nameSetAny :: (Name -> Bool) -> NameSet -> Bool
   94 nameSetAny = uniqSetAny
   95 
   96 nameSetAll :: (Name -> Bool) -> NameSet -> Bool
   97 nameSetAll = uniqSetAll
   98 
   99 -- | Get the elements of a NameSet with some stable ordering.
  100 -- This only works for Names that originate in the source code or have been
  101 -- tidied.
  102 -- See Note [Deterministic UniqFM] to learn about nondeterminism
  103 nameSetElemsStable :: NameSet -> [Name]
  104 nameSetElemsStable ns =
  105   sortBy stableNameCmp $ nonDetEltsUniqSet ns
  106   -- It's OK to use nonDetEltsUniqSet here because we immediately sort
  107   -- with stableNameCmp
  108 
  109 {-
  110 ************************************************************************
  111 *                                                                      *
  112 \subsection{Free variables}
  113 *                                                                      *
  114 ************************************************************************
  115 
  116 These synonyms are useful when we are thinking of free variables
  117 -}
  118 
  119 type FreeVars   = NameSet
  120 
  121 plusFV   :: FreeVars -> FreeVars -> FreeVars
  122 addOneFV :: FreeVars -> Name -> FreeVars
  123 unitFV   :: Name -> FreeVars
  124 emptyFVs :: FreeVars
  125 plusFVs  :: [FreeVars] -> FreeVars
  126 mkFVs    :: [Name] -> FreeVars
  127 delFV    :: Name -> FreeVars -> FreeVars
  128 delFVs   :: [Name] -> FreeVars -> FreeVars
  129 intersectFVs :: FreeVars -> FreeVars -> FreeVars
  130 
  131 isEmptyFVs :: NameSet -> Bool
  132 isEmptyFVs  = isEmptyNameSet
  133 emptyFVs    = emptyNameSet
  134 plusFVs     = unionNameSets
  135 plusFV      = unionNameSet
  136 mkFVs       = mkNameSet
  137 addOneFV    = extendNameSet
  138 unitFV      = unitNameSet
  139 delFV n s   = delFromNameSet s n
  140 delFVs ns s = delListFromNameSet s ns
  141 intersectFVs = intersectNameSet
  142 
  143 {-
  144 ************************************************************************
  145 *                                                                      *
  146                 Defs and uses
  147 *                                                                      *
  148 ************************************************************************
  149 -}
  150 
  151 -- | A set of names that are defined somewhere
  152 type Defs = NameSet
  153 
  154 -- | A set of names that are used somewhere
  155 type Uses = NameSet
  156 
  157 -- | @(Just ds, us) =>@ The use of any member of the @ds@
  158 --                      implies that all the @us@ are used too.
  159 --                      Also, @us@ may mention @ds@.
  160 --
  161 -- @Nothing =>@ Nothing is defined in this group, but
  162 --              nevertheless all the uses are essential.
  163 --              Used for instance declarations, for example
  164 type DefUse  = (Maybe Defs, Uses)
  165 
  166 -- | A number of 'DefUse's in dependency order: earlier 'Defs' scope over later 'Uses'
  167 --   In a single (def, use) pair, the defs also scope over the uses
  168 type DefUses = OrdList DefUse
  169 
  170 emptyDUs :: DefUses
  171 emptyDUs = nilOL
  172 
  173 usesOnly :: Uses -> DefUses
  174 usesOnly uses = unitOL (Nothing, uses)
  175 
  176 mkDUs :: [(Defs,Uses)] -> DefUses
  177 mkDUs pairs = toOL [(Just defs, uses) | (defs,uses) <- pairs]
  178 
  179 plusDU :: DefUses -> DefUses -> DefUses
  180 plusDU = appOL
  181 
  182 duDefs :: DefUses -> Defs
  183 duDefs dus = foldr get emptyNameSet dus
  184   where
  185     get (Nothing, _u1) d2 = d2
  186     get (Just d1, _u1) d2 = d1 `unionNameSet` d2
  187 
  188 allUses :: DefUses -> Uses
  189 -- ^ Just like 'duUses', but 'Defs' are not eliminated from the 'Uses' returned
  190 allUses dus = foldr get emptyNameSet dus
  191   where
  192     get (_d1, u1) u2 = u1 `unionNameSet` u2
  193 
  194 duUses :: DefUses -> Uses
  195 -- ^ Collect all 'Uses', regardless of whether the group is itself used,
  196 -- but remove 'Defs' on the way
  197 duUses dus = foldr get emptyNameSet dus
  198   where
  199     get (Nothing,   rhs_uses) uses = rhs_uses `unionNameSet` uses
  200     get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSet` uses)
  201                                      `minusNameSet` defs
  202 
  203 findUses :: DefUses -> Uses -> Uses
  204 -- ^ Given some 'DefUses' and some 'Uses', find all the uses, transitively.
  205 -- The result is a superset of the input 'Uses'; and includes things defined
  206 -- in the input 'DefUses' (but only if they are used)
  207 findUses dus uses
  208   = foldr get uses dus
  209   where
  210     get (Nothing, rhs_uses) uses
  211         = rhs_uses `unionNameSet` uses
  212     get (Just defs, rhs_uses) uses
  213         | defs `intersectsNameSet` uses         -- Used
  214         || nameSetAny (startsWithUnderscore . nameOccName) defs
  215                 -- At least one starts with an "_",
  216                 -- so treat the group as used
  217         = rhs_uses `unionNameSet` uses
  218         | otherwise     -- No def is used
  219         = uses
  220 
  221 -- | 'Id's which have no CAF references. This is a result of analysis of C--.
  222 -- It is always safe to use an empty 'NonCaffySet'. TODO Refer to Note.
  223 newtype NonCaffySet = NonCaffySet NameSet
  224   deriving (Semigroup, Monoid)