X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FNameSet.lhs;h=bef9e928fda04721e208bb05be703a18c0398a21;hp=46bcee72ab7836b764e1b353ea5749b17df5e608;hb=b2bd63f99d643f6b3eb30bb72bb9ae26d4183252;hpb=46f02d59813499ba2aa44e7831e0b69ec6d8f25d

diff --git a/compiler/basicTypes/NameSet.lhs b/compiler/basicTypes/NameSet.lhs
index 46bcee7..bef9e92 100644
--- a/compiler/basicTypes/NameSet.lhs
+++ b/compiler/basicTypes/NameSet.lhs
@@ -30,9 +30,13 @@ module NameSet (
     ) where
 
 #include "HsVersions.h"
+#include "Typeable.h"
 
 import Name
 import UniqSet
+import Util
+
+import Data.Data
 \end{code}
 
 %************************************************************************
@@ -44,6 +48,19 @@ import UniqSet
 \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
@@ -142,6 +159,7 @@ type Uses = NameSet
 type DefUse  = (Maybe Defs, Uses)
 
 -- | 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
@@ -162,17 +180,16 @@ duDefs dus = foldr get emptyNameSet dus
     get (Nothing, _u1) d2 = d2
     get (Just d1, _u1) d2 = d1 `unionNameSets` d2
 
-duUses :: DefUses -> Uses
--- ^ Just like 'allUses', but 'Defs' are not eliminated from the 'Uses' returned
-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
 
-allUses :: DefUses -> Uses
+duUses :: 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 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)