Replace FiniteMap and UniqFM with counterparts from containers.

The original interfaces are kept. There is small performance improvement:
- when compiling for five nofib, we get following speedups:
    Average                -----           -2.5%
    Average                -----           -0.6%
    Average                -----           -0.5%
    Average                -----           -5.5%
    Average                -----          -10.3%
- when compiling HPC ten times, we get:
    switches                          oldmaps   newmaps
    -O -fasm                          117.402s  116.081s (98.87%)
    -O -fasm -fregs-graph             119.993s  118.735s (98.95%)
    -O -fasm -fregs-iterative         120.191s  118.607s (98.68%)

1 files changed, 78 insertions, 749 deletions

diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs
index 9a3d6063ab..293e48ed14 100644
--- a/compiler/utils/UniqFM.lhs
+++ b/compiler/utils/UniqFM.lhs
@@ -3,21 +3,27 @@
 % (c) The AQUA Project, Glasgow University, 1994-1998
 %
 
-UniqFM: Specialised finite maps, for things with @Uniques@
-
-Based on @FiniteMaps@ (as you would expect).
+UniqFM: Specialised finite maps, for things with @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@.)
 
+The interface is based on @FiniteMap@s, but the implementation uses
+@Data.IntMap@, which is both maitained and faster than the past
+implementation (see commit log).
+
+The @UniqFM@ interface maps directly to Data.IntMap, only
+``Data.IntMap.union'' is left-biased and ``plusUFM'' right-biased
+and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order
+of arguments of combining function.
+
 \begin{code}
