X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FUniqFM.lhs;h=e38f4f54f5222eb104cad028f5c1f62776e20a17;hb=06e14415fa8aef5be7d01314d08fcd87873cd0da;hp=6374705f255744ef24a6ac720735cff94bfb4a78;hpb=12899612693163154531da3285ec99c1c8ca2226;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/UniqFM.lhs b/ghc/compiler/utils/UniqFM.lhs
index 6374705..e38f4f5 100644
--- a/ghc/compiler/utils/UniqFM.lhs
+++ b/ghc/compiler/utils/UniqFM.lhs
@@ -1,27 +1,18 @@
 %
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (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 @Uniquable@, and we use the
-@uniqueOf@ method to grab their @Uniques@.
+@getUnique@ method to grab their @Uniques@.
 
 (A similar thing to @UniqSet@, as opposed to @Set@.)
 
 \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
-	Uniquable(..), -- class to go with it
 
 	emptyUFM,
 	unitUFM,
@@ -39,33 +30,30 @@ module UniqFM (
 	plusUFM_C,
 	minusUFM,
 	intersectUFM,
-	IF_NOT_GHC(intersectUFM_C COMMA)
-	IF_NOT_GHC(foldUFM COMMA)
+	intersectUFM_C,
+	foldUFM,
 	mapUFM,
+	elemUFM,
 	filterUFM,
 	sizeUFM,
+	hashUFM,
 	isNullUFM,
 	lookupUFM, lookupUFM_Directly,
 	lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
-	eltsUFM,
-	ufmToList
+	eltsUFM, keysUFM,
+	ufmToList 
     ) where
 
-#if defined(COMPILING_GHC)
-IMP_Ubiq(){-uitous-}
-#endif
+#include "HsVersions.h"
 
-import Unique		( Unique, u2i, mkUniqueGrimily )
-import Util
-import Pretty		( SYN_IE(Pretty), PrettyRep )
-import PprStyle		( PprStyle )
-import SrcLoc		( SrcLoc )
+import {-# SOURCE #-} Name	( Name )
 
-#if ! OMIT_NATIVE_CODEGEN
-#define IF_NCG(a) a
-#else
-#define IF_NCG(a) {--}
-#endif
+import Unique		( Uniquable(..), Unique, getKey, mkUniqueGrimily )
+import Panic
+import FastTypes
+import Outputable
+
+import GLAEXTS		-- Lots of Int# operations
 \end{code}
 
 %************************************************************************
@@ -74,7 +62,7 @@ import SrcLoc		( SrcLoc )
 %*									*
 %************************************************************************
 
-We use @FiniteMaps@, with a (@uniqueOf@-able) @Unique@ as ``key''.
+We use @FiniteMaps@, with a (@getUnique@-able) @Unique@ as ``key''.
 
 \begin{code}
 emptyUFM	:: UniqFM elt
@@ -91,8 +79,11 @@ addListToUFM	:: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
 addToUFM_Directly
 		:: UniqFM elt -> Unique -> elt -> UniqFM elt
 
-addToUFM_C	:: Uniquable key => (elt -> elt -> elt)
-			   -> UniqFM elt -> key -> elt -> UniqFM 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
@@ -106,16 +97,18 @@ plusUFM		:: UniqFM elt -> UniqFM elt -> UniqFM elt
 plusUFM_C	:: (elt -> elt -> elt)
 		-> UniqFM elt -> UniqFM elt -> UniqFM elt
 
-minusUFM	:: UniqFM elt -> UniqFM elt -> UniqFM elt
+minusUFM	:: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
 
 intersectUFM	:: UniqFM elt -> UniqFM elt -> UniqFM elt
-intersectUFM_C	:: (elt -> elt -> elt)
-		-> UniqFM elt -> UniqFM elt -> UniqFM elt
+intersectUFM_C	:: (elt1 -> elt2 -> elt3)
+		-> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
 foldUFM		:: (elt -> a -> a) -> a -> UniqFM elt -> a
 mapUFM		:: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
 filterUFM	:: (elt -> Bool) -> UniqFM elt -> UniqFM elt
 
 sizeUFM		:: UniqFM elt -> Int
+hashUFM		:: UniqFM elt -> Int
+elemUFM		:: Uniquable key => key -> UniqFM elt -> Bool
 
 lookupUFM	:: Uniquable key => UniqFM elt -> key -> Maybe elt
 lookupUFM_Directly  -- when you've got the Unique already
@@ -125,6 +118,7 @@ lookupWithDefaultUFM
 lookupWithDefaultUFM_Directly
 		:: UniqFM elt -> elt -> Unique -> elt
 
+keysUFM		:: UniqFM elt -> [Unique]	-- Get the keys
 eltsUFM		:: UniqFM elt -> [elt]
 ufmToList	:: UniqFM elt -> [(Unique, elt)]
 \end{code}
@@ -136,34 +130,31 @@ ufmToList	:: UniqFM elt -> [(Unique, elt)]
 %************************************************************************
 
 \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
-		  , UniqFM elt -> [(RnName, elt)] -> UniqFM elt
   #-}
 {-# SPECIALIZE
     addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name,  elt)] -> UniqFM elt
-		    , (elt -> elt -> elt) -> UniqFM elt -> [(RnName,elt)] -> UniqFM elt
   #-}
 {-# SPECIALIZE
     addToUFM	:: UniqFM elt -> Unique -> elt  -> UniqFM elt
   #-}
 {-# SPECIALIZE
     listToUFM	:: [(Unique, elt)]     -> UniqFM elt
-		 , [(RnName, elt)]     -> UniqFM elt
   #-}
 {-# SPECIALIZE
     lookupUFM	:: UniqFM elt -> Name   -> Maybe elt
-		 , UniqFM elt -> RnName -> Maybe elt
 		 , UniqFM elt -> Unique -> Maybe elt
   #-}
-{-# SPECIALIZE
-    lookupWithDefaultUFM :: UniqFM elt -> elt -> RnName -> elt
-  #-}
 
-#endif {- __GLASGOW_HASKELL__ -}
+#endif /* __GLASGOW_HASKELL__ */
+#endif
 \end{code}
 
 %************************************************************************
@@ -198,27 +189,25 @@ First, the DataType itself; which is either a Node, a Leaf, or an Empty.
 \begin{code}
 data UniqFM ele
   = EmptyUFM
-  | LeafUFM FAST_INT ele
-  | NodeUFM FAST_INT	    -- the switching
-	    FAST_INT	    -- the delta
+  | LeafUFM FastInt ele
+  | NodeUFM FastInt	    -- the switching
+	    FastInt	    -- the delta
 	    (UniqFM ele)
 	    (UniqFM ele)
 
-class Uniquable a where
-    uniqueOf :: a -> Unique
-
--- for debugging only :-)
 {-
-instance Text (UniqFM a) where
-	showsPrec _ (NodeUFM a b t1 t2) =
-		  showString "NodeUFM " . shows (IBOX(a))
-		. showString " " . shows (IBOX(b))
-		. showString " (" . shows t1
-		. showString ") (" . shows t2
-		. showString ")"
-	showsPrec _ (LeafUFM x a) = showString "LeafUFM " . shows (IBOX(x))
-	showsPrec _ (EmptyUFM) = id
+-- 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}
 
 %************************************************************************
@@ -231,8 +220,8 @@ First the ways of building a UniqFM.
 
 \begin{code}
 emptyUFM		     = EmptyUFM
-unitUFM	     key elt = mkLeafUFM (u2i (uniqueOf key)) elt
-unitDirectlyUFM key elt = mkLeafUFM (u2i key) elt
+unitUFM	     key elt = mkLeafUFM (getKey (getUnique key)) elt
+unitDirectlyUFM key elt = mkLeafUFM (getKey key) elt
 
 listToUFM key_elt_pairs
   = addListToUFM_C use_snd EmptyUFM key_elt_pairs
@@ -251,20 +240,20 @@ 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 (u2i u) elt
+addToUFM_Directly fm u elt = insert_ele use_snd fm (getKey u) elt
 
 addToUFM_C combiner fm key elt
-  = insert_ele combiner fm (u2i (uniqueOf key)) elt
+  = insert_ele combiner fm (getKey (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 (uniqueOf k)) e)
+ = foldl (\ fm (k, e) -> insert_ele combiner fm (getKey (getUnique k)) e)
 	 fm key_elt_pairs
 
 addListToUFM_directly_C combiner fm uniq_elt_pairs
- = foldl (\ fm (k, e) -> insert_ele combiner fm (u2i k) e)
+ = foldl (\ fm (k, e) -> insert_ele combiner fm (getKey k) e)
 	 fm uniq_elt_pairs
 \end{code}
 
@@ -273,8 +262,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_Directly fm u   = delete fm (u2i u)
+delFromUFM          fm key = delete fm (getKey (getUnique key))
+delFromUFM_Directly fm u   = delete fm (getKey u)
 
 delete EmptyUFM _   = EmptyUFM
 delete fm       key = del_ele fm
@@ -282,11 +271,11 @@ delete fm       key = del_ele fm
     del_ele :: UniqFM a -> UniqFM a
 
     del_ele lf@(LeafUFM j _)
-      | j _EQ_ key	= EmptyUFM
+      | j ==# key	= EmptyUFM
       | otherwise	= lf	-- no delete!
 
     del_ele nd@(NodeUFM j p t1 t2)
-      | j _GT_ key
+      | j ># key
       = mkSLNodeUFM (NodeUFMData j p) (del_ele t1) t2
       | otherwise
       = mkLSNodeUFM (NodeUFMData j p) t1 (del_ele t2)
@@ -515,9 +504,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
 
@@ -537,22 +529,32 @@ 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}
-lookupUFM	   fm key = lookUp fm (u2i (uniqueOf key))
-lookupUFM_Directly fm key = lookUp fm (u2i key)
+elemUFM key fm = case lookUp fm (getKey (getUnique key)) of
+			Nothing -> False
+			Just _  -> True
+
+lookupUFM	   fm key = lookUp fm (getKey (getUnique key))
+lookupUFM_Directly fm key = lookUp fm (getKey key)
 
 lookupWithDefaultUFM fm deflt key
-  = case lookUp fm (u2i (uniqueOf key)) of
+  = case lookUp fm (getKey (getUnique key)) of
       Nothing  -> deflt
       Just elt -> elt
 
 lookupWithDefaultUFM_Directly fm deflt key
-  = case lookUp fm (u2i key) of
+  = case lookUp fm (getKey key) of
       Nothing  -> deflt
       Just elt -> elt
 
@@ -562,10 +564,10 @@ lookUp fm i	    = lookup_tree fm
 	lookup_tree :: UniqFM a -> Maybe a
 
 	lookup_tree (LeafUFM j b)
-	  | j _EQ_ i	= Just b
+	  | j ==# i	= Just b
 	  | otherwise	= Nothing
 	lookup_tree (NodeUFM j p t1 t2)
-	  | j _GT_ i	= lookup_tree t1
+	  | j ># i	= lookup_tree t1
 	  | otherwise	= lookup_tree t2
 
 	lookup_tree EmptyUFM = panic "lookup Failed"
@@ -574,17 +576,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
 
-    fold_tree f a EmptyUFM = panic "Should Never fold over an EmptyUFM"
+keysUFM fm = fold_tree (\ iu elt rest -> mkUniqueGrimily iu : rest) [] fm
+
+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}
 
 %************************************************************************
@@ -605,7 +605,7 @@ If in doubt, use mkSSNodeUFM, which has the `strongest'
 functionality, but may do a few needless evaluations.
 
 \begin{code}
-mkLeafUFM :: FAST_INT -> a -> UniqFM a
+mkLeafUFM :: FastInt -> a -> UniqFM a
 mkLeafUFM i a	  = LeafUFM i a
 
 -- The *ONLY* ways of building a NodeUFM.
@@ -613,21 +613,21 @@ mkLeafUFM i a	  = LeafUFM i a
 mkSSNodeUFM (NodeUFMData j p) EmptyUFM t2 = t2
 mkSSNodeUFM (NodeUFMData j p) t1 EmptyUFM = t1
 mkSSNodeUFM (NodeUFMData j p) t1 t2
-  = ASSERT(correctNodeUFM (IBOX(j)) (IBOX(p)) t1 t2)
+  = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
     NodeUFM j p t1 t2
 
 mkSLNodeUFM (NodeUFMData j p) EmptyUFM t2 = t2
 mkSLNodeUFM (NodeUFMData j p) t1 t2
-  = ASSERT(correctNodeUFM (IBOX(j)) (IBOX(p)) t1 t2)
+  = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
     NodeUFM j p t1 t2
 
 mkLSNodeUFM (NodeUFMData j p) t1 EmptyUFM = t1
 mkLSNodeUFM (NodeUFMData j p) t1 t2
-  = ASSERT(correctNodeUFM (IBOX(j)) (IBOX(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)
+  = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
     NodeUFM j p t1 t2
 
 correctNodeUFM
@@ -641,9 +641,9 @@ 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
+      = low <= iBox i && iBox i <= high
     correct low high above_p (NodeUFM j p _ _)
-      = low <= IBOX(j) && IBOX(j) <= high && above_p > IBOX(p)
+      = low <= iBox j && iBox j <= high && above_p > iBox p
     correct _ _ _ EmptyUFM = panic "EmptyUFM stored inside a tree"
 \end{code}
 
@@ -654,20 +654,20 @@ and if necessary do $\lambda$ lifting on our functions that are bound.
 insert_ele
 	:: (a -> a -> a)
 	-> UniqFM a
-	-> FAST_INT
+	-> FastInt
 	-> a
 	-> UniqFM a
 
 insert_ele f EmptyUFM i new = mkLeafUFM i new
 
 insert_ele f (LeafUFM j old) i new
-  | j _GT_ i =
+  | j ># i =
 	  mkLLNodeUFM (getCommonNodeUFMData
 			  (indexToRoot i)
 			  (indexToRoot j))
 		 (mkLeafUFM i new)
 		 (mkLeafUFM j old)
-  | j _EQ_ i  = mkLeafUFM j (f old new)
+  | j ==# i  = mkLeafUFM j (f old new)
   | otherwise =
 	  mkLLNodeUFM (getCommonNodeUFMData
 			  (indexToRoot i)
@@ -676,8 +676,8 @@ insert_ele f (LeafUFM j old) i new
 		 (mkLeafUFM i new)
 
 insert_ele f n@(NodeUFM j p t1 t2) i a
-  | i _LT_ j
-    = if (i _GE_ (j _SUB_ p))
+  | i <# j
+    = if (i >=# (j -# p))
       then mkSLNodeUFM (NodeUFMData j p) (insert_ele f t1 i a) t2
       else mkLLNodeUFM (getCommonNodeUFMData
 			  (indexToRoot i)
@@ -685,7 +685,7 @@ insert_ele f n@(NodeUFM j p t1 t2) i a
 		  (mkLeafUFM i a)
 		  n
   | otherwise
-    = if (i _LE_ ((j _SUB_ ILIT(1)) _ADD_ p))
+    = if (i <=# ((j -# _ILIT(1)) +# p))
       then mkLSNodeUFM (NodeUFMData j p) t1 (insert_ele f t2 i a)
       else mkLLNodeUFM (getCommonNodeUFMData
 			  (indexToRoot i)
@@ -694,14 +694,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)
@@ -719,6 +712,7 @@ filter_tree f nd@(NodeUFM j p t1 t2)
 filter_tree f lf@(LeafUFM i obj)
   | f obj = lf
   | otherwise = EmptyUFM
+filter_tree f _ = panic "filter_tree failed"
 \end{code}
 
 %************************************************************************
@@ -734,8 +728,8 @@ consumer use.
 
 \begin{code}
 data NodeUFMData
-  = NodeUFMData FAST_INT
-		FAST_INT
+  = NodeUFMData FastInt
+		FastInt
 \end{code}
 
 This is the information used when computing new NodeUFMs.
@@ -753,43 +747,43 @@ data CommonRoot
 This specifies the relationship between NodeUFMData and CalcNodeUFMData.
 
 \begin{code}
-indexToRoot :: FAST_INT -> NodeUFMData
+indexToRoot :: FastInt -> NodeUFMData
 
 indexToRoot i
   = let
-	l = (ILIT(1) :: FAST_INT)
+	l = (_ILIT(1) :: FastInt)
     in
-    NodeUFMData (((i `shiftR_` l) `shiftL_` l) _ADD_ ILIT(1)) l
+    NodeUFMData (((i `shiftR_` l) `shiftL_` l) +# _ILIT(1)) l
 
 getCommonNodeUFMData :: NodeUFMData -> NodeUFMData -> NodeUFMData
 
 getCommonNodeUFMData (NodeUFMData i p) (NodeUFMData i2 p2)
-  | p _EQ_ p2	= getCommonNodeUFMData_ p j j2
-  | p _LT_ p2	= getCommonNodeUFMData_ p2 (j _QUOT_ (p2 _QUOT_ p)) j2
-  | otherwise	= getCommonNodeUFMData_ p j (j2 _QUOT_ (p _QUOT_ 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
-    l  = (ILIT(1) :: FAST_INT)
-    j  = i  _QUOT_ (p  `shiftL_` l)
-    j2 = i2 _QUOT_ (p2 `shiftL_` l)
+    l  = (_ILIT(1) :: FastInt)
+    j  = i  `quotFastInt` (p  `shiftL_` l)
+    j2 = i2 `quotFastInt` (p2 `shiftL_` l)
 
-    getCommonNodeUFMData_ :: FAST_INT -> FAST_INT -> FAST_INT -> NodeUFMData
+    getCommonNodeUFMData_ :: FastInt -> FastInt -> FastInt -> NodeUFMData
 
     getCommonNodeUFMData_ p j j_
-      | j _EQ_ j_
-      = NodeUFMData (((j `shiftL_` l) _ADD_ l) _MUL_ p) p
+      | j ==# j_
+      = NodeUFMData (((j `shiftL_` l) +# l) *# p) p
       | otherwise
       = getCommonNodeUFMData_ (p `shiftL_`  l) (j `shiftR_` l) (j_ `shiftR_` l)
 
 ask_about_common_ancestor :: NodeUFMData -> NodeUFMData -> CommonRoot
 
 ask_about_common_ancestor x@(NodeUFMData j p) y@(NodeUFMData j2 p2)
-  | j _EQ_ j2 = SameRoot
+  | j ==# j2 = SameRoot
   | otherwise
   = case getCommonNodeUFMData x y of
       nd@(NodeUFMData j3 p3)
-	| j3 _EQ_ j  -> LeftRoot (decideSide (j _GT_ j2))
-	| j3 _EQ_ j2 -> RightRoot (decideSide (j _LT_ j2))
-	| otherwise   -> NewRoot nd (j _GT_ j2)
+	| j3 ==# j  -> LeftRoot (decideSide (j ># j2))
+	| j3 ==# j2 -> RightRoot (decideSide (j <# j2))
+	| otherwise   -> NewRoot nd (j ># j2)
     where
 	decideSide :: Bool -> Side
 	decideSide True	 = Leftt
@@ -801,30 +795,33 @@ This might be better in Util.lhs ?
 
 Now the bit twiddling functions.
 \begin{code}
-shiftL_ :: FAST_INT -> FAST_INT -> FAST_INT
-shiftR_ :: FAST_INT -> FAST_INT -> FAST_INT
+shiftL_ :: FastInt -> FastInt -> FastInt
+shiftR_ :: FastInt -> FastInt -> FastInt
 
 #if __GLASGOW_HASKELL__
 {-# INLINE shiftL_ #-}
 {-# INLINE shiftR_ #-}
+#if __GLASGOW_HASKELL__ >= 503
+shiftL_ n p = word2Int#((int2Word# n) `uncheckedShiftL#` p)
+#else
 shiftL_ n p = word2Int#((int2Word# n) `shiftL#` p)
+#endif
 shiftR_ n p = word2Int#((int2Word# n) `shiftr` p)
   where
-    shiftr x y = shiftRA# x y
+#if __GLASGOW_HASKELL__ >= 503
+    shiftr x y = uncheckedShiftRL# x y
+#else
+    shiftr x y = shiftRL# x y
+#endif
 
-#else {- not GHC -}
+#else /* not GHC */
 shiftL_ n p = n * (2 ^ p)
 shiftR_ n p = n `quot` (2 ^ p)
 
-#endif {- not GHC -}
+#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}