Enable shortcutting of stack squeezing

[ghc-hetmet.git] / ghc / compiler / basicTypes / NameSet.lhs

diff --git a/ghc/compiler/basicTypes/NameSet.lhs b/ghc/compiler/basicTypes/NameSet.lhs
index 305e80d..d0e55de 100644 (file)
--- a/ghc/compiler/basicTypes/NameSet.lhs
+++ b/ghc/compiler/basicTypes/NameSet.lhs
@@ -145,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
@@ -159,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