X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FNameSet.lhs;h=d0e55dec687b00c86b40a0181f9ede47568c74f3;hb=07806d2b66986825ff7c5cd51240f920d91ee2f9;hp=0e2b1375463314738f588cbd4f11828d856bf1c0;hpb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/NameSet.lhs b/ghc/compiler/basicTypes/NameSet.lhs
index 0e2b137..d0e55de 100644
--- a/ghc/compiler/basicTypes/NameSet.lhs
+++ b/ghc/compiler/basicTypes/NameSet.lhs
@@ -8,7 +8,18 @@ module NameSet (
 	-- Sets of Names
 	NameSet,
 	emptyNameSet, unitNameSet, mkNameSet, unionNameSets, unionManyNameSets,
-	minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet, isEmptyNameSet,
+	minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet, 
+	delFromNameSet, delListFromNameSet, isEmptyNameSet, foldNameSet, filterNameSet,
+	intersectsNameSet, intersectNameSet,
+	
+	-- Free variables
+	FreeVars, isEmptyFVs, emptyFVs, plusFVs, plusFV, 
+	mkFVs, addOneFV, unitFV, delFV, delFVs,
+
+	-- Defs and uses
+	Defs, Uses, DefUse, DefUses,
+	emptyDUs, usesOnly, mkDUs, plusDU, 
+	findUses, duDefs, duUses, allUses
     ) where
 
 #include "HsVersions.h"
@@ -26,17 +37,24 @@ import UniqSet
 
 \begin{code}
 type NameSet = UniqSet Name
-emptyNameSet	  :: NameSet
-unitNameSet	  :: Name -> NameSet
-addListToNameSet  :: NameSet -> [Name] -> NameSet
-addOneToNameSet   :: NameSet -> Name -> NameSet
-mkNameSet         :: [Name] -> NameSet
-unionNameSets	  :: NameSet -> NameSet -> NameSet
-unionManyNameSets :: [NameSet] -> NameSet
-minusNameSet 	  :: NameSet -> NameSet -> NameSet
-elemNameSet	  :: Name -> NameSet -> Bool
-nameSetToList	  :: NameSet -> [Name]
-isEmptyNameSet	  :: NameSet -> Bool
+emptyNameSet	   :: NameSet
+unitNameSet	   :: Name -> NameSet
+addListToNameSet   :: NameSet -> [Name] -> NameSet
+addOneToNameSet    :: NameSet -> Name -> NameSet
+mkNameSet          :: [Name] -> NameSet
+unionNameSets	   :: NameSet -> NameSet -> NameSet
+unionManyNameSets  :: [NameSet] -> NameSet
+minusNameSet 	   :: NameSet -> NameSet -> NameSet
+elemNameSet	   :: Name -> NameSet -> Bool
+nameSetToList	   :: NameSet -> [Name]
+isEmptyNameSet	   :: NameSet -> Bool
+delFromNameSet	   :: NameSet -> Name -> NameSet
+delListFromNameSet :: 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 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty
 
 isEmptyNameSet    = isEmptyUniqSet
 emptyNameSet	  = emptyUniqSet
@@ -49,6 +67,124 @@ unionManyNameSets = unionManyUniqSets
 minusNameSet	  = minusUniqSet
 elemNameSet       = elementOfUniqSet
 nameSetToList     = uniqSetToList
+delFromNameSet    = delOneFromUniqSet
+foldNameSet	  = foldUniqSet
+filterNameSet	  = filterUniqSet
+intersectNameSet  = intersectUniqSets
+
+delListFromNameSet set ns = foldl delFromNameSet set ns
+
+intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Free variables}
+%*									*
+%************************************************************************
+
+These synonyms are useful when we are thinking of free variables
+
+\begin{code}
+type FreeVars	= NameSet
+
+plusFV   :: FreeVars -> FreeVars -> FreeVars
+addOneFV :: FreeVars -> Name -> FreeVars
+unitFV   :: Name -> FreeVars
+emptyFVs :: FreeVars
+plusFVs  :: [FreeVars] -> FreeVars
+mkFVs	 :: [Name] -> FreeVars
+delFV    :: Name -> FreeVars -> FreeVars
+delFVs   :: [Name] -> FreeVars -> FreeVars
+
+isEmptyFVs  = isEmptyNameSet
+emptyFVs    = emptyNameSet
+plusFVs     = unionManyNameSets
+plusFV      = unionNameSets
+mkFVs	    = mkNameSet
+addOneFV    = addOneToNameSet
+unitFV      = unitNameSet
+delFV n s   = delFromNameSet s n
+delFVs ns s = delListFromNameSet s ns
 \end{code}
 
 
+%************************************************************************
+%*									*
+		Defs and uses
+%*									*
+%************************************************************************
+
+\begin{code}
+type Defs = NameSet
+type Uses = NameSet
+
+type DefUses = [DefUse]
+	-- In dependency order: earlier Defs scope over later Uses
+
+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
+
+emptyDUs :: DefUses
+emptyDUs = []
+
+usesOnly :: Uses -> DefUses
+usesOnly uses = [(Nothing, uses)]
+
+mkDUs :: [(Defs,Uses)] -> DefUses
+mkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]
+
+plusDU :: DefUses -> DefUses -> DefUses
+plusDU = (++)
+
+duDefs :: DefUses -> Defs
+duDefs dus = foldr get emptyNameSet dus
+  where
+    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
+  where
+    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
+  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)
+findUses dus uses 
+  = foldr get uses dus
+  where
+    get (Nothing, rhs_uses) uses
+	= rhs_uses `unionNameSets` uses
+    get (Just defs, rhs_uses) uses
+	| defs `intersectsNameSet` uses 	-- Used
+	|| not (all (reportIfUnused . nameOccName) (nameSetToList defs))
+		-- At least one starts with an "_", 
+		-- so treat the group as used
+	= rhs_uses `unionNameSets` uses
+	| otherwise	-- No def is used
+	= uses
+\end{code}
\ No newline at end of file