X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FUniqFM.lhs;h=09723c824e0d59d954818a270c4cab5acfa3a6d4;hb=573ef10b2afd99d3c6a36370a9367609716c97d2;hp=f23ef1f8f74c3b2da8af37106d52d65c44f444cd;hpb=f9120c200bcf613b58d742802172fb4c08171f0d;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/UniqFM.lhs b/ghc/compiler/utils/UniqFM.lhs
index f23ef1f..09723c8 100644
--- a/ghc/compiler/utils/UniqFM.lhs
+++ b/ghc/compiler/utils/UniqFM.lhs
@@ -21,6 +21,7 @@ Basically, the things need to be in class @Uniquable@, and we use the
 
 module UniqFM (
 	UniqFM,   -- abstract type
+	Uniquable(..), -- class to go with it
 
 	emptyUFM,
 	unitUFM,
@@ -34,6 +35,7 @@ module UniqFM (
 	IF_NOT_GHC(addToUFM_C COMMA)
 	addListToUFM_C,
 	delFromUFM,
+	delFromUFM_Directly,
 	delListFromUFM,
 	plusUFM,
 	plusUFM_C,
@@ -49,18 +51,15 @@ module UniqFM (
 	lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
 	eltsUFM,
 	ufmToList
-
-	-- to make the interface self-sufficient
     ) where
 
 #if defined(COMPILING_GHC)
-CHK_Ubiq() -- debugging consistency check
+IMP_Ubiq(){-uitous-}
 #endif
 
-import Unique		( Unique, Uniquable(..), u2i, mkUniqueGrimily )
+import Unique		( Unique, u2i, mkUniqueGrimily )
 import Util
-import Outputable	( Outputable(..), ExportFlag )
-import Pretty		( Pretty(..), PrettyRep )
+import Pretty		( SYN_IE(Pretty), PrettyRep )
 import PprStyle		( PprStyle )
 import SrcLoc		( SrcLoc )
 
@@ -102,6 +101,7 @@ addListToUFM_C	:: Uniquable key => (elt -> elt -> elt)
 
 delFromUFM	:: Uniquable key => UniqFM elt -> key	 -> UniqFM elt
 delListFromUFM	:: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
+delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
 
 plusUFM		:: UniqFM elt -> UniqFM elt -> UniqFM elt
 
@@ -138,89 +138,34 @@ ufmToList	:: UniqFM elt -> [(Unique, elt)]
 %************************************************************************
 
 \begin{code}
-#if 0
-
-type IdFinMap	 elt = UniqFM elt
-type TyVarFinMap elt = UniqFM elt
-type NameFinMap  elt = UniqFM elt
-type RegFinMap   elt = UniqFM elt
-
 #ifdef __GLASGOW_HASKELL__
 -- I don't think HBC was too happy about this (WDP 94/10)
 
 {-# SPECIALIZE
-    unitUFM :: Id	  -> elt -> IdFinMap elt,
-		    TyVar -> elt -> TyVarFinMap elt,
-		    Name  -> elt -> NameFinMap elt
-    IF_NCG(COMMA    Reg   -> elt -> RegFinMap elt)
-  #-}
-{-# SPECIALIZE
-    listToUFM	:: [(Id,   elt)]     -> IdFinMap elt,
-		   [(TyVar,elt)]     -> TyVarFinMap elt,
-		   [(Name, elt)]     -> NameFinMap elt
-    IF_NCG(COMMA   [(Reg COMMA elt)] -> RegFinMap elt)
-  #-}
-{-# SPECIALIZE
-    addToUFM	:: IdFinMap    elt -> Id    -> elt  -> IdFinMap elt,
-		   TyVarFinMap elt -> TyVar -> elt  -> TyVarFinMap elt,
-		   NameFinMap  elt -> Name  -> elt  -> NameFinMap elt
-    IF_NCG(COMMA   RegFinMap   elt -> Reg   -> elt  -> RegFinMap elt)
+    addListToUFM :: UniqFM elt -> [(Name,   elt)] -> UniqFM elt
+		  , UniqFM elt -> [(RnName, elt)] -> UniqFM elt
   #-}
 {-# SPECIALIZE
-    addListToUFM :: IdFinMap	elt -> [(Id,   elt)] -> IdFinMap elt,
-		    TyVarFinMap elt -> [(TyVar,elt)] -> TyVarFinMap elt,
-		    NameFinMap  elt -> [(Name,elt)]  -> NameFinMap elt
-    IF_NCG(COMMA    RegFinMap   elt -> [(Reg COMMA elt)] -> RegFinMap elt)
+    addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name,  elt)] -> UniqFM elt
+		    , (elt -> elt -> elt) -> UniqFM elt -> [(RnName,elt)] -> UniqFM elt
   #-}
 {-# SPECIALIZE
-    addToUFM_C	:: (elt -> elt -> elt)
-		-> IdFinMap elt -> Id -> elt -> IdFinMap elt,
-		   (elt -> elt -> elt)
-		-> TyVarFinMap elt -> TyVar -> elt -> TyVarFinMap elt,
-		   (elt -> elt -> elt)
-		-> NameFinMap elt -> Name -> elt -> NameFinMap elt
-    IF_NCG(COMMA   (elt -> elt -> elt)
-    		-> RegFinMap elt -> Reg -> elt -> RegFinMap elt)
+    addToUFM	:: UniqFM elt -> Unique -> elt  -> UniqFM elt
   #-}
 {-# SPECIALIZE
-    addListToUFM_C :: (elt -> elt -> elt)
-		-> IdFinMap elt -> [(Id,elt)] -> IdFinMap elt,
-		   (elt -> elt -> elt)
-		-> TyVarFinMap elt -> [(TyVar,elt)] -> TyVarFinMap elt,
-		   (elt -> elt -> elt)
-		-> NameFinMap elt -> [(Name,elt)] -> NameFinMap elt
-    IF_NCG(COMMA   (elt -> elt -> elt)
-		-> RegFinMap elt -> [(Reg COMMA elt)] -> RegFinMap elt)
+    listToUFM	:: [(Unique, elt)]     -> UniqFM elt
+		 , [(RnName, elt)]     -> UniqFM elt
   #-}
 {-# SPECIALIZE
-    delFromUFM	:: IdFinMap elt	   -> Id    -> IdFinMap elt,
-		   TyVarFinMap elt -> TyVar -> TyVarFinMap elt,
-		   NameFinMap elt  -> Name  -> NameFinMap elt
-    IF_NCG(COMMA    RegFinMap elt   -> Reg   -> RegFinMap elt)
+    lookupUFM	:: UniqFM elt -> Name   -> Maybe elt
+		 , UniqFM elt -> RnName -> Maybe elt
+		 , UniqFM elt -> Unique -> Maybe elt
   #-}
 {-# SPECIALIZE
-    delListFromUFM :: IdFinMap elt    -> [Id]	 -> IdFinMap elt,
-		      TyVarFinMap elt -> [TyVar] -> TyVarFinMap elt,
-		      NameFinMap elt  -> [Name]  -> NameFinMap elt
-    IF_NCG(COMMA      RegFinMap elt   -> [Reg]   -> RegFinMap elt)
-  #-}
-
-{-# SPECIALIZE
-    lookupUFM	:: IdFinMap elt	   -> Id    -> Maybe elt,
-		   TyVarFinMap elt -> TyVar -> Maybe elt,
-		   NameFinMap elt  -> Name  -> Maybe elt
-    IF_NCG(COMMA   RegFinMap elt   -> Reg   -> Maybe elt)
-  #-}
-{-# SPECIALIZE
-    lookupWithDefaultUFM
-		:: IdFinMap elt	   -> elt -> Id	   -> elt,
-		   TyVarFinMap elt -> elt -> TyVar -> elt,
-		   NameFinMap elt  -> elt -> Name  -> elt
-    IF_NCG(COMMA   RegFinMap elt   -> elt -> Reg   -> elt)
+    lookupWithDefaultUFM :: UniqFM elt -> elt -> RnName -> elt
   #-}
 
 #endif {- __GLASGOW_HASKELL__ -}
-#endif {- 0 -}
 \end{code}
 
 %************************************************************************
@@ -261,6 +206,9 @@ data UniqFM ele
 	    (UniqFM ele)
 	    (UniqFM ele)
 
+class Uniquable a where
+    uniqueOf :: a -> Unique
+
 -- for debugging only :-)
 {-
 instance Text (UniqFM a) where
@@ -327,7 +275,8 @@ Now ways of removing things from UniqFM.
 \begin{code}
 delListFromUFM fm lst = foldl delFromUFM fm lst
 
-delFromUFM fm key = delete fm (u2i (uniqueOf key))
+delFromUFM          fm key = delete fm (u2i (uniqueOf key))
+delFromUFM_Directly fm u   = delete fm (u2i u)
 
 delete EmptyUFM _   = EmptyUFM
 delete fm       key = del_ele fm
@@ -436,8 +385,8 @@ minusUFM fm1 fm2     = minus_trees fm1 fm2
 	--
 	-- Notice the asymetry of subtraction
 	--
-	minus_trees lf@(LeafUFM i a) t2	       =
-		case lookup t2 i of
+	minus_trees lf@(LeafUFM i a) t2 =
+		case lookUp t2 i of
 		  Nothing -> lf
 		  Just b -> EmptyUFM
 
@@ -508,12 +457,12 @@ intersectUFM_C f _ EmptyUFM = EmptyUFM
 intersectUFM_C f fm1 fm2    = intersect_trees fm1 fm2
     where
 	intersect_trees (LeafUFM i a) t2 =
-		case lookup t2 i of
+		case lookUp t2 i of
 		  Nothing -> EmptyUFM
 		  Just b -> mkLeafUFM i (f a b)
 
 	intersect_trees t1 (LeafUFM i a) =
-		case lookup t1 i of
+		case lookUp t1 i of
 		  Nothing -> EmptyUFM
 		  Just b -> mkLeafUFM i (f b a)
 
@@ -596,21 +545,21 @@ looking up in a hurry is the {\em whole point} of this binary tree lark.
 Lookup up a binary tree is easy (and fast).
 
 \begin{code}
-lookupUFM	  fm key = lookup fm (u2i (uniqueOf key))
-lookupUFM_Directly fm key = lookup fm (u2i key)
+lookupUFM	   fm key = lookUp fm (u2i (uniqueOf key))
+lookupUFM_Directly fm key = lookUp fm (u2i key)
 
 lookupWithDefaultUFM fm deflt key
-  = case lookup fm (u2i (uniqueOf key)) of
+  = case lookUp fm (u2i (uniqueOf key)) of
       Nothing  -> deflt
       Just elt -> elt
 
 lookupWithDefaultUFM_Directly fm deflt key
-  = case lookup fm (u2i key) of
+  = case lookUp fm (u2i key) of
       Nothing  -> deflt
       Just elt -> elt
 
-lookup EmptyUFM _   = Nothing
-lookup fm i	    = lookup_tree fm
+lookUp EmptyUFM _   = Nothing
+lookUp fm i	    = lookup_tree fm
   where
 	lookup_tree :: UniqFM a -> Maybe a