X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FUniqFM.lhs;h=d0b3d9d90b8627a289cbffae3afbb7b3834970f2;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=92839cbdb615060792501886f320b4cfe765f5fb;hpb=e7d21ee4f8ac907665a7e170c71d59e13a01da09;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/UniqFM.lhs b/ghc/compiler/utils/UniqFM.lhs
index 92839cb..d0b3d9d 100644
--- a/ghc/compiler/utils/UniqFM.lhs
+++ b/ghc/compiler/utils/UniqFM.lhs
@@ -1,73 +1,58 @@
 %
-% (c) The AQUA Project, Glasgow University, 1994-1995
+% (c) The AQUA Project, Glasgow University, 1994-1998
 %
 \section[UniqFM]{Specialised finite maps, for things with @Uniques@}
 
 Based on @FiniteMaps@ (as you would expect).
 
-Basically, the things need to be in class @NamedThing@, and we use the
-@getTheUnique@ method to grab their @Uniques@.
+Basically, the things need to be in class @Uniquable@, and we use the
+@getUnique@ method to grab their @Uniques@.
 
 (A similar thing to @UniqSet@, as opposed to @Set@.)
 
-@IdEnv@ and @TyVarEnv@ are the (backward-compatible?) specialisations
-of this stuff for Ids and TyVars, respectively.
-
 \begin{code}
-#if defined(COMPILING_GHC)
-#include "HsVersions.h"
-#define IF_NOT_GHC(a) {--}
-#else
-#define ASSERT(e) {--}
-#define IF_NOT_GHC(a) a
-#endif
-
 module UniqFM (
 	UniqFM,   -- abstract type
 
 	emptyUFM,
-	singletonUFM,
-	singletonDirectlyUFM,
+	unitUFM,
+	unitDirectlyUFM,
 	listToUFM,
 	listToUFM_Directly,
-	addToUFM,
-	IF_NOT_GHC(addListToUFM COMMA)
+	addToUFM,addToUFM_C,
+	addListToUFM,addListToUFM_C,
 	addToUFM_Directly,
-	IF_NOT_GHC(addToUFM_C COMMA)
-	IF_NOT_GHC(addListToUFM_C COMMA)
+	addListToUFM_Directly,
 	delFromUFM,
+	delFromUFM_Directly,
 	delListFromUFM,
 	plusUFM,
 	plusUFM_C,
 	minusUFM,
 	intersectUFM,
-	IF_NOT_GHC(intersectUFM_C COMMA)
-	IF_NOT_GHC(foldUFM COMMA)
+	intersectUFM_C,
+	foldUFM,
 	mapUFM,
+	elemUFM,
 	filterUFM,
 	sizeUFM,
 	isNullUFM,
-	lookupUFM,
-	lookupDirectlyUFM,
-	IF_NOT_GHC(lookupWithDefaultUFM COMMA)
-	eltsUFM,
-	ufmToList,
-
-	-- to make the interface self-sufficient
-	Id, TyVar, Unique
-	IF_ATTACK_PRAGMAS(COMMA u2i)	-- profiling
+	lookupUFM, lookupUFM_Directly,
+	lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
+	eltsUFM, keysUFM,
+	ufmToList, 
+	FastString
     ) where
 