-{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
+{-# OPTIONS -Wall #-}
 module UniqFM (
 	-- * Unique-keyed mappings
-	UniqFM(..),   	-- abstract type
-			-- (de-abstracted for MachRegs.trivColorable optimisation BL 2007/09)
+	UniqFM,       -- abstract type
 
         -- ** Manipulating those mappings
 	emptyUFM,
@@ -36,7 +42,6 @@ module UniqFM (
 	plusUFM,
 	plusUFM_C,
 	minusUFM,
-	intersectsUFM,
 	intersectUFM,
 	intersectUFM_C,
 	foldUFM, foldUFM_Directly,
@@ -44,7 +49,6 @@ module UniqFM (
 	elemUFM, elemUFM_Directly,
 	filterUFM, filterUFM_Directly,
 	sizeUFM,
-	hashUFM,
 	isNullUFM,
 	lookupUFM, lookupUFM_Directly,
 	lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
@@ -52,22 +56,18 @@ module UniqFM (
 	ufmToList 
     ) where
 
-#include "HsVersions.h"
-
-import Unique		( Uniquable(..), Unique, getKeyFastInt, mkUniqueGrimily )
-import Maybes		( maybeToBool )
-import FastTypes
+import Unique           ( Uniquable(..), Unique, getKey )
 import Outputable
+
+import qualified Data.IntMap as M
 \end{code}
 
 %************************************************************************
 %*									*
-\subsection{The @UniqFM@ type, and signatures for the functions}
+\subsection{The signature of the module}
 %*									*
 %************************************************************************
 
-We use @FiniteMaps@, with a (@getUnique@-able) @Unique@ as ``key''.
-
 \begin{code}
 emptyUFM	:: UniqFM elt
 isNullUFM	:: UniqFM elt -> Bool
@@ -107,6 +107,7 @@ delFromUFM	:: Uniquable key => UniqFM elt -> key	 -> UniqFM elt
 delListFromUFM	:: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
 delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
 
+-- Bindings in right argument shadow those in the left
 plusUFM		:: UniqFM elt -> UniqFM elt -> UniqFM elt
 
 plusUFM_C	:: (elt -> elt -> elt)
@@ -117,7 +118,6 @@ minusUFM	:: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
 intersectUFM	:: UniqFM elt -> UniqFM elt -> UniqFM elt
 intersectUFM_C	:: (elt1 -> elt2 -> elt3)
 		-> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
-intersectsUFM	:: UniqFM elt1 -> UniqFM elt2 -> Bool
 
 foldUFM		:: (elt -> a -> a) -> a -> UniqFM elt -> a
 foldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
@@ -126,7 +126,7 @@ filterUFM	:: (elt -> Bool) -> UniqFM elt -> UniqFM elt
 filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
 
 sizeUFM		:: UniqFM elt -> Int
-hashUFM		:: UniqFM elt -> Int
+--hashUFM		:: UniqFM elt -> Int
 elemUFM		:: Uniquable key => key -> UniqFM elt -> Bool
 elemUFM_Directly:: Unique -> UniqFM elt -> Bool
 
@@ -142,749 +142,78 @@ lookupWithDefaultUFM_Directly
 keysUFM		:: UniqFM elt -> [Unique]	-- Get the keys
 eltsUFM		:: UniqFM elt -> [elt]
 ufmToList	:: UniqFM elt -> [(Unique, elt)]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{The @IdFinMap@ and @TyVarFinMap@ specialisations for Ids/TyVars}
-%*									*
-%************************************************************************
-
-\begin{code}
--- Turn off for now, these need to be updated (SDM 4/98)
-
-#if 0
-#ifdef __GLASGOW_HASKELL__
--- I don't think HBC was too happy about this (WDP 94/10)
-
-{-# SPECIALIZE
-    addListToUFM :: UniqFM elt -> [(Name,   elt)] -> UniqFM elt
-  #-}
-{-# SPECIALIZE
-    addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name,  elt)] -> UniqFM elt
-  #-}
-{-# SPECIALIZE
-    addToUFM	:: UniqFM elt -> Unique -> elt  -> UniqFM elt
-  #-}
-{-# SPECIALIZE
-    listToUFM	:: [(Unique, elt)]     -> UniqFM elt
-  #-}
-{-# SPECIALIZE
-    lookupUFM	:: UniqFM elt -> Name   -> Maybe elt
-		 , UniqFM elt -> Unique -> Maybe elt
-  #-}
-
-#endif /* __GLASGOW_HASKELL__ */
-#endif
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Andy Gill's underlying @UniqFM@ machinery}
-%*									*
-%************************************************************************
-
-``Uniq Finite maps'' are the heart and soul of the compiler's
-lookup-tables/environments.  Important stuff!  It works well with
-Dense and Sparse ranges.
-Both @Uq@ Finite maps and @Hash@ Finite Maps
-are built ontop of Int Finite Maps.
-
-This code is explained in the paper:
-\begin{display}
-	A Gill, S Peyton Jones, B O'Sullivan, W Partain and Aqua Friends
-	"A Cheap balancing act that grows on a tree"
-	Glasgow FP Workshop, Sep 1994, pp??-??
-\end{display}
 
-%************************************************************************
-%*									*
-\subsubsection{The @UniqFM@ type, and signatures for the functions}
-%*									*
-%************************************************************************
-
-First, the DataType itself; which is either a Node, a Leaf, or an Empty.
-
-\begin{code}
--- | @UniqFM a@ is a mapping from Unique to @a@. DO NOT use these constructors
--- directly unless you live in this module!
-data UniqFM ele
-  = EmptyUFM
-  | LeafUFM !FastInt ele
-  | NodeUFM !FastInt         -- the switching
-            !FastInt         -- the delta
-            (UniqFM ele)
-            (UniqFM ele)
--- INVARIANT: the children of a NodeUFM are never EmptyUFMs
-
-{-
--- for debugging only :-)
-instance Outputable (UniqFM a) where
-	ppr(NodeUFM a b t1 t2) =
-		sep [text "NodeUFM " <+> int IBOX(a) <+> int IBOX(b),
-		     nest 1 (parens (ppr t1)),
-		     nest 1 (parens (ppr t2))]
-	ppr (LeafUFM x a) = text "LeafUFM " <+> int IBOX(x)
-	ppr (EmptyUFM)    = empty
--}
--- and when not debugging the package itself...
-instance Outputable a => Outputable (UniqFM a) where
-    ppr ufm = ppr (ufmToList ufm)
 \end{code}
 
 %************************************************************************
-%*									*
-\subsubsection{The @UniqFM@ functions}
-%*									*
+%*                                                                      *
+\subsection{Implementation using ``Data.IntMap''}
+%*                                                                      *
 %************************************************************************
 
-First the ways of building a UniqFM.
-
 \begin{code}
-emptyUFM		     = EmptyUFM
-unitUFM	     key elt = mkLeafUFM (getKeyFastInt (getUnique key)) elt
-unitDirectlyUFM key elt = mkLeafUFM (getKeyFastInt key) elt
+newtype UniqFM ele = UFM (M.IntMap ele)
+
+emptyUFM = UFM M.empty
+isNullUFM (UFM m) = M.null m
+unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v)
+unitDirectlyUFM u v = UFM (M.singleton (getKey u) v)
+listToUFM = foldl (\m (k, v) -> addToUFM m k v) emptyUFM
+listToUFM_Directly = foldl (\m (u, v) -> addToUFM_Directly m u v) emptyUFM
+listToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v) emptyUFM
+
+addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m)
+addListToUFM = foldl (\m (k, v) -> addToUFM m k v)
+addListToUFM_Directly = foldl (\m (k, v) -> addToUFM_Directly m k v)
+addToUFM_Directly (UFM m) u v = UFM (M.insert (getKey u) v m)
+
+-- Arguments of combining function of M.insertWith and addToUFM_C are flipped.
+addToUFM_C f (UFM m) k v =
+  UFM (M.insertWith (flip f) (getKey $ getUnique k) v m)
+addToUFM_Acc exi new (UFM m) k v =
+  UFM (M.insertWith (\_new old -> exi v old) (getKey $ getUnique k) (new v) m)
+addListToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v)
+
+delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m)
+delListFromUFM = foldl delFromUFM
+delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)
+
+-- M.union is left-biased, plusUFM should be right-biased.
+plusUFM (UFM x) (UFM y) = UFM (M.union y x)
+plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)
+minusUFM (UFM x) (UFM y) = UFM (M.difference x y)
+intersectUFM (UFM x) (UFM y) = UFM (M.intersection x y)
+intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)
+
+foldUFM k z (UFM m) = M.fold k z m
+foldUFM_Directly k z (UFM m) = M.foldWithKey (k . getUnique) z m
+mapUFM f (UFM m) = UFM (M.map f m)
+filterUFM p (UFM m) = UFM (M.filter p m)
+filterUFM_Directly p (UFM m) = UFM (M.filterWithKey (p . getUnique) m)
+
+sizeUFM (UFM m) = M.size m
+elemUFM k (UFM m) = M.member (getKey $ getUnique k) m
+elemUFM_Directly u (UFM m) = M.member (getKey u) m
+
+splitUFM (UFM m) k = case M.splitLookup (getKey $ getUnique k) m of
+                       (less, equal, greater) -> (UFM less, equal, UFM greater)
+lookupUFM (UFM m) k = M.lookup (getKey $ getUnique k) m
+lookupUFM_Directly (UFM m) u = M.lookup (getKey u) m
+lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m
+lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m
+keysUFM (UFM m) = map getUnique $ M.keys m
+eltsUFM (UFM m) = M.elems m
+ufmToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
 
