%
\begin{code}
-{-# OPTIONS_GHC -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
--- for details
-
module NameSet (
- -- Sets of Names
+ -- * Names set type
NameSet,
+
+ -- ** Manipulating these sets
emptyNameSet, unitNameSet, mkNameSet, unionNameSets, unionManyNameSets,
minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet,
delFromNameSet, delListFromNameSet, isEmptyNameSet, foldNameSet, filterNameSet,
intersectsNameSet, intersectNameSet,
- -- Free variables
- FreeVars, isEmptyFVs, emptyFVs, plusFVs, plusFV,
+ -- * Free variables
+ FreeVars,
+
+ -- ** Manipulating sets of free variables
+ isEmptyFVs, emptyFVs, plusFVs, plusFV,
mkFVs, addOneFV, unitFV, delFV, delFVs,
- -- Defs and uses
+ -- * Defs and uses
Defs, Uses, DefUse, DefUses,
+
+ -- ** Manipulating defs and uses
emptyDUs, usesOnly, mkDUs, plusDU,
findUses, duDefs, duUses, allUses
) where
#include "HsVersions.h"
+#include "Typeable.h"
import Name
import UniqSet
+import Util
+
+import Data.Data
\end{code}
%************************************************************************
\begin{code}
type NameSet = UniqSet Name
+
+-- TODO: These Data/Typeable instances look very dubious. Surely either
+-- UniqFM should have the instances, or this should be a newtype?
+
+nameSetTc :: TyCon
+nameSetTc = mkTyCon "NameSet"
+instance Typeable NameSet where { typeOf _ = mkTyConApp nameSetTc [] }
+
+instance Data NameSet where
+ gfoldl k z s = z mkNameSet `k` nameSetToList s -- traverse abstractly
+ toConstr _ = abstractConstr "NameSet"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "NameSet"
+
emptyNameSet :: NameSet
unitNameSet :: Name -> NameSet
addListToNameSet :: NameSet -> [Name] -> NameSet
foldNameSet :: (Name -> b -> b) -> b -> NameSet -> b
filterNameSet :: (Name -> Bool) -> NameSet -> NameSet
intersectNameSet :: NameSet -> NameSet -> NameSet
-intersectsNameSet :: NameSet -> NameSet -> Bool -- True if non-empty intersection
- -- (s1 `intersectsNameSet` s2) doesn't compute s2 if s1 is empty
+intersectsNameSet :: NameSet -> NameSet -> Bool
+-- ^ True if there is a non-empty intersection.
+-- @s1 `intersectsNameSet` s2@ doesn't compute @s2@ if @s1@ is empty
isEmptyNameSet = isEmptyUniqSet
emptyNameSet = emptyUniqSet
delFV :: Name -> FreeVars -> FreeVars
delFVs :: [Name] -> FreeVars -> FreeVars
+isEmptyFVs :: NameSet -> Bool
isEmptyFVs = isEmptyNameSet
emptyFVs = emptyNameSet
plusFVs = unionManyNameSets
%************************************************************************
\begin{code}
+-- | A set of names that are defined somewhere
type Defs = NameSet
-type Uses = NameSet
-type DefUses = [DefUse]
- -- In dependency order: earlier Defs scope over later Uses
+-- | A set of names that are used somewhere
+type Uses = NameSet
+-- | @(Just ds, us) =>@ The use of any member of the @ds@
+-- implies that all the @us@ are used too.
+-- Also, @us@ may mention @ds@.
+--
+-- @Nothing =>@ Nothing is defined in this group, but
+-- nevertheless all the uses are essential.
+-- Used for instance declarations, for example
type DefUse = (Maybe Defs, Uses)
- -- For items (Just ds, us), the use of any member
- -- of the ds implies that all the us are used too
- --
- -- Also, us may mention ds
- --
- -- Nothing => Nothing defined in this group, but
- -- nevertheless all the uses are essential.
- -- Used for instance declarations, for example
+
+-- | A number of 'DefUse's in dependency order: earlier 'Defs' scope over later 'Uses'
+-- In a single (def, use) pair, the defs also scope over the uses
+type DefUses = [DefUse]
emptyDUs :: DefUses
emptyDUs = []
duDefs :: DefUses -> Defs
duDefs dus = foldr get emptyNameSet dus
where
- get (Nothing, u1) d2 = d2
- get (Just d1, u1) d2 = d1 `unionNameSets` d2
+ get (Nothing, _u1) d2 = d2
+ get (Just d1, _u1) d2 = d1 `unionNameSets` d2
-duUses :: DefUses -> Uses
--- Just like allUses, but defs are not eliminated
-duUses dus = foldr get emptyNameSet dus
+allUses :: DefUses -> Uses
+-- ^ Just like 'duUses', but 'Defs' are not eliminated from the 'Uses' returned
+allUses dus = foldr get emptyNameSet dus
where
- get (d1, u1) u2 = u1 `unionNameSets` u2
+ get (_d1, u1) u2 = u1 `unionNameSets` u2
-allUses :: DefUses -> Uses
--- Collect all uses, regardless of
--- whether the group is itself used,
--- but remove defs on the way
-allUses dus
- = foldr get emptyNameSet dus
+duUses :: DefUses -> Uses
+-- ^ Collect all 'Uses', regardless of whether the group is itself used,
+-- but remove 'Defs' on the way
+duUses dus = foldr get emptyNameSet dus
where
get (Nothing, rhs_uses) uses = rhs_uses `unionNameSets` uses
get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSets` uses)
`minusNameSet` defs
findUses :: DefUses -> Uses -> Uses
--- Given some DefUses and some Uses,
--- find all the uses, transitively.
--- The result is a superset of the input uses;
--- and includes things defined in the input DefUses
--- (but only if they are used)
+-- ^ Given some 'DefUses' and some 'Uses', find all the uses, transitively.
+-- The result is a superset of the input 'Uses'; and includes things defined
+-- in the input 'DefUses' (but only if they are used)
findUses dus uses
= foldr get uses dus
where
= rhs_uses `unionNameSets` uses
get (Just defs, rhs_uses) uses
| defs `intersectsNameSet` uses -- Used
- || not (all (reportIfUnused . nameOccName) (nameSetToList defs))
+ || any (startsWithUnderscore . nameOccName) (nameSetToList defs)
-- At least one starts with an "_",
-- so treat the group as used
= rhs_uses `unionNameSets` uses
projects / ghc-hetmet.git / blobdiff