X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FUniqSet.lhs;h=6d39e00e40b7f00d279b5c1d777122106f3b0c8b;hb=f4b727487a65e6b611bbaafbd2207bd63a8df706;hp=129e333eb5dfc76a804276bb3b3bfbb48a93723f;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/utils/UniqSet.lhs b/compiler/utils/UniqSet.lhs
index 129e333..6d39e00 100644
--- a/compiler/utils/UniqSet.lhs
+++ b/compiler/utils/UniqSet.lhs
@@ -1,4 +1,5 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The AQUA Project, Glasgow University, 1994-1998
 %
 \section[UniqSet]{Specialised sets, for things with @Uniques@}
@@ -9,23 +10,22 @@ Basically, the things need to be in class @Uniquable@.
 
 \begin{code}
 module UniqSet (
-	UniqSet,    -- abstract type: NOT
-
-	mkUniqSet, uniqSetToList, emptyUniqSet, unitUniqSet,
-	addOneToUniqSet, addListToUniqSet, delOneFromUniqSet, delListFromUniqSet,
-	unionUniqSets, unionManyUniqSets, minusUniqSet,
-	elementOfUniqSet, mapUniqSet, intersectUniqSets,
-	isEmptyUniqSet, filterUniqSet, sizeUniqSet, foldUniqSet,
-	elemUniqSet_Directly, lookupUniqSet, hashUniqSet
+        -- * Unique set type
+        UniqSet,    -- abstract type: NOT
+
+        -- ** Manipulating these sets
+        mkUniqSet, uniqSetToList, emptyUniqSet, unitUniqSet,
+        addOneToUniqSet, addListToUniqSet, addOneToUniqSet_C,
+        delOneFromUniqSet, delListFromUniqSet, delOneFromUniqSet_Directly,
+        unionUniqSets, unionManyUniqSets, minusUniqSet,
+        elementOfUniqSet, mapUniqSet, intersectUniqSets,
+        isEmptyUniqSet, filterUniqSet, sizeUniqSet, foldUniqSet,
+        elemUniqSet_Directly, lookupUniqSet, hashUniqSet
     ) where
 
-#include "HsVersions.h"
-
-import {-# SOURCE #-} Name ( Name )
-
-import Maybes		( maybeToBool )
+import Maybes
 import UniqFM
-import Unique		( Unique, Uniquable(..) )
+import Unique
 
 #if ! OMIT_NATIVE_CODEGEN
 #define IF_NCG(a) a
@@ -35,9 +35,9 @@ import Unique		( Unique, Uniquable(..) )
 \end{code}
 
 %************************************************************************
-%*									*
+%*                                                                      *
 \subsection{The @UniqSet@ type}
-%*									*
+%*                                                                      *
 %************************************************************************
 
 We use @UniqFM@, with a (@getUnique@-able) @Unique@ as ``key''
@@ -59,7 +59,7 @@ uniqSetToList :: UniqSet a -> [a]
 uniqSetToList (MkUniqSet set) = eltsUFM set
 
 foldUniqSet :: (a -> b -> b) -> b -> UniqSet a -> b
-foldUniqSet k z (MkUniqSet set) = foldUFM k z set 
+foldUniqSet k z (MkUniqSet set) = foldUFM k z set
 
 mkUniqSet :: Uniquable a => [a]  -> UniqSet a
 mkUniqSet xs = MkUniqSet (listToUFM [ (x, x) | x <- xs])
@@ -67,9 +67,17 @@ 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)
 
+addOneToUniqSet_C :: Uniquable a
+                  => (a -> a -> a) -> UniqSet a -> a -> UniqSet a
+addOneToUniqSet_C f (MkUniqSet set) x = MkUniqSet (addToUFM_C f set x x)
+
 delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
 delOneFromUniqSet (MkUniqSet set) x = MkUniqSet (delFromUFM set x)
 
+delOneFromUniqSet_Directly :: Uniquable a => UniqSet a -> Unique -> UniqSet a
+delOneFromUniqSet_Directly (MkUniqSet set) u
+    = MkUniqSet (delFromUFM_Directly set u)
+
 delListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
 delListFromUniqSet (MkUniqSet set) xs = MkUniqSet (delListFromUFM set xs)
 
@@ -80,9 +88,9 @@ unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
 unionUniqSets (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (plusUFM set1 set2)
 
 unionManyUniqSets :: [UniqSet a] -> UniqSet a
-	-- = foldr unionUniqSets emptyUniqSet ss
-unionManyUniqSets []	 = emptyUniqSet
-unionManyUniqSets [s]	 = s
+-- = foldr unionUniqSets emptyUniqSet ss
+unionManyUniqSets []     = emptyUniqSet
+unionManyUniqSets [s]    = s
 unionManyUniqSets (s:ss) = s `unionUniqSets` unionManyUniqSets ss
 
 minusUniqSet  :: UniqSet a -> UniqSet a -> UniqSet a
@@ -112,19 +120,23 @@ hashUniqSet (MkUniqSet set) = hashUFM set
 isEmptyUniqSet :: UniqSet a -> Bool
 isEmptyUniqSet (MkUniqSet set) = isNullUFM set {-SLOW: sizeUFM set == 0-}
 
-mapUniqSet :: (a -> a) -> UniqSet a -> UniqSet a
-  -- VERY IMPORTANT: *assumes* that the function doesn't change the unique
+-- | Invariant: the mapping function doesn't change the unique
+mapUniqSet :: (a -> b) -> UniqSet a -> UniqSet b
 mapUniqSet f (MkUniqSet set) = MkUniqSet (mapUFM f set)
 \end{code}
 
 \begin{code}
-#if __GLASGOW_HASKELL__
+#ifdef __GLASGOW_HASKELL__
 {-# SPECIALIZE
     addOneToUniqSet :: UniqSet Unique -> Unique -> UniqSet Unique
     #-}
+
+-- These next three specialisations disabled as importing Name creates a
+-- loop, and getting the Uniquable Name instance in particular is tricky.
+
 {- SPECIALIZE
     elementOfUniqSet :: Name -> UniqSet Name -> Bool
-		      , Unique -> UniqSet Unique -> Bool
+                      , Unique -> UniqSet Unique -> Bool
     -}
 {- SPECIALIZE
     mkUniqSet :: [Name] -> UniqSet Name
@@ -132,7 +144,7 @@ mapUniqSet f (MkUniqSet set) = MkUniqSet (mapUFM f set)
 
 {- SPECIALIZE
     unitUniqSet :: Name -> UniqSet Name
-		 , Unique -> UniqSet Unique
+                 , Unique -> UniqSet Unique
     -}
 #endif
 \end{code}