X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Futils%2FUniqFM.lhs;h=59158f38b2be2618af4cd1a2da761997759bc0d3;hp=2a02dc728d5e0437333bdcbef39c939d263ce61e;hb=206b4dec78250efef3cd927d64dc6cbc54a16c3d;hpb=49e265f1e3e1aef2f0d7b8f25eb50e268b16c8cc

diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs
index 2a02dc7..59158f3 100644
--- a/compiler/utils/UniqFM.lhs
+++ b/compiler/utils/UniqFM.lhs
@@ -1,7 +1,9 @@
-%ilter
+%
+% (c) The University of Glasgow 2006
 % (c) The AQUA Project, Glasgow University, 1994-1998
 %
-\section[UniqFM]{Specialised finite maps, for things with @Uniques@}
+
+UniqFM: Specialised finite maps, for things with @Uniques@
 
 Based on @FiniteMaps@ (as you would expect).
 
@@ -11,8 +13,10 @@ Basically, the things need to be in class @Uniquable@, and we use the
 (A similar thing to @UniqSet@, as opposed to @Set@.)
 
 \begin{code}
+{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
 module UniqFM (
-	UniqFM,   -- abstract type
+	UniqFM(..),   	-- abstract type
+			-- (de-abstracted for MachRegs.trivColorable optimisation BL 2007/09)
 
 	emptyUFM,
 	unitUFM,
@@ -32,7 +36,7 @@ module UniqFM (
 	intersectsUFM,
 	intersectUFM,
 	intersectUFM_C,
-	foldUFM,
+	foldUFM, foldUFM_Directly,
 	mapUFM,
 	elemUFM, elemUFM_Directly,
 	filterUFM, filterUFM_Directly,
@@ -47,12 +51,10 @@ module UniqFM (
 
 #include "HsVersions.h"
 
-import Unique		( Uniquable(..), Unique, getKey#, mkUniqueGrimily )
+import Unique		( Uniquable(..), Unique, getKeyFastInt, mkUniqueGrimily )
 import Maybes		( maybeToBool )
 import FastTypes
 import Outputable
-
-import GLAEXTS		-- Lots of Int# operations
 \end{code}
 
 %************************************************************************
@@ -75,6 +77,7 @@ listToUFM_Directly
 
 addToUFM	:: Uniquable key => UniqFM elt -> key -> elt  -> UniqFM elt
 addListToUFM	:: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
+addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
 addToUFM_Directly
 		:: UniqFM elt -> Unique -> elt -> UniqFM elt
 
@@ -111,6 +114,7 @@ intersectUFM_C	:: (elt1 -> elt2 -> 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
 mapUFM		:: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
 filterUFM	:: (elt -> Bool) -> UniqFM elt -> UniqFM elt
 filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
@@ -231,8 +235,8 @@ First the ways of building a UniqFM.
 
 \begin{code}
 emptyUFM		     = EmptyUFM
-unitUFM	     key elt = mkLeafUFM (getKey# (getUnique key)) elt
-unitDirectlyUFM key elt = mkLeafUFM (getKey# key) elt
+unitUFM	     key elt = mkLeafUFM (getKeyFastInt (getUnique key)) elt
+unitDirectlyUFM key elt = mkLeafUFM (getKeyFastInt key) elt
 
 listToUFM key_elt_pairs
   = addListToUFM_C use_snd EmptyUFM key_elt_pairs
@@ -251,13 +255,13 @@ 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 (getKey# u) elt
+addToUFM_Directly fm u elt = insert_ele use_snd fm (getKeyFastInt u) elt
 
 addToUFM_C combiner fm key elt
-  = insert_ele combiner fm (getKey# (getUnique key)) elt
+  = insert_ele combiner fm (getKeyFastInt (getUnique key)) elt
 
 addToUFM_Acc add unit fm key item
-  = insert_ele combiner fm (getKey# (getUnique key)) (unit item)
+  = insert_ele combiner fm (getKeyFastInt (getUnique key)) (unit item)
   where
     combiner old _unit_item = add item old
 
@@ -265,11 +269,12 @@ 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 (getKey# (getUnique k)) e)
+ = 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 (getKey# k) e)
+ = foldl (\ fm (k, e) -> insert_ele combiner fm (getKeyFastInt k) e)
 	 fm uniq_elt_pairs
 \end{code}
 
@@ -278,9 +283,10 @@ Now ways of removing things from UniqFM.
 \begin{code}
 delListFromUFM fm lst = foldl delFromUFM fm lst
 
-delFromUFM          fm key = delete fm (getKey# (getUnique key))
-delFromUFM_Directly fm u   = delete fm (getKey# u)
+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
@@ -290,7 +296,7 @@ delete fm       key = del_ele fm
       | j ==# key	= EmptyUFM
       | otherwise	= lf	-- no delete!
 
-    del_ele nd@(NodeUFM j p t1 t2)
+    del_ele (NodeUFM j p t1 t2)
       | j ># key
       = mkSLNodeUFM (NodeUFMData j p) (del_ele t1) t2
       | otherwise
@@ -304,8 +310,8 @@ Now ways of adding two UniqFM's together.
 \begin{code}
 plusUFM tr1 tr2 = plusUFM_C use_snd tr1 tr2
 
-plusUFM_C f EmptyUFM tr	= tr
-plusUFM_C f tr EmptyUFM	= tr
+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
@@ -388,10 +394,10 @@ minusUFM fm1 fm2     = minus_trees fm1 fm2
 	--
 	-- Notice the asymetry of subtraction
 	--
-	minus_trees lf@(LeafUFM i a) t2 =
+	minus_trees lf@(LeafUFM i _a) t2 =
 		case lookUp t2 i of
 		  Nothing -> lf
-		  Just b -> EmptyUFM
+		  Just _ -> EmptyUFM
 
 	minus_trees t1 (LeafUFM i _) = delete t1 i
 
@@ -410,7 +416,7 @@ minusUFM fm1 fm2     = minus_trees fm1 fm2
 		--
 		-- Fast, Ehh !
 		--
-	  minus_branches (NewRoot nd _) = left_t
+	  minus_branches (NewRoot _ _) = left_t
 
 		-- Now, if j == j':
 		--
@@ -456,8 +462,8 @@ And taking the intersection of two UniqFM's.
 intersectUFM  t1 t2 = intersectUFM_C use_snd t1 t2
 intersectsUFM t1 t2 = isNullUFM (intersectUFM_C (\ _ _ -> error "urk") t1 t2)
 
-intersectUFM_C f EmptyUFM _ = EmptyUFM
-intersectUFM_C f _ EmptyUFM = EmptyUFM
+intersectUFM_C _ EmptyUFM _ = EmptyUFM
+intersectUFM_C _ _ EmptyUFM = EmptyUFM
 intersectUFM_C f fm1 fm2    = intersect_trees fm1 fm2
     where
 	intersect_trees (LeafUFM i a) t2 =
@@ -484,7 +490,7 @@ intersectUFM_C f fm1 fm2    = intersect_trees fm1 fm2
 		--
 		-- Fast, Ehh !
 		--
-	  intersect_branches (NewRoot nd _) = EmptyUFM
+	  intersect_branches (NewRoot _nd _) = EmptyUFM
 
 		-- Now, if j == j':
 		--
@@ -515,7 +521,7 @@ intersectUFM_C f fm1 fm2    = intersect_trees fm1 fm2
 	  intersect_branches (RightRoot Rightt)
 	    = intersect_trees left_t t2'
 
-	intersect_trees x y = panic ("EmptyUFM found when intersecting trees")
+	intersect_trees _ _ = panic ("EmptyUFM found when intersecting trees")
 \end{code}
 
 Now the usual set of `collection' operators, like map, fold, etc.
@@ -523,20 +529,18 @@ 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 f a EmptyUFM	        = a
+foldUFM _ a EmptyUFM	        = a
 \end{code}
 
 \begin{code}
-mapUFM fn EmptyUFM    = EmptyUFM
-mapUFM fn fm	      = map_tree fn fm
+mapUFM _fn EmptyUFM   = EmptyUFM
+mapUFM  fn fm	      = map_tree fn fm
 
-filterUFM fn EmptyUFM = EmptyUFM
-filterUFM fn fm	      = filter_tree pred fm
-	where
-	  pred (i::FastInt) e = fn e
+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
+filterUFM_Directly _fn EmptyUFM = EmptyUFM
+filterUFM_Directly  fn fm       = filter_tree pred fm
 	where
 	  pred i e = fn (mkUniqueGrimily (iBox i)) e
 \end{code}
@@ -568,19 +572,20 @@ Lookup up a binary tree is easy (and fast).
 elemUFM          key fm = maybeToBool (lookupUFM fm key)
 elemUFM_Directly key fm = maybeToBool (lookupUFM_Directly fm key)
 
-lookupUFM	   fm key = lookUp fm (getKey# (getUnique key))
-lookupUFM_Directly fm key = lookUp fm (getKey# key)
+lookupUFM	   fm key = lookUp fm (getKeyFastInt (getUnique key))
+lookupUFM_Directly fm key = lookUp fm (getKeyFastInt key)
 
 lookupWithDefaultUFM fm deflt key
-  = case lookUp fm (getKey# (getUnique key)) of
+  = case lookUp fm (getKeyFastInt (getUnique key)) of
       Nothing  -> deflt
       Just elt -> elt
 
 lookupWithDefaultUFM_Directly fm deflt key
-  = case lookUp fm (getKey# key) of
+  = 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
@@ -589,7 +594,7 @@ lookUp fm i	    = lookup_tree fm
 	lookup_tree (LeafUFM j b)
 	  | j ==# i	= Just b
 	  | otherwise	= Nothing
-	lookup_tree (NodeUFM j p t1 t2)
+	lookup_tree (NodeUFM j _ t1 t2)
 	  | j ># i	= lookup_tree t1
 	  | otherwise	= lookup_tree t2
 
@@ -599,15 +604,15 @@ lookUp fm i	    = lookup_tree fm
 folds are *wonderful* things.
 
 \begin{code}
-eltsUFM fm = foldUFM (:) [] fm
-
-ufmToList fm = fold_tree (\ iu elt rest -> (mkUniqueGrimily (iBox iu), elt) : rest) [] fm
-
-keysUFM fm = fold_tree (\ iu elt rest -> mkUniqueGrimily (iBox iu) : rest) [] fm
+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 f a EmptyUFM		  = a
+fold_tree _ a EmptyUFM		  = a
 \end{code}
 
 %************************************************************************
@@ -633,18 +638,21 @@ mkLeafUFM i a	  = LeafUFM i a
 
 -- The *ONLY* ways of building a NodeUFM.
 
-mkSSNodeUFM (NodeUFMData j p) EmptyUFM t2 = t2
-mkSSNodeUFM (NodeUFMData j p) t1 EmptyUFM = t1
+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 j p) EmptyUFM t2 = 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 j p) t1 EmptyUFM = t1
+mkLSNodeUFM (NodeUFMData _ _) t1 EmptyUFM = t1
 mkLSNodeUFM (NodeUFMData j p) t1 t2
   = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
     NodeUFM j p t1 t2
@@ -681,9 +689,9 @@ insert_ele
 	-> a
 	-> UniqFM a
 
-insert_ele f EmptyUFM i new = mkLeafUFM i new
+insert_ele _f EmptyUFM i new = mkLeafUFM i new
 
-insert_ele f (LeafUFM j old) i new
+insert_ele  f (LeafUFM j old) i new
   | j ># i =
 	  mkLLNodeUFM (getCommonNodeUFMData
 			  (indexToRoot i)
@@ -720,23 +728,24 @@ insert_ele f n@(NodeUFM j p t1 t2) i a
 
 
 \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 f _ = panic "map_tree failed"
+map_tree _ _ = panic "map_tree failed"
 \end{code}
 
 \begin{code}
 filter_tree :: (FastInt -> a -> Bool) -> UniqFM a -> UniqFM a
-filter_tree f nd@(NodeUFM j p t1 t2)
+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 f _ = panic "filter_tree failed"
+filter_tree _ _ = panic "filter_tree failed"
 \end{code}
 
 %************************************************************************
@@ -774,10 +783,7 @@ This specifies the relationship between NodeUFMData and CalcNodeUFMData.
 indexToRoot :: FastInt -> NodeUFMData
 
 indexToRoot i
-  = let
-	l = (_ILIT(1) :: FastInt)
-    in
-    NodeUFMData (((i `shiftR_` l) `shiftL_` l) +# _ILIT(1)) l
+  = NodeUFMData ((shiftL1 (shiftR1 i)) +# _ILIT(1)) (_ILIT(1))
 
 getCommonNodeUFMData :: NodeUFMData -> NodeUFMData -> NodeUFMData
 
@@ -786,25 +792,24 @@ getCommonNodeUFMData (NodeUFMData i p) (NodeUFMData i2 p2)
   | p <# p2	= getCommonNodeUFMData_ p2 (j `quotFastInt` (p2 `quotFastInt` p)) j2
   | otherwise	= getCommonNodeUFMData_ p j (j2 `quotFastInt` (p `quotFastInt` p2))
   where
-    l  = (_ILIT(1) :: FastInt)
-    j  = i  `quotFastInt` (p  `shiftL_` l)
-    j2 = i2 `quotFastInt` (p2 `shiftL_` l)
+    j  = i  `quotFastInt` (shiftL1 p)
+    j2 = i2 `quotFastInt` (shiftL1 p2)
 
     getCommonNodeUFMData_ :: FastInt -> FastInt -> FastInt -> NodeUFMData
 
     getCommonNodeUFMData_ p j j_
       | j ==# j_
-      = NodeUFMData (((j `shiftL_` l) +# l) *# p) p
+      = NodeUFMData (((shiftL1 j) +# _ILIT(1)) *# p) p
       | otherwise
-      = getCommonNodeUFMData_ (p `shiftL_`  l) (j `shiftR_` l) (j_ `shiftR_` l)
+      = 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)
+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)
+      nd@(NodeUFMData j3 _p3)
 	| j3 ==# j  -> LeftRoot (decideSide (j ># j2))
 	| j3 ==# j2 -> RightRoot (decideSide (j <# j2))
 	| otherwise   -> NewRoot nd (j ># j2)
@@ -819,33 +824,22 @@ This might be better in Util.lhs ?
 
 Now the bit twiddling functions.
 \begin{code}
-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
-#if __GLASGOW_HASKELL__ >= 503
-    shiftr x y = uncheckedShiftRL# x y
-#else
-    shiftr x y = shiftRL# x y
-#endif
+shiftL1 :: FastInt -> FastInt
+shiftR1 :: FastInt -> FastInt
 
-#else /* not GHC */
-shiftL_ n p = n * (2 ^ p)
-shiftR_ n p = n `quot` (2 ^ p)
+{-# INLINE shiftL1 #-}
+{-# INLINE shiftR1 #-}
 
-#endif /* not GHC */
+shiftL1 n = n `shiftLFastInt` _ILIT(1)
+shiftR1 n = n `shiftR_FastInt` _ILIT(1)
 \end{code}
 
 \begin{code}
 use_snd :: a -> b -> b
-use_snd a b = b
+use_snd _ b = b
+\end{code}
+
+\begin{code}
+_unused :: FS.FastString
+_unused = undefined
 \end{code}