[project @ 2005-03-03 11:48:02 by chak]

[ghc-hetmet.git] / ghc / compiler / utils / UniqFM.lhs

diff --git a/ghc/compiler/utils/UniqFM.lhs b/ghc/compiler/utils/UniqFM.lhs
index 7b27322..aa357b8 100644 (file)
--- a/ghc/compiler/utils/UniqFM.lhs
+++ b/ghc/compiler/utils/UniqFM.lhs
@@ -1,4 +1,4 @@
-%
+%ilter
 % (c) The AQUA Project, Glasgow University, 1994-1998
 %
 \section[UniqFM]{Specialised finite maps, for things with @Uniques@}
@@ -34,7 +34,7 @@ module UniqFM (
        foldUFM,
        mapUFM,
        elemUFM,
-       filterUFM,
+       filterUFM, filterUFM_Directly,
        sizeUFM,
        hashUFM,
        isNullUFM,
@@ -46,13 +46,12 @@ module UniqFM (
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} Name     ( Name )
-
-import Unique          ( Uniquable(..), Unique, getKey, mkUniqueGrimily )
+import Unique          ( Uniquable(..), Unique, getKey#, mkUniqueGrimily )
 import Panic
-import GlaExts         -- Lots of Int# operations
 import FastTypes
 import Outputable
+
+import GLAEXTS         -- Lots of Int# operations
 \end{code}
 
 %************************************************************************
@@ -104,6 +103,7 @@ intersectUFM_C      :: (elt1 -> elt2 -> elt3)
 foldUFM                :: (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
 
 sizeUFM                :: UniqFM elt -> Int
 hashUFM                :: UniqFM elt -> Int
@@ -152,7 +152,7 @@ ufmToList   :: UniqFM elt -> [(Unique, elt)]
                 , UniqFM elt -> Unique -> Maybe elt
   #-}
 
-#endif {- __GLASGOW_HASKELL__ -}
+#endif /* __GLASGOW_HASKELL__ */
 #endif
 \end{code}
 
@@ -193,6 +193,7 @@ data UniqFM ele
            FastInt         -- the delta
            (UniqFM ele)
            (UniqFM ele)
+-- INVARIANT: the children of a NodeUFM are never EmptyUFMs
 
 {-
 -- for debugging only :-)
@@ -219,8 +220,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 (getKey# (getUnique key)) elt
+unitDirectlyUFM key elt = mkLeafUFM (getKey# key) elt
 
 listToUFM key_elt_pairs
   = addListToUFM_C use_snd EmptyUFM key_elt_pairs
@@ -239,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 (getKey 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 (getKey (getUnique 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 (getKey (getUnique 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 (getKey k) e)
+ = foldl (\ fm (k, e) -> insert_ele combiner fm (getKey# k) e)
         fm uniq_elt_pairs
 \end{code}
 
@@ -261,8 +262,8 @@ 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 (getKey# (getUnique key))
+delFromUFM_Directly fm u   = delete fm (getKey# u)
 
 delete EmptyUFM _   = EmptyUFM
 delete fm       key = del_ele fm
@@ -513,7 +514,14 @@ mapUFM fn EmptyUFM    = EmptyUFM
 mapUFM fn fm         = map_tree fn fm
 
 filterUFM fn EmptyUFM = EmptyUFM
-filterUFM fn fm              = filter_tree fn fm
+filterUFM fn fm              = filter_tree pred fm
+       where
+         pred (i::FastInt) e = fn e
+
+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
@@ -540,20 +548,20 @@ 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 = case lookUp fm (getKey (getUnique key)) of
+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)
+lookupUFM         fm key = lookUp fm (getKey# (getUnique key))
+lookupUFM_Directly fm key = lookUp fm (getKey# key)
 
 lookupWithDefaultUFM fm deflt key
-  = case lookUp fm (getKey (getUnique key)) of
+  = case lookUp fm (getKey# (getUnique key)) of
       Nothing  -> deflt
       Just elt -> elt
 
 lookupWithDefaultUFM_Directly fm deflt key
-  = case lookUp fm (getKey key) of
+  = case lookUp fm (getKey# key) of
       Nothing  -> deflt
       Just elt -> elt
 
@@ -577,9 +585,9 @@ folds are *wonderful* things.
 \begin{code}
 eltsUFM fm = foldUFM (:) [] fm
 
-ufmToList fm = fold_tree (\ iu elt rest -> (mkUniqueGrimily iu, elt) : rest) [] fm
+ufmToList fm = fold_tree (\ iu elt rest -> (mkUniqueGrimily (iBox iu), elt) : rest) [] fm
 
-keysUFM fm = fold_tree (\ iu elt rest -> mkUniqueGrimily iu : rest) [] fm
+keysUFM fm = fold_tree (\ iu elt rest -> mkUniqueGrimily (iBox 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
@@ -705,11 +713,12 @@ map_tree f _ = 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)
   = mkSSNodeUFM (NodeUFMData j p) (filter_tree f t1) (filter_tree f t2)
 
 filter_tree f lf@(LeafUFM i obj)
-  | f obj = lf
+  | f i obj = lf
   | otherwise = EmptyUFM
 filter_tree f _ = panic "filter_tree failed"
 \end{code}
@@ -813,11 +822,11 @@ shiftR_ n p = word2Int#((int2Word# n) `shiftr` p)
     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}
 
 \begin{code}