-import AbsUniType	-- for specialisation to TyVars
-import Id		-- for specialisation to Ids
-import IdInfo		-- sigh
-import Maybes		( maybeToBool, Maybe(..) )
-import Name
-import Outputable
-import Unique		( u2i, mkUniqueGrimily, Unique )
+#include "HsVersions.h"
+
+import {-# SOURCE #-} Name	( Name )
+
+import Unique		( Uniquable(..), Unique, u2i, mkUniqueGrimily )
 import Util
+import GlaExts		-- Lots of Int# operations
+
 #if ! OMIT_NATIVE_CODEGEN
-import AsmRegAlloc	( Reg )
 #define IF_NCG(a) a
 #else
 #define IF_NCG(a) {--}
@@ -80,31 +65,35 @@ import AsmRegAlloc	( Reg )
 %*									*
 %************************************************************************
 
-We use @FiniteMaps@, with a (@getTheUnique@-able) @Unique@ as ``key''.
+We use @FiniteMaps@, with a (@getUnique@-able) @Unique@ as ``key''.
 
 \begin{code}
 emptyUFM	:: UniqFM elt
 isNullUFM	:: UniqFM elt -> Bool
-singletonUFM	:: NamedThing key => key -> elt -> UniqFM elt
-singletonDirectlyUFM -- got the Unique already
+unitUFM		:: Uniquable key => key -> elt -> UniqFM elt
+unitDirectlyUFM -- got the Unique already
 		:: Unique -> elt -> UniqFM elt
-listToUFM	:: NamedThing key => [(key,elt)] -> UniqFM elt
+listToUFM	:: Uniquable key => [(key,elt)] -> UniqFM elt
 listToUFM_Directly
 		:: [(Unique, elt)] -> UniqFM elt
 
-addToUFM	:: NamedThing key => UniqFM elt -> key -> elt  -> UniqFM elt
-addListToUFM	:: NamedThing key => UniqFM elt -> [(key,elt)] -> UniqFM elt
+addToUFM	:: Uniquable key => UniqFM elt -> key -> elt  -> UniqFM elt
+addListToUFM	:: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
 addToUFM_Directly
 		:: UniqFM elt -> Unique -> elt -> UniqFM elt
 
-addToUFM_C	:: NamedThing key => (elt -> elt -> elt)
-			   -> UniqFM elt -> key -> elt -> UniqFM elt
-addListToUFM_C	:: NamedThing key => (elt -> elt -> elt)
+addToUFM_C	:: Uniquable key => (elt -> elt -> elt)	-- old -> new -> result
+			   -> UniqFM elt 		-- old
+			   -> key -> elt 		-- new
+			   -> UniqFM elt		-- result
+
+addListToUFM_C	:: Uniquable key => (elt -> elt -> elt)
 			   -> UniqFM elt -> [(key,elt)]
 			   -> UniqFM elt
 
-delFromUFM	:: NamedThing key => UniqFM elt -> key	 -> UniqFM elt
-delListFromUFM	:: NamedThing key => UniqFM elt -> [key] -> UniqFM 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
 
@@ -121,13 +110,17 @@ mapUFM		:: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
 filterUFM	:: (elt -> Bool) -> UniqFM elt -> UniqFM elt
 
 sizeUFM		:: UniqFM elt -> Int
+elemUFM		:: Uniquable key => key -> UniqFM elt -> Bool
 
-lookupUFM	:: NamedThing key => UniqFM elt -> key -> Maybe elt
-lookupDirectlyUFM  -- when you've got the Unique already
+lookupUFM	:: Uniquable key => UniqFM elt -> key -> Maybe elt
+lookupUFM_Directly  -- when you've got the Unique already
 		:: UniqFM elt -> Unique -> Maybe elt
 lookupWithDefaultUFM
-		:: NamedThing key => UniqFM elt -> elt -> key -> elt
+		:: Uniquable key => UniqFM elt -> elt -> key -> elt
+lookupWithDefaultUFM_Directly
+		:: UniqFM elt -> elt -> Unique -> elt
 
+keysUFM		:: UniqFM elt -> [Int]		-- Get the keys
 eltsUFM		:: UniqFM elt -> [elt]
 ufmToList	:: UniqFM elt -> [(Unique, elt)]
 \end{code}
@@ -139,88 +132,31 @@ ufmToList	:: UniqFM elt -> [(Unique, elt)]
 %************************************************************************
 
 \begin{code}
-type IdFinMap	 elt = UniqFM elt
-type TyVarFinMap elt = UniqFM elt
-type NameFinMap  elt = UniqFM elt
-type RegFinMap   elt = UniqFM elt
-\end{code}
+-- Turn off for now, these need to be updated (SDM 4/98)
 
-\begin{code}
+#if 0
 #ifdef __GLASGOW_HASKELL__
 -- I don't think HBC was too happy about this (WDP 94/10)
 
 {-# SPECIALIZE
-    singletonUFM :: Id	  -> elt -> IdFinMap elt,
-		    TyVar -> elt -> TyVarFinMap elt,
-		    Name  -> elt -> NameFinMap elt
-    IF_NCG(COMMA    Reg   -> elt -> RegFinMap elt)
+    addListToUFM :: UniqFM elt -> [(Name,   elt)] -> UniqFM elt
   #-}
 {-# SPECIALIZE
-    listToUFM	:: [(Id,   elt)]     -> IdFinMap elt,
-		   [(TyVar,elt)]     -> TyVarFinMap elt,
-		   [(Name, elt)]     -> NameFinMap elt
-    IF_NCG(COMMA   [(Reg COMMA elt)] -> RegFinMap elt)
+    addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name,  elt)] -> UniqFM 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)
+    addToUFM	:: UniqFM elt -> Unique -> 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)
+    listToUFM	:: [(Unique, 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)
-  #-}
-{-# 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)
-  #-}
-{-# 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)
-  #-}
-{-# 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)
+    lookupUFM	:: UniqFM elt -> Name   -> Maybe elt
+		 , UniqFM elt -> Unique -> Maybe elt
   #-}
 
 #endif {- __GLASGOW_HASKELL__ -}
+#endif
 \end{code}
 
 %************************************************************************
@@ -285,8 +221,8 @@ First the ways of building a UniqFM.
 
 \begin{code}
 emptyUFM		     = EmptyUFM
-singletonUFM	     key elt = mkLeafUFM (u2i (getTheUnique key)) elt
-singletonDirectlyUFM key elt = mkLeafUFM (u2i key) elt
+unitUFM	     key elt = mkLeafUFM (u2i (getUnique key)) elt
+unitDirectlyUFM key elt = mkLeafUFM (u2i key) elt
 
 listToUFM key_elt_pairs
   = addListToUFM_C use_snd EmptyUFM key_elt_pairs
@@ -308,12 +244,13 @@ addToUFM fm key elt = addToUFM_C use_snd fm key elt
 addToUFM_Directly fm u elt = insert_ele use_snd fm (u2i u) elt
 
 addToUFM_C combiner fm key elt
-  = insert_ele combiner fm (u2i (getTheUnique key)) elt
+  = insert_ele combiner fm (u2i (getUnique key)) elt
 
 addListToUFM fm key_elt_pairs = addListToUFM_C use_snd fm key_elt_pairs
+addListToUFM_Directly fm uniq_elt_pairs = addListToUFM_directly_C use_snd fm uniq_elt_pairs
 
 addListToUFM_C combiner fm key_elt_pairs
- = foldl (\ fm (k, e) -> insert_ele combiner fm (u2i (getTheUnique k)) e)
+ = foldl (\ fm (k, e) -> insert_ele combiner fm (u2i (getUnique k)) e)
 	 fm key_elt_pairs
 
 addListToUFM_directly_C combiner fm uniq_elt_pairs
@@ -326,7 +263,8 @@ Now ways of removing things from UniqFM.
 \begin{code}
 delListFromUFM fm lst = foldl delFromUFM fm lst
 
-delFromUFM fm key = delete fm (u2i (getTheUnique key))
+delFromUFM          fm key = delete fm (u2i (getUnique key))
+delFromUFM_Directly fm u   = delete fm (u2i u)
 
 delete EmptyUFM _   = EmptyUFM
 delete fm       key = del_ele fm
@@ -340,7 +278,7 @@ delete fm       key = del_ele fm
     del_ele nd@(NodeUFM j p t1 t2)
       | j _GT_ key
       = mkSLNodeUFM (NodeUFMData j p) (del_ele t1) t2
-      | otherwise	
+      | otherwise
       = mkLSNodeUFM (NodeUFMData j p) t1 (del_ele t2)
 
     del_ele _ = panic "Found EmptyUFM FM when rec-deleting"
@@ -383,7 +321,7 @@ plusUFM_C f fm1 fm2	= mix_trees fm1 fm2
 		--	  j		j'			 j
 		--	 / \	+      / \	==>		/ \
 		--     t1   t2	    t1'	  t2'		t1 + t1'   t2 + t2'
-		--	
+		--
 	  mix_branches (SameRoot)
 		= mkSSNodeUFM (NodeUFMData j p)
 			(mix_trees t1 t1')
@@ -397,29 +335,29 @@ plusUFM_C f fm1 fm2	= mix_trees fm1 fm2
 		--     t1   t2	    t1'	  t2'		      t1   t2 + j'
 		--						       / \
 		--						     t1'  t2'
-	  mix_branches (LeftRoot Left) -- | trace "LL" True
+	  mix_branches (LeftRoot Leftt) -- | trace "LL" True
 	    = mkSLNodeUFM
 		(NodeUFMData j p)
-		(mix_trees t1 right_t)	
+		(mix_trees t1 right_t)
 		t2
 
-	  mix_branches (LeftRoot Right) -- | trace "LR" True
+	  mix_branches (LeftRoot Rightt) -- | trace "LR" True
 	    = mkLSNodeUFM
 		(NodeUFMData j p)
 		t1
-		(mix_trees t2 right_t)	
+		(mix_trees t2 right_t)
 
-	  mix_branches (RightRoot Left) -- | trace "RL" True
+	  mix_branches (RightRoot Leftt) -- | trace "RL" True
 	    = mkSLNodeUFM
 		(NodeUFMData j' p')
-		(mix_trees left_t t1')	
+		(mix_trees left_t t1')
 		t2'
 
-	  mix_branches (RightRoot Right) -- | trace "RR" True
+	  mix_branches (RightRoot Rightt) -- | trace "RR" True
 	    = mkLSNodeUFM
 		(NodeUFMData j' p')
 		t1'
-		(mix_trees left_t t2')	
+		(mix_trees left_t t2')
 
 	mix_trees _ _ = panic "EmptyUFM found when inserting into plusInt"
 \end{code}
@@ -435,8 +373,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
 
@@ -453,8 +391,8 @@ minusUFM fm1 fm2     = minus_trees fm1 fm2
 		--	  j		j'		   j
 		--	 / \	+      / \	==>	  / \
 		--     t1   t2	    t1'	  t2'		 t1  t2
-		--				
-		--				
+		--
+		--
 		-- Fast, Ehh !
 		--
 	  minus_branches (NewRoot nd _) = left_t
@@ -464,7 +402,7 @@ minusUFM fm1 fm2     = minus_trees fm1 fm2
 		--	  j		j'			 j
 		--	 / \	+      / \	==>		/ \
 		--     t1   t2	    t1'	  t2'		t1 + t1'   t2 + t2'
-		--	
+		--
 	  minus_branches (SameRoot)
 		= mkSSNodeUFM (NodeUFMData j p)
 			(minus_trees t1 t1')
@@ -475,23 +413,23 @@ minusUFM fm1 fm2     = minus_trees fm1 fm2
 		--
 		-- The left is above the right
 		--
-	  minus_branches (LeftRoot Left)
+	  minus_branches (LeftRoot Leftt)
 	    = mkSLNodeUFM
 		(NodeUFMData j p)
-		(minus_trees t1 right_t)	
+		(minus_trees t1 right_t)
 		t2
-	  minus_branches (LeftRoot Right)
+	  minus_branches (LeftRoot Rightt)
 	    = mkLSNodeUFM
 		(NodeUFMData j p)
 		t1
-		(minus_trees t2 right_t)	
+		(minus_trees t2 right_t)
 
 		--
 		-- The right is above the left
 		--
-	  minus_branches (RightRoot Left)
+	  minus_branches (RightRoot Leftt)
 	    = minus_trees left_t t1'
-	  minus_branches (RightRoot Right)
+	  minus_branches (RightRoot Rightt)
 	    = minus_trees left_t t2'
 
 	minus_trees _ _ = panic "EmptyUFM found when insering into plusInt"
@@ -507,12 +445,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)
 
@@ -524,10 +462,10 @@ intersectUFM_C f fm1 fm2    = intersect_trees fm1 fm2
 	  where
 		-- Given a disjoint j,j' (p >^ p' && p' >^ p):
 		--
-		--	  j		j'		
+		--	  j		j'
 		--	 / \	+      / \	==>		EmptyUFM
-		--     t1   t2	    t1'	  t2'		
-		--					
+		--     t1   t2	    t1'	  t2'
+		--
 		-- Fast, Ehh !
 		--
 	  intersect_branches (NewRoot nd _) = EmptyUFM
@@ -537,7 +475,7 @@ intersectUFM_C f fm1 fm2    = intersect_trees fm1 fm2
 		--	  j		j'			 j
 		--	 / \	+      / \	==>		/ \
 		--     t1   t2	    t1'	  t2'		t1 x t1'   t2 x t2'
-		--	
+		--
 	  intersect_branches (SameRoot)
 		= mkSSNodeUFM (NodeUFMData j p)
 			(intersect_trees t1 t1')
@@ -549,16 +487,16 @@ intersectUFM_C f fm1 fm2    = intersect_trees fm1 fm2
 		--	  j		j'		       t2 + j'
 		--	 / \	+      / \	==>		   / \
 		--     t1   t2	    t1'	  t2'			 t1'  t2'
-		--						
+		--
 		-- This does cut down the search space quite a bit.
-					
-	  intersect_branches (LeftRoot Left)
+
+	  intersect_branches (LeftRoot Leftt)
 	    = intersect_trees t1 right_t
-	  intersect_branches (LeftRoot Right)
+	  intersect_branches (LeftRoot Rightt)
 	    = intersect_trees t2 right_t
-	  intersect_branches (RightRoot Left)
+	  intersect_branches (RightRoot Leftt)
 	    = intersect_trees left_t t1'
-	  intersect_branches (RightRoot Right)
+	  intersect_branches (RightRoot Rightt)
 	    = intersect_trees left_t t2'
 
 	intersect_trees x y = panic ("EmptyUFM found when intersecting trees")
@@ -567,9 +505,12 @@ intersectUFM_C f fm1 fm2    = intersect_trees fm1 fm2
 Now the usual set of `collection' operators, like map, fold, etc.
 
 \begin{code}
-foldUFM fn a EmptyUFM = a
-foldUFM fn a fm	      = fold_tree fn a fm
+foldUFM f a (NodeUFM _ _ t1 t2) = foldUFM f (foldUFM f a t2) t1
+foldUFM f a (LeafUFM _ obj)     = f obj a
+foldUFM f a EmptyUFM	        = a
+\end{code}
 
+\begin{code}
 mapUFM fn EmptyUFM    = EmptyUFM
 mapUFM fn fm	      = map_tree fn fm
 
@@ -595,16 +536,25 @@ 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 (getTheUnique key))
-lookupDirectlyUFM fm key = lookup fm (u2i key)
+elemUFM key fm = case lookUp fm (u2i (getUnique key)) of
+			Nothing -> False
+			Just _  -> True
+
+lookupUFM	   fm key = lookUp fm (u2i (getUnique key))
+lookupUFM_Directly fm key = lookUp fm (u2i key)
 
 lookupWithDefaultUFM fm deflt key
-  = case lookup fm (u2i (getTheUnique key)) of
+  = case lookUp fm (u2i (getUnique key)) of
       Nothing  -> deflt
       Just elt -> elt
 
-lookup EmptyUFM _   = Nothing
-lookup fm i	    = lookup_tree fm
+lookupWithDefaultUFM_Directly fm deflt key
+  = case lookUp fm (u2i key) of
+      Nothing  -> deflt
+      Just elt -> elt
+
+lookUp EmptyUFM _   = Nothing
+lookUp fm i	    = lookup_tree fm
   where
 	lookup_tree :: UniqFM a -> Maybe a
 
@@ -621,17 +571,15 @@ lookup fm i	    = lookup_tree fm
 folds are *wonderful* things.
 
 \begin{code}
-eltsUFM EmptyUFM = []
-eltsUFM fm       = fold_tree (:) [] fm
+eltsUFM fm = foldUFM (:) [] fm
 
-ufmToList EmptyUFM = []
-ufmToList fm
-  = fold_tree (\ iu elt rest -> (mkUniqueGrimily iu, elt) : rest) [] fm
-  where
-    fold_tree f a (NodeUFM _ _ t1 t2) = fold_tree f (fold_tree f a t2) t1
-    fold_tree f a (LeafUFM iu obj)    = f iu obj a
+ufmToList fm = fold_tree (\ iu elt rest -> (mkUniqueGrimily iu, elt) : rest) [] fm
+
+keysUFM fm = fold_tree (\ iu elt rest -> IBOX(iu) : rest) [] fm
 
-    fold_tree f a EmptyUFM = panic "Should Never fold over an EmptyUFM"
+fold_tree f a (NodeUFM _ _ t1 t2) = fold_tree f (fold_tree f a t2) t1
+fold_tree f a (LeafUFM iu obj)    = f iu obj a
+fold_tree f a EmptyUFM		  = a
 \end{code}
 
 %************************************************************************
@@ -741,14 +689,7 @@ insert_ele f n@(NodeUFM j p t1 t2) i a
 		  (mkLeafUFM i a)
 \end{code}
 
-This has got a left to right ordering.
 
-\begin{code}
-fold_tree f a (NodeUFM _ _ t1 t2) = fold_tree f (fold_tree f a t2) t1
-fold_tree f a (LeafUFM _ obj)	  = f obj a
-
-fold_tree f a EmptyUFM = panic "Should Never fold over an EmptyUFM"
-\end{code}
 
 \begin{code}
 map_tree f (NodeUFM j p t1 t2)
@@ -763,9 +704,10 @@ map_tree f _ = panic "map_tree failed"
 filter_tree f nd@(NodeUFM j p t1 t2)
   = mkSSNodeUFM (NodeUFMData j p) (filter_tree f t1) (filter_tree f t2)
 
-filter_tree f lf@(LeafUFM i obj)	
+filter_tree f lf@(LeafUFM i obj)
   | f obj = lf
   | otherwise = EmptyUFM
+filter_tree f _ = panic "filter_tree failed"
 \end{code}
 
 %************************************************************************
@@ -788,7 +730,7 @@ data NodeUFMData
 This is the information used when computing new NodeUFMs.
 
 \begin{code}
-data Side = Left | Right
+data Side = Leftt | Rightt -- NB: avoid 1.3 names "Left" and "Right"
 data CommonRoot
   = LeftRoot  Side	-- which side is the right down ?
   | RightRoot Side	-- which side is the left down ?
@@ -839,8 +781,8 @@ ask_about_common_ancestor x@(NodeUFMData j p) y@(NodeUFMData j2 p2)
 	| otherwise   -> NewRoot nd (j _GT_ j2)
     where
 	decideSide :: Bool -> Side
-	decideSide True	 = Left
-	decideSide False = Right
+	decideSide True	 = Leftt
+	decideSide False = Rightt
 \end{code}
 
 This might be better in Util.lhs ?
@@ -856,12 +798,8 @@ shiftR_ :: FAST_INT -> FAST_INT -> FAST_INT
 {-# INLINE shiftR_ #-}
 shiftL_ n p = word2Int#((int2Word# n) `shiftL#` p)
 shiftR_ n p = word2Int#((int2Word# n) `shiftr` p)
-# if __GLASGOW_HASKELL__ >= 23
   where
-    shiftr x y = shiftRA# x y
-# else
-    shiftr x y = shiftR#  x y
-# endif
+    shiftr x y = shiftRL# x y
 
 #else {- not GHC -}
 shiftL_ n p = n * (2 ^ p)
@@ -870,12 +808,7 @@ shiftR_ n p = n `quot` (2 ^ p)
 #endif {- not GHC -}
 \end{code}
 
-Andy's extras: ToDo: to Util.
-
 \begin{code}
-use_fst :: a -> b -> a
-use_fst a b = a
-
 use_snd :: a -> b -> b
 use_snd a b = b
 \end{code}