X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FNameSet.lhs;h=bef9e928fda04721e208bb05be703a18c0398a21;hp=c46127cbcaf641e39055b9859ad5fd506bf4c0cf;hb=c648345e3d82c0c40333bfd8ddea2633e21b08dc;hpb=f278f0676579f67075033a4f9857715909c4b71e diff --git a/compiler/basicTypes/NameSet.lhs b/compiler/basicTypes/NameSet.lhs index c46127c..bef9e92 100644 --- a/compiler/basicTypes/NameSet.lhs +++ b/compiler/basicTypes/NameSet.lhs @@ -48,7 +48,12 @@ import Data.Data \begin{code} type NameSet = UniqSet Name -INSTANCE_TYPEABLE0(NameSet,nameSetTc,"NameSet") +-- 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 @@ -154,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 @@ -174,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)