[project @ 1999-11-17 11:25:01 by simonmar]

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

diff --git a/ghc/compiler/utils/UniqFM.lhs b/ghc/compiler/utils/UniqFM.lhs
index 64ceff4..81d4bee 100644 (file)
--- a/ghc/compiler/utils/UniqFM.lhs
+++ b/ghc/compiler/utils/UniqFM.lhs
@@ -1,12 +1,12 @@
 %
-% (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@.)
 
@@ -36,12 +36,12 @@ module UniqFM (
        elemUFM,
        filterUFM,
        sizeUFM,
+       hashUFM,
        isNullUFM,
        lookupUFM, lookupUFM_Directly,
        lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
        eltsUFM, keysUFM,
-       ufmToList, 
-       FastString
+       ufmToList 
     ) where
 
 #include "HsVersions.h"
@@ -49,8 +49,9 @@ module UniqFM (
 import {-# SOURCE #-} Name     ( Name )
 
 import Unique          ( Uniquable(..), Unique, u2i, mkUniqueGrimily )
-import Util
+import Panic
 import GlaExts         -- Lots of Int# operations
+import Outputable
 
 #if ! OMIT_NATIVE_CODEGEN
 #define IF_NCG(a) a
@@ -65,7 +66,7 @@ import GlaExts                -- Lots of Int# operations
 %*                                                                     *
 %************************************************************************
 
-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
@@ -110,6 +111,7 @@ 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
@@ -197,17 +199,15 @@ data UniqFM ele
            (UniqFM ele)
            (UniqFM ele)
 
--- 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
 -}
 \end{code}
 
@@ -221,7 +221,7 @@ First the ways of building a UniqFM.
 
 \begin{code}
 emptyUFM                    = EmptyUFM
-unitUFM             key elt = mkLeafUFM (u2i (uniqueOf key)) elt
+unitUFM             key elt = mkLeafUFM (u2i (getUnique key)) elt
 unitDirectlyUFM key elt = mkLeafUFM (u2i key) elt
 
 listToUFM key_elt_pairs
@@ -244,13 +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 (uniqueOf 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 (uniqueOf 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
@@ -263,7 +263,7 @@ 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          fm key = delete fm (u2i (getUnique key))
 delFromUFM_Directly fm u   = delete fm (u2i u)
 
 delete EmptyUFM _   = EmptyUFM
@@ -530,21 +530,27 @@ 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 = case lookUp fm (u2i (uniqueOf key)) of
+elemUFM key fm = case lookUp fm (u2i (getUnique key)) of
                        Nothing -> False
                        Just _  -> True
 
-lookupUFM         fm key = lookUp fm (u2i (uniqueOf key))
+lookupUFM         fm key = lookUp fm (u2i (getUnique key))
 lookupUFM_Directly fm key = lookUp fm (u2i key)
 
 lookupWithDefaultUFM fm deflt key
-  = case lookUp fm (u2i (uniqueOf key)) of
+  = case lookUp fm (u2i (getUnique key)) of
       Nothing  -> deflt
       Just elt -> elt
 
@@ -799,7 +805,7 @@ shiftR_ :: FAST_INT -> FAST_INT -> FAST_INT
 shiftL_ n p = word2Int#((int2Word# n) `shiftL#` p)
 shiftR_ n p = word2Int#((int2Word# n) `shiftr` p)
   where
-    shiftr x y = shiftRA# x y
+    shiftr x y = shiftRL# x y
 
 #else {- not GHC -}
 shiftL_ n p = n * (2 ^ p)