X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FNameSet.lhs;h=e2acaf7109da17b6da550f3dc3bc6967e8d5432c;hb=5e54b553bbb112167412ee9164135d56b06f5721;hp=46bcee72ab7836b764e1b353ea5749b17df5e608;hpb=46f02d59813499ba2aa44e7831e0b69ec6d8f25d;p=ghc-hetmet.git diff --git a/compiler/basicTypes/NameSet.lhs b/compiler/basicTypes/NameSet.lhs index 46bcee7..e2acaf7 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,14 @@ import UniqSet \begin{code} type NameSet = UniqSet Name +INSTANCE_TYPEABLE0(NameSet,nameSetTc,"NameSet") + +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 +154,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,16 +175,16 @@ duDefs dus = foldr get emptyNameSet dus get (Nothing, _u1) d2 = d2 get (Just d1, _u1) d2 = d1 `unionNameSets` d2 -duUses :: DefUses -> Uses +allUses :: DefUses -> Uses -- ^ Just like 'allUses', but 'Defs' are not eliminated from the 'Uses' returned -duUses dus = foldr get emptyNameSet dus +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 +duUses dus = foldr get emptyNameSet dus where get (Nothing, rhs_uses) uses = rhs_uses `unionNameSets` uses