[project @ 2003-06-03 09:41:48 by ross]
[ghc-hetmet.git] / ghc / compiler / utils / UniqSet.lhs
index 3adc33b..129e333 100644 (file)
@@ -1,57 +1,33 @@
 %
-% (c) The AQUA Project, Glasgow University, 1994-1995
+% (c) The AQUA Project, Glasgow University, 1994-1998
 %
 \section[UniqSet]{Specialised sets, for things with @Uniques@}
 
 Based on @UniqFMs@ (as you would expect).
 
-Basically, the things need to be in class @NamedThing@.
-
-We also export specialisations for @Ids@ and @TyVars@.
+Basically, the things need to be in class @Uniquable@.
 
 \begin{code}
-#include "HsVersions.h"
-
 module UniqSet (
-       UniqSet(..),    -- abstract type: NOT
+       UniqSet,    -- abstract type: NOT
 
-       mkUniqSet, uniqSetToList, emptyUniqSet, singletonUniqSet,
+       mkUniqSet, uniqSetToList, emptyUniqSet, unitUniqSet,
+       addOneToUniqSet, addListToUniqSet, delOneFromUniqSet, delListFromUniqSet,
        unionUniqSets, unionManyUniqSets, minusUniqSet,
-       elementOfUniqSet, mapUniqSet,
-       intersectUniqSets, isEmptyUniqSet,
-       
-       -- specalised for Ids:
-       IdSet(..),
-
-       -- specalised for TyVars:
-       TyVarSet(..),
-
-       -- specalised for Names:
-       NameSet(..),
-
-       -- to make the interface self-sufficient
-       Id, TyVar, Name,
+       elementOfUniqSet, mapUniqSet, intersectUniqSets,
+       isEmptyUniqSet, filterUniqSet, sizeUniqSet, foldUniqSet,
+       elemUniqSet_Directly, lookupUniqSet, hashUniqSet
+    ) where
 
-       UniqFM, Unique
+#include "HsVersions.h"
 
