Remove very dead Java backend code.

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

diff --git a/compiler/basicTypes/NameSet.lhs b/compiler/basicTypes/NameSet.lhs
index 5c2c1b8..bef9e92 100644 (file)
--- a/compiler/basicTypes/NameSet.lhs
+++ b/compiler/basicTypes/NameSet.lhs
@@ -5,27 +5,38 @@
 
 \begin{code}
 module NameSet (
 
 \begin{code}
 module NameSet (

-       -- Sets of Names
+       -- * Names set type

        NameSet,
        NameSet,

+       
+       -- ** Manipulating these sets

        emptyNameSet, unitNameSet, mkNameSet, unionNameSets, unionManyNameSets,
        minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet, 
        delFromNameSet, delListFromNameSet, isEmptyNameSet, foldNameSet, filterNameSet,
        intersectsNameSet, intersectNameSet,
        
        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,
 
        mkFVs, addOneFV, unitFV, delFV, delFVs,
 

-       -- Defs and uses
+       -- * Defs and uses

        Defs, Uses, DefUse, DefUses,
        Defs, Uses, DefUse, DefUses,

+       
+       -- ** Manipulating defs and uses

        emptyDUs, usesOnly, mkDUs, plusDU, 
        findUses, duDefs, duUses, allUses
     ) where
 
 #include "HsVersions.h"
        emptyDUs, usesOnly, mkDUs, plusDU, 
        findUses, duDefs, duUses, allUses
     ) where
 
 #include "HsVersions.h"

+#include "Typeable.h"

 
 import Name
 import UniqSet
 
 import Name
 import UniqSet

+import Util
+
+import Data.Data

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -36,6 +47,20 @@ import UniqSet
 
 \begin{code}
 type NameSet = UniqSet Name
 
 \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
 emptyNameSet      :: NameSet
 unitNameSet       :: Name -> NameSet
 addListToNameSet   :: NameSet -> [Name] -> NameSet

@@ -52,8 +77,9 @@ delListFromNameSet :: NameSet -> [Name] -> NameSet
 foldNameSet       :: (Name -> b -> b) -> b -> NameSet -> b
 filterNameSet     :: (Name -> Bool) -> NameSet -> NameSet
 intersectNameSet   :: NameSet -> NameSet -> 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
 
 isEmptyNameSet    = isEmptyUniqSet
 emptyNameSet     = emptyUniqSet

@@ -97,6 +123,7 @@ mkFVs         :: [Name] -> FreeVars
 delFV    :: Name -> FreeVars -> FreeVars
 delFVs   :: [Name] -> FreeVars -> FreeVars
 
 delFV    :: Name -> FreeVars -> FreeVars
 delFVs   :: [Name] -> FreeVars -> FreeVars
 

+isEmptyFVs :: NameSet -> Bool

 isEmptyFVs  = isEmptyNameSet
 emptyFVs    = emptyNameSet
 plusFVs     = unionManyNameSets
 isEmptyFVs  = isEmptyNameSet
 emptyFVs    = emptyNameSet
 plusFVs     = unionManyNameSets

@@ -116,21 +143,24 @@ delFVs ns s = delListFromNameSet s ns
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

+-- | A set of names that are defined somewhere

 type Defs = NameSet
 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)
 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 = []
 
 emptyDUs :: DefUses
 emptyDUs = []

@@ -147,32 +177,28 @@ plusDU = (++)
 duDefs :: DefUses -> Defs
 duDefs dus = foldr get emptyNameSet dus
   where
 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
   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
   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
 findUses dus uses 
   = foldr get uses dus
   where

@@ -180,7 +206,7 @@ findUses dus uses
        = rhs_uses `unionNameSets` uses
     get (Just defs, rhs_uses) uses
        | defs `intersectsNameSet` uses         -- Used
        = 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
                -- At least one starts with an "_", 
                -- so treat the group as used
        = rhs_uses `unionNameSets` uses