X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FNameSet.lhs;h=d0e55dec687b00c86b40a0181f9ede47568c74f3;hb=2f0d9b271c16303f1f7f97b35df721fbbebd1cae;hp=e75d3cd2ccfd5f4c2aef8b07f2f448a7c94929dc;hpb=84ed91abfe3f9df43d5b33e404138e43a574beb8;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/NameSet.lhs b/ghc/compiler/basicTypes/NameSet.lhs
index e75d3cd..d0e55de 100644
--- a/ghc/compiler/basicTypes/NameSet.lhs
+++ b/ghc/compiler/basicTypes/NameSet.lhs
@@ -19,7 +19,7 @@ module NameSet (
 	-- Defs and uses
 	Defs, Uses, DefUse, DefUses,
 	emptyDUs, usesOnly, mkDUs, plusDU, 
-	findUses, duDefs, duUses
+	findUses, duDefs, duUses, allUses
     ) where
 
 #include "HsVersions.h"
@@ -120,9 +120,10 @@ delFVs ns s = delListFromNameSet s ns
 type Defs = NameSet
 type Uses = NameSet
 
-type DefUse  = (Maybe Defs, Uses)
 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
 	--
@@ -144,9 +145,23 @@ mkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]
 plusDU :: DefUses -> DefUses -> DefUses
 plusDU = (++)
 
-allUses :: DefUses -> Uses -> Uses
--- Collect all uses, removing defs
-allUses dus uses
+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
@@ -158,27 +173,18 @@ findUses :: DefUses -> Uses -> Uses
 -- find all the uses, transitively. 
 -- The result is a superset of the input uses;
 -- and includes things defined in the input DefUses
--- (if they are used, of course)
+-- (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
+	| 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
-
-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
--- Defs are not eliminated
-duUses dus = foldr get emptyNameSet dus
-  where
-    get (d1, u1) u2 = u1 `unionNameSets` u2
 \end{code}
\ No newline at end of file