-listToUFM key_elt_pairs
-  = addListToUFM_C use_snd EmptyUFM key_elt_pairs
-
-listToUFM_Directly uniq_elt_pairs
-  = addListToUFM_directly_C use_snd EmptyUFM uniq_elt_pairs
-
-listToUFM_C combiner key_elt_pairs
-  = addListToUFM_C combiner EmptyUFM key_elt_pairs
-\end{code}
-
-Now ways of adding things to UniqFMs.
-
-There is an alternative version of @addListToUFM_C@, that uses @plusUFM@,
-but the semantics of this operation demands a linear insertion;
-perhaps the version without the combinator function
-could be optimised using it.
-
-\begin{code}
-addToUFM fm key elt = addToUFM_C use_snd fm key elt
-
-addToUFM_Directly fm u elt = insert_ele use_snd fm (getKeyFastInt u) elt
-
-addToUFM_C combiner fm key elt
-  = insert_ele combiner fm (getKeyFastInt (getUnique key)) elt
-
-addToUFM_Acc add unit fm key item
-  = insert_ele combiner fm (getKeyFastInt (getUnique key)) (unit item)
-  where
-    combiner old _unit_item = add item old
-
-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 (getKeyFastInt (getUnique k)) e)
-	 fm key_elt_pairs
-
-addListToUFM_directly_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Unique,elt)] -> UniqFM elt
-addListToUFM_directly_C combiner fm uniq_elt_pairs
- = foldl (\ fm (k, e) -> insert_ele combiner fm (getKeyFastInt k) e)
-	 fm uniq_elt_pairs
-\end{code}
-
-Now ways of removing things from UniqFM.
-
-\begin{code}
-delListFromUFM fm lst = foldl delFromUFM fm lst
-
-delFromUFM          fm key = delete fm (getKeyFastInt (getUnique key))
-delFromUFM_Directly fm u   = delete fm (getKeyFastInt u)
-
-delete :: UniqFM a -> FastInt -> UniqFM a
-delete EmptyUFM _   = EmptyUFM
-delete fm       key = del_ele fm
-  where
-    del_ele :: UniqFM a -> UniqFM a
-
-    del_ele lf@(LeafUFM j _)
-      | j ==# key	= EmptyUFM
-      | otherwise	= lf	-- no delete!
-
-    del_ele (NodeUFM j p t1 t2)
-      | j ># key
-      = mkSLNodeUFM (NodeUFMData j p) (del_ele t1) t2
-      | otherwise
-      = mkLSNodeUFM (NodeUFMData j p) t1 (del_ele t2)
-
-    del_ele _ = panic "Found EmptyUFM FM when rec-deleting"
-\end{code}
-
-Now ways of adding two UniqFM's together.
-
-\begin{code}
-plusUFM tr1 tr2 = plusUFM_C use_snd tr1 tr2
-
-plusUFM_C _ EmptyUFM tr	= tr
-plusUFM_C _ tr EmptyUFM	= tr
-plusUFM_C f fm1 fm2	= mix_trees fm1 fm2
-    where
-	mix_trees (LeafUFM i a) t2 = insert_ele (flip f) t2 i a
-	mix_trees t1 (LeafUFM i a) = insert_ele f	 t1 i a
-
-	mix_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
-	  = mix_branches
-		(ask_about_common_ancestor
-			(NodeUFMData j p)
-			(NodeUFMData j' p'))
-	  where
-		-- Given a disjoint j,j' (p >^ p' && p' >^ p):
-		--
-		--	  j		j'			(C j j')
-		--	 / \	+      / \	==>		/	\
-		--     t1   t2	    t1'	  t2'		       j	 j'
-		--					      / \	/ \
-		--					     t1	 t2   t1'  t2'
-		-- Fast, Ehh !
-		--
-	  mix_branches (NewRoot nd False)
-		= mkLLNodeUFM nd left_t right_t
-	  mix_branches (NewRoot nd True)
-		= mkLLNodeUFM nd right_t left_t
-
-		-- Now, if j == j':
-		--
-		--	  j		j'			 j
-		--	 / \	+      / \	==>		/ \
-		--     t1   t2	    t1'	  t2'		t1 + t1'   t2 + t2'
-		--
-	  mix_branches (SameRoot)
-		= mkSSNodeUFM (NodeUFMData j p)
-			(mix_trees t1 t1')
-			(mix_trees t2 t2')
-		-- Now the 4 different other ways; all like this:
-		--
- -- Given j >^ j' (and, say,  j > j')
-		--
-		--	  j		j'			 j
-		--	 / \	+      / \	==>		/ \
-		--     t1   t2	    t1'	  t2'		      t1   t2 + j'
-		--						       / \
-		--						     t1'  t2'
-	  mix_branches (LeftRoot Leftt) --  | trace "LL" True
-	    = mkSLNodeUFM
-		(NodeUFMData j p)
-		(mix_trees t1 right_t)
-		t2
-
-	  mix_branches (LeftRoot Rightt) --  | trace "LR" True
-	    = mkLSNodeUFM
-		(NodeUFMData j p)
-		t1
-		(mix_trees t2 right_t)
-
-	  mix_branches (RightRoot Leftt) --  | trace "RL" True
-	    = mkSLNodeUFM
-		(NodeUFMData j' p')
-		(mix_trees left_t t1')
-		t2'
-
-	  mix_branches (RightRoot Rightt) --  | trace "RR" True
-	    = mkLSNodeUFM
-		(NodeUFMData j' p')
-		t1'
-		(mix_trees left_t t2')
-
-	mix_trees _ _ = panic "EmptyUFM found when inserting into plusInt"
-\end{code}
-
-And ways of subtracting them. First the base cases,
-then the full D&C approach.
-
-\begin{code}
-minusUFM EmptyUFM _  = EmptyUFM
-minusUFM t1 EmptyUFM = t1
-minusUFM fm1 fm2     = minus_trees fm1 fm2
-    where
-	--
-	-- Notice the asymetry of subtraction
-	--
-	minus_trees lf@(LeafUFM i _a) t2 =
-		case lookUp t2 i of
-		  Nothing -> lf
-		  Just _ -> EmptyUFM
-
-	minus_trees t1 (LeafUFM i _) = delete t1 i
-
-	minus_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
-	  = minus_branches
-		(ask_about_common_ancestor
-			(NodeUFMData j p)
-			(NodeUFMData j' p'))
-	  where
-		-- Given a disjoint j,j' (p >^ p' && p' >^ p):
-		--
-		--	  j		j'		   j
-		--	 / \	+      / \	==>	  / \
-		--     t1   t2	    t1'	  t2'		 t1  t2
-		--
-		--
-		-- Fast, Ehh !
-		--
-	  minus_branches (NewRoot _ _) = left_t
-
-		-- Now, if j == j':
-		--
-		--	  j		j'			 j
-		--	 / \	+      / \	==>		/ \
-		--     t1   t2	    t1'	  t2'		t1 + t1'   t2 + t2'
-		--
-	  minus_branches (SameRoot)
-		= mkSSNodeUFM (NodeUFMData j p)
-			(minus_trees t1 t1')
-			(minus_trees t2 t2')
-		-- Now the 4 different other ways; all like this:
-		-- again, with asymatry
-
-		--
-		-- The left is above the right
-		--
-	  minus_branches (LeftRoot Leftt)
-	    = mkSLNodeUFM
-		(NodeUFMData j p)
-		(minus_trees t1 right_t)
-		t2
-	  minus_branches (LeftRoot Rightt)
-	    = mkLSNodeUFM
-		(NodeUFMData j p)
-		t1
-		(minus_trees t2 right_t)
-
-		--
-		-- The right is above the left
-		--
-	  minus_branches (RightRoot Leftt)
-	    = minus_trees left_t t1'
-	  minus_branches (RightRoot Rightt)
-	    = minus_trees left_t t2'
-
-	minus_trees _ _ = panic "EmptyUFM found when insering into plusInt"
-\end{code}
-
-And taking the intersection of two UniqFM's.
-
-\begin{code}
-intersectUFM  t1 t2 = intersectUFM_C use_snd t1 t2
-intersectsUFM t1 t2 = isNullUFM (intersectUFM_C (\ _ _ -> error "urk") t1 t2)
-
-intersectUFM_C _ EmptyUFM _ = EmptyUFM
-intersectUFM_C _ _ EmptyUFM = EmptyUFM
-intersectUFM_C f fm1 fm2    = intersect_trees fm1 fm2
-    where
-	intersect_trees (LeafUFM i a) t2 =
-		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
-		  Nothing -> EmptyUFM
-		  Just b -> mkLeafUFM i (f b a)
-
-	intersect_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
-	  = intersect_branches
-		(ask_about_common_ancestor
-			(NodeUFMData j p)
-			(NodeUFMData j' p'))
-	  where
-		-- Given a disjoint j,j' (p >^ p' && p' >^ p):
-		--
-		--	  j		j'
-		--	 / \	+      / \	==>		EmptyUFM
-		--     t1   t2	    t1'	  t2'
-		--
-		-- Fast, Ehh !
-		--
-	  intersect_branches (NewRoot _nd _) = EmptyUFM
-
-		-- Now, if j == j':
-		--
-		--	  j		j'			 j
-		--	 / \	+      / \	==>		/ \
-		--     t1   t2	    t1'	  t2'		t1 x t1'   t2 x t2'
-		--
-	  intersect_branches (SameRoot)
-		= mkSSNodeUFM (NodeUFMData j p)
-			(intersect_trees t1 t1')
-			(intersect_trees t2 t2')
-		-- Now the 4 different other ways; all like this:
-		--
-		-- Given j >^ j' (and, say,  j > j')
-		--
-		--	  j		j'		       t2 + j'
-		--	 / \	+      / \	==>		   / \
-		--     t1   t2	    t1'	  t2'			 t1'  t2'
-		--
-		-- This does cut down the search space quite a bit.
-
-	  intersect_branches (LeftRoot Leftt)
-	    = intersect_trees t1 right_t
-	  intersect_branches (LeftRoot Rightt)
-	    = intersect_trees t2 right_t
-	  intersect_branches (RightRoot Leftt)
-	    = intersect_trees left_t t1'
-	  intersect_branches (RightRoot Rightt)
-	    = intersect_trees left_t t2'
-
-	intersect_trees _ _ = panic ("EmptyUFM found when intersecting trees")
-\end{code}
-
-Now the usual set of `collection' operators, like map, fold, etc.
-
-\begin{code}
-foldUFM f a (NodeUFM _ _ t1 t2) = foldUFM f (foldUFM f a t2) t1
-foldUFM f a (LeafUFM _ obj)     = f obj a
-foldUFM _ a EmptyUFM	        = a
-\end{code}
-
-\begin{code}
-mapUFM _fn EmptyUFM   = EmptyUFM
-mapUFM  fn fm	      = map_tree fn fm
-
-filterUFM _fn EmptyUFM = EmptyUFM
-filterUFM  fn fm       = filter_tree (\_ e -> fn e) fm
-
-filterUFM_Directly _fn EmptyUFM = EmptyUFM
-filterUFM_Directly  fn fm       = filter_tree pred fm
-	where
-	  pred i e = fn (mkUniqueGrimily (iBox i)) e
-\end{code}
-
-Note, this takes a long time, O(n), but
-because we dont want to do this very often, we put up with this.
-O'rable, but how often do we look at the size of
-a finite map?
-
-\begin{code}
-sizeUFM EmptyUFM	    = 0
-sizeUFM (NodeUFM _ _ t1 t2) = sizeUFM t1 + sizeUFM t2
-sizeUFM (LeafUFM _ _)	    = 1
-
-isNullUFM EmptyUFM = True
-isNullUFM _	   = False
-
--- hashing is used in VarSet.uniqAway, and should be fast
--- We use a cheap and cheerful method for now
-hashUFM EmptyUFM          = 0
-hashUFM (NodeUFM n _ _ _) = iBox n
-hashUFM (LeafUFM n _)     = iBox n
-\end{code}
-
-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}
-elemUFM          key fm = maybeToBool (lookupUFM fm key)
-elemUFM_Directly key fm = maybeToBool (lookupUFM_Directly fm key)
-
-lookupUFM	   fm key = lookUp fm (getKeyFastInt (getUnique key))
-lookupUFM_Directly fm key = lookUp fm (getKeyFastInt key)
-
-lookupWithDefaultUFM fm deflt key
-  = case lookUp fm (getKeyFastInt (getUnique key)) of
-      Nothing  -> deflt
-      Just elt -> elt
-
-lookupWithDefaultUFM_Directly fm deflt key
-  = case lookUp fm (getKeyFastInt key) of
-      Nothing  -> deflt
-      Just elt -> elt
-
-lookUp :: UniqFM a -> FastInt -> Maybe a
-lookUp EmptyUFM _   = Nothing
-lookUp fm i	    = lookup_tree fm
-  where
-	lookup_tree :: UniqFM a -> Maybe a
-
-	lookup_tree (LeafUFM j b)
-	  | j ==# i	= Just b
-	  | otherwise	= Nothing
-	lookup_tree (NodeUFM j _ t1 t2)
-	  | j ># i	= lookup_tree t1
-	  | otherwise	= lookup_tree t2
-
-	lookup_tree EmptyUFM = panic "lookup Failed"
-
--------------------
-splitUFM fm key = split fm (getKeyFastInt (getUnique key))
-
-split :: UniqFM a -> FastInt -> (UniqFM a, Maybe a, UniqFM a)
--- Splits a UFM into things less than, equal to, and greater than the key
-split EmptyUFM _ = (EmptyUFM, Nothing, EmptyUFM)
-split fm i       = go fm
-  where
-    go (LeafUFM j b) | i <# j    = (EmptyUFM,    Nothing, LeafUFM j b)
-       		     | i ># j    = (LeafUFM j b, Nothing, EmptyUFM)
-                     | otherwise = (EmptyUFM,    Just b,  EmptyUFM)
-       		     
-    go (NodeUFM j p t1 t2) 
-      | j ># i 
-      , (lt, eq, gt) <- go t1 = (lt, eq, mkSLNodeUFM (NodeUFMData j p) gt t2)
-      | (lt, eq, gt) <- go t2 = (mkLSNodeUFM (NodeUFMData j p) t1 lt, eq, gt)
-
-    go EmptyUFM = panic "splitUFM failed"
-\end{code}
-
-folds are *wonderful* things.
-
-\begin{code}
-eltsUFM   fm = foldUFM (:) [] fm
-keysUFM   fm = foldUFM_Directly (\u _ l -> u      : l) [] fm
-ufmToList fm = foldUFM_Directly (\u e l -> (u, e) : l) [] fm
-foldUFM_Directly f = fold_tree (\iu e a -> f (mkUniqueGrimily (iBox iu)) e a)
-
-fold_tree :: (FastInt -> elt -> a -> a) -> a -> UniqFM elt -> a
-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 _ a EmptyUFM		  = a
 \end{code}
 
 %************************************************************************
-%*									*
-\subsubsection{The @UniqFM@ type, and its functions}
-%*									*
+%*                                                                      *
+\subsection{Output-ery}
+%*                                                                      *
 %************************************************************************
 
-You should always use these to build the tree.
-There are 4 versions of mkNodeUFM, depending on
-the strictness of the two sub-tree arguments.
-The strictness is used *both* to prune out
-empty trees, *and* to improve performance,
-stoping needless thunks lying around.
-The rule of thumb (from experence with these trees)
-is make thunks strict, but data structures lazy.
-If in doubt, use mkSSNodeUFM, which has the `strongest'
-functionality, but may do a few needless evaluations.
-
 \begin{code}
-mkLeafUFM :: FastInt -> a -> UniqFM a
-mkLeafUFM i a =
-  ASSERT (iBox i >= 0) -- Note [Uniques must be positive]
-  LeafUFM i a
-
--- The *ONLY* ways of building a NodeUFM.
-
-mkSSNodeUFM, mkSLNodeUFM, mkLSNodeUFM, mkLLNodeUFM ::
-    NodeUFMData -> UniqFM a -> UniqFM a -> UniqFM a
-
-mkSSNodeUFM (NodeUFMData _ _) EmptyUFM t2 = t2
-mkSSNodeUFM (NodeUFMData _ _) t1 EmptyUFM = t1
-mkSSNodeUFM (NodeUFMData j p) t1 t2
-  = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
-    NodeUFM j p t1 t2
-
-mkSLNodeUFM (NodeUFMData _ _) EmptyUFM t2 = t2
-mkSLNodeUFM (NodeUFMData j p) t1 t2
-  = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
-    NodeUFM j p t1 t2
-
-mkLSNodeUFM (NodeUFMData _ _) t1 EmptyUFM = t1
-mkLSNodeUFM (NodeUFMData j p) t1 t2
-  = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
-    NodeUFM j p t1 t2
-
-mkLLNodeUFM (NodeUFMData j p) t1 t2
-  = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
-    NodeUFM j p t1 t2
-
-correctNodeUFM
-	:: Int
-	-> Int
-	-> UniqFM a
-	-> UniqFM a
-	-> Bool
-
-correctNodeUFM j p t1 t2
-  = correct (j-p) (j-1) p t1 && correct j ((j-1)+p) p t2
-  where
-    correct low high _ (LeafUFM i _)
-      = low <= iBox i && iBox i <= high
-    correct low high above_p (NodeUFM j p _ _)
-      = low <= iBox j && iBox j <= high && above_p > iBox p
-    correct _ _ _ EmptyUFM = panic "EmptyUFM stored inside a tree"
-\end{code}
-
-Note: doing SAT on this by hand seems to make it worse. Todo: Investigate,
-and if necessary do $\lambda$ lifting on our functions that are bound.
-
-\begin{code}
-insert_ele
-	:: (a -> a -> a)	-- old -> new -> result
-	-> UniqFM a
-	-> FastInt
-	-> a
-	-> UniqFM a
-
-insert_ele _f EmptyUFM i new = mkLeafUFM i new
-
-insert_ele  f (LeafUFM j old) i new
-  | j ># i =
-	  mkLLNodeUFM (getCommonNodeUFMData
-			  (indexToRoot i)
-			  (indexToRoot j))
-		 (mkLeafUFM i new)
-		 (mkLeafUFM j old)
-  | j ==# i  = mkLeafUFM j $ f old new
-  | otherwise =
-	  mkLLNodeUFM (getCommonNodeUFMData
-			  (indexToRoot i)
-			  (indexToRoot j))
-		 (mkLeafUFM j old)
-		 (mkLeafUFM i new)
-
-insert_ele f n@(NodeUFM j p t1 t2) i a
-  | i <# j
-    = if (i >=# (j -# p))
-      then mkSLNodeUFM (NodeUFMData j p) (insert_ele f t1 i a) t2
-      else mkLLNodeUFM (getCommonNodeUFMData
-			  (indexToRoot i)
-			  ((NodeUFMData j p)))
-		  (mkLeafUFM i a)
-		  n
-  | otherwise
-    = if (i <=# ((j -# _ILIT(1)) +# p))
-      then mkLSNodeUFM (NodeUFMData j p) t1 (insert_ele f t2 i a)
-      else mkLLNodeUFM (getCommonNodeUFMData
-			  (indexToRoot i)
-			  ((NodeUFMData j p)))
-		  n
-		  (mkLeafUFM i a)
-\end{code}
-
-
-
-\begin{code}
-map_tree :: (a -> b) -> UniqFM a -> UniqFM b
-map_tree f (NodeUFM j p t1 t2)
-  = mkLLNodeUFM (NodeUFMData j p) (map_tree f t1) (map_tree f t2)
-	-- NB. lazy! we know the tree is well-formed.
-map_tree f (LeafUFM i obj)
-  = mkLeafUFM i (f obj)
-map_tree _ _ = panic "map_tree failed"
-\end{code}
-
-\begin{code}
-filter_tree :: (FastInt -> a -> Bool) -> UniqFM a -> UniqFM a
-filter_tree f (NodeUFM j p t1 t2)
-  = mkSSNodeUFM (NodeUFMData j p) (filter_tree f t1) (filter_tree f t2)
-
-filter_tree f lf@(LeafUFM i obj)
-  | f i obj = lf
-  | otherwise = EmptyUFM
-filter_tree _ _ = panic "filter_tree failed"
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{The @UniqFM@ type, and signatures for the functions}
-%*									*
-%************************************************************************
-
-Now some Utilities;
-
-This is the information that is held inside a NodeUFM, packaged up for
-consumer use.
-
-\begin{code}
-data NodeUFMData
-  = NodeUFMData FastInt
-		FastInt
-\end{code}
-
-This is the information used when computing new NodeUFMs.
-
-\begin{code}
-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 ?
-  | SameRoot		-- they are the same !
-  | NewRoot NodeUFMData	-- here's the new, common, root
-	    Bool	-- do you need to swap left and right ?
-\end{code}
-
-This specifies the relationship between NodeUFMData and CalcNodeUFMData.
-
-\begin{code}
-indexToRoot :: FastInt -> NodeUFMData
-
-indexToRoot i
-  = NodeUFMData ((shiftL1 (shiftR1 i)) +# _ILIT(1)) (_ILIT(1))
-
-getCommonNodeUFMData :: NodeUFMData -> NodeUFMData -> NodeUFMData
-
-getCommonNodeUFMData (NodeUFMData i p) (NodeUFMData i2 p2)
-  | p ==# p2	= getCommonNodeUFMData_ p j j2
-  | p <# p2	= getCommonNodeUFMData_ p2 (j `quotFastInt` (p2 `quotFastInt` p)) j2
-  | otherwise	= getCommonNodeUFMData_ p j (j2 `quotFastInt` (p `quotFastInt` p2))
-  where
-    !j  = i  `quotFastInt` (shiftL1 p)
-    !j2 = i2 `quotFastInt` (shiftL1 p2)
-
-    getCommonNodeUFMData_ :: FastInt -> FastInt -> FastInt -> NodeUFMData
-
-    getCommonNodeUFMData_ p j j_
-      | j ==# j_
-      = NodeUFMData (((shiftL1 j) +# _ILIT(1)) *# p) p
-      | otherwise
-      = getCommonNodeUFMData_ (shiftL1 p) (shiftR1 j) (shiftR1 j_)
-
-ask_about_common_ancestor :: NodeUFMData -> NodeUFMData -> CommonRoot
-
-ask_about_common_ancestor x@(NodeUFMData j _p) y@(NodeUFMData j2 _p2)
-  | j ==# j2 = SameRoot
-  | otherwise
-  = case getCommonNodeUFMData x y of
-      nd@(NodeUFMData j3 _p3)
-	| j3 ==# j  -> LeftRoot (decideSide (j ># j2))
-	| j3 ==# j2 -> RightRoot (decideSide (j <# j2))
-	| otherwise   -> NewRoot nd (j ># j2)
-    where
-	decideSide :: Bool -> Side
-	decideSide True	 = Leftt
-	decideSide False = Rightt
-\end{code}
-
-This might be better in Util.lhs ?
-
-
-Now the bit twiddling functions.
-\begin{code}
-shiftL1 :: FastInt -> FastInt
-shiftR1 :: FastInt -> FastInt
-
-{-# INLINE shiftL1 #-}
-{-# INLINE shiftR1 #-}
-
-shiftL1 n = n `shiftLFastInt` _ILIT(1)
-shiftR1 n = n `shiftR_FastInt` _ILIT(1)
-\end{code}
-
-\begin{code}
-use_snd :: a -> b -> b
-use_snd _ b = b
+instance Outputable a => Outputable (UniqFM a) where
+    ppr ufm = ppr (ufmToList ufm)
 \end{code}
-
-{- Note [Uniques must be positive]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The getCommonNodeUFMData function assumes that the nodes use
-positive uniques. Specifically, the inner `loop' shifts the
-low bits out of two uniques until the shifted uniques are the same.
-At the same time, it computes a new delta, by shifting
-to the left.
-
-The failure case I (JPD) encountered:
-If one of the uniques is negative, the shifting may continue
-until all 64 bits have been shifted out, resulting in a new delta
-of 0, which is wrong and can trigger later assertion failures.
-
-Where do the negative uniques come from? Both Simom M and
-I have run into this problem when hashing a data structure.
-In both cases, we have avoided the problem by ensuring that
-the hashes remain positive.
--}