-       -- and to be pragma friendly
-#ifdef USE_ATTACK_PRAGMAS
-       , emptyUFM, intersectUFM, isNullUFM, minusUFM, singletonUFM,
-       plusUFM, eltsUFM,
-       u2i
-#endif
-    ) where
+import {-# SOURCE #-} Name ( Name )
 
+import Maybes          ( maybeToBool )
 import UniqFM
-import Id              -- for specialisation to Ids
-import IdInfo          -- sigh
-import Maybes          ( maybeToBool, Maybe(..) )
-import Name
-import Outputable
-import AbsUniType      -- for specialisation to TyVars
-import Util
+import Unique          ( Unique, Uniquable(..) )
+
 #if ! OMIT_NATIVE_CODEGEN
-import AsmRegAlloc     ( Reg )
 #define IF_NCG(a) a
 #else
 #define IF_NCG(a) {--}
@@ -64,7 +40,7 @@ import AsmRegAlloc    ( Reg )
 %*                                                                     *
 %************************************************************************
 
-We use @UniqFM@, with a (@getTheUnique@-able) @Unique@ as ``key''
+We use @UniqFM@, with a (@getUnique@-able) @Unique@ as ``key''
 and the thing itself as the ``value'' (for later retrieval).
 
 \begin{code}
@@ -76,15 +52,30 @@ type UniqSet a = UniqFM a
 emptyUniqSet :: UniqSet a
 emptyUniqSet = MkUniqSet emptyUFM
 
-singletonUniqSet :: NamedThing a => a -> UniqSet a
-singletonUniqSet x = MkUniqSet (singletonUFM x x)
+unitUniqSet :: Uniquable a => a -> UniqSet a
+unitUniqSet x = MkUniqSet (unitUFM x x)
 
 uniqSetToList :: UniqSet a -> [a]
-uniqSetToList (MkUniqSet set) = BSCC("uniqSetToList") eltsUFM set ESCC
+uniqSetToList (MkUniqSet set) = eltsUFM set
+
+foldUniqSet :: (a -> b -> b) -> b -> UniqSet a -> b
+foldUniqSet k z (MkUniqSet set) = foldUFM k z set 
 
-mkUniqSet :: NamedThing a => [a]  -> UniqSet a
+mkUniqSet :: Uniquable a => [a]  -> UniqSet a
 mkUniqSet xs = MkUniqSet (listToUFM [ (x, x) | x <- xs])
 
+addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
+addOneToUniqSet (MkUniqSet set) x = MkUniqSet (addToUFM set x x)
+
+delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
+delOneFromUniqSet (MkUniqSet set) x = MkUniqSet (delFromUFM set x)
+
+delListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
+delListFromUniqSet (MkUniqSet set) xs = MkUniqSet (delListFromUFM set xs)
+
+addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
+addListToUniqSet (MkUniqSet set) xs = MkUniqSet (addListToUFM set [(x,x) | x<-xs])
+
 unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
 unionUniqSets (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (plusUFM set1 set2)
 
@@ -97,68 +88,51 @@ unionManyUniqSets (s:ss) = s `unionUniqSets` unionManyUniqSets ss
 minusUniqSet  :: UniqSet a -> UniqSet a -> UniqSet a
 minusUniqSet (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (minusUFM set1 set2)
 
+filterUniqSet :: (a -> Bool) -> UniqSet a -> UniqSet a
+filterUniqSet pred (MkUniqSet set) = MkUniqSet (filterUFM pred set)
+
 intersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
 intersectUniqSets (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (intersectUFM set1 set2)
 
-elementOfUniqSet :: NamedThing a => a -> UniqSet a -> Bool
+elementOfUniqSet :: Uniquable a => a -> UniqSet a -> Bool
 elementOfUniqSet x (MkUniqSet set) = maybeToBool (lookupUFM set x)
 
+lookupUniqSet :: Uniquable a => UniqSet a -> a -> Maybe a
+lookupUniqSet (MkUniqSet set) x = lookupUFM set x
+
+elemUniqSet_Directly :: Unique -> UniqSet a -> Bool
+elemUniqSet_Directly x (MkUniqSet set) = maybeToBool (lookupUFM_Directly set x)
+
+sizeUniqSet :: UniqSet a -> Int
+sizeUniqSet (MkUniqSet set) = sizeUFM set
+
+hashUniqSet :: UniqSet a -> Int
+hashUniqSet (MkUniqSet set) = hashUFM set
+
 isEmptyUniqSet :: UniqSet a -> Bool
 isEmptyUniqSet (MkUniqSet set) = isNullUFM set {-SLOW: sizeUFM set == 0-}
 
-mapUniqSet :: NamedThing b => (a -> b) -> UniqSet a -> UniqSet b
-mapUniqSet f (MkUniqSet set)
-  = MkUniqSet (listToUFM [ let
-                            mapped_thing = f thing
-                         in
-                         (mapped_thing, mapped_thing)
-                       | thing <- eltsUFM set ])
+mapUniqSet :: (a -> a) -> UniqSet a -> UniqSet a
+  -- VERY IMPORTANT: *assumes* that the function doesn't change the unique
+mapUniqSet f (MkUniqSet set) = MkUniqSet (mapUFM f set)
 \end{code}
 
-%************************************************************************
-%*                                                                     *
-\subsection{The @IdSet@ and @TyVarSet@ specialisations for sets of Ids/TyVars}
-%*                                                                     *
-%************************************************************************
-
-@IdSet@ is a specialised version, optimised for sets of Ids.
-
 \begin{code}
-type IdSet    = UniqSet Id
-type TyVarSet = UniqSet TyVar
-type NameSet  = UniqSet Name
-#if ! OMIT_NATIVE_CODEGEN
-type RegSet   = UniqSet Reg
-#endif
-
 #if __GLASGOW_HASKELL__
-    -- avoid hbc bug (0.999.7)
-{-# SPECIALIZE
-    singletonUniqSet :: Id    -> IdSet,
-                       TyVar -> TyVarSet,
-                       Name  -> NameSet
-    IF_NCG(COMMA       Reg   -> RegSet)
-    #-}
-
-{-# SPECIALIZE
-    mkUniqSet :: [Id]    -> IdSet,
-                [TyVar] -> TyVarSet,
-                [Name]  -> NameSet
-    IF_NCG(COMMA [Reg]   -> RegSet)
-    #-}
-
-{-# SPECIALIZE
-    elementOfUniqSet :: Id    -> IdSet    -> Bool,
-                       TyVar -> TyVarSet -> Bool,
-                       Name  -> NameSet  -> Bool
-    IF_NCG(COMMA       Reg   -> RegSet   -> Bool)
-    #-}
-
 {-# SPECIALIZE
-    mapUniqSet :: (Id    -> Id)    -> IdSet    -> IdSet,
-                 (TyVar -> TyVar) -> TyVarSet -> TyVarSet,
-                 (Name  -> Name)  -> NameSet  -> NameSet
-    IF_NCG(COMMA  (Reg  -> Reg)    -> RegSet   -> RegSet)
+    addOneToUniqSet :: UniqSet Unique -> Unique -> UniqSet Unique
     #-}
+{- SPECIALIZE
+    elementOfUniqSet :: Name -> UniqSet Name -> Bool
+                     , Unique -> UniqSet Unique -> Bool
+    -}
+{- SPECIALIZE
+    mkUniqSet :: [Name] -> UniqSet Name
+    -}
+
+{- SPECIALIZE
+    unitUniqSet :: Name -> UniqSet Name
+                , Unique -> UniqSet Unique
+    -}
 #endif
 \end{code}