[project @ 2001-03-01 15:59:51 by simonmar]

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

diff --git a/ghc/compiler/utils/FiniteMap.lhs b/ghc/compiler/utils/FiniteMap.lhs
index cf08d7c..c2c34fb 100644 (file)
--- a/ghc/compiler/utils/FiniteMap.lhs
+++ b/ghc/compiler/utils/FiniteMap.lhs
@@ -1,5 +1,5 @@
-%
-% (c) The AQUA Project, Glasgow University, 1994-1996
+
+% (c) The AQUA Project, Glasgow University, 1994-1998
 %
 \section[FiniteMap]{An implementation of finite maps}
 
@@ -45,8 +45,6 @@ module FiniteMap (
        fmToList, keysFM, eltsFM
 
        , bagToFM
-       , FiniteSet, emptySet, mkSet, isEmptySet
-       , elementOf, setToList, union, minusSet
 
     ) where
 
@@ -59,11 +57,10 @@ module FiniteMap (
 #define OUTPUTABLE_key {--}
 #endif
 
-import {-# SOURCE #-} Name
 import GlaExts
-import FastString
 import Maybes
 import Bag       ( Bag, foldrBag )
+import Util
 import Outputable
 
 #if ! OMIT_NATIVE_CODEGEN
@@ -105,6 +102,7 @@ addToFM             :: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> key -> elt  -> Fini
 addListToFM    :: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> [(key,elt)] -> FiniteMap key elt
 
                   -- Combines with previous binding
+                  -- The combining fn goes (old -> new -> new)
 addToFM_C      :: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt)
                           -> FiniteMap key elt -> key -> elt
                           -> FiniteMap key elt
@@ -130,8 +128,8 @@ minusFM             :: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt -
                   -- (minusFM a1 a2) deletes from a1 any bindings which are bound in a2
 
 intersectFM    :: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
-intersectFM_C  :: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt2)
-                          -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt2
+intersectFM_C  :: (Ord key OUTPUTABLE_key) => (elt1 -> elt2 -> elt3)
+                          -> FiniteMap key elt1 -> FiniteMap key elt2 -> FiniteMap key elt3
 
 --     MAPPING, FOLDING, FILTERING
 foldFM         :: (key -> elt -> a -> a) -> a -> FiniteMap key elt -> a
@@ -223,7 +221,7 @@ addToFM_C combiner (Branch key elt size fm_l fm_r) new_key new_elt
 addListToFM fm key_elt_pairs = addListToFM_C (\ old new -> new) fm key_elt_pairs
 
 addListToFM_C combiner fm key_elt_pairs
-  = foldl add fm key_elt_pairs -- foldl adds from the left
+  = foldl' add fm key_elt_pairs        -- foldl adds from the left
   where
     add fmap (key,elt) = addToFM_C combiner fmap key elt
 \end{code}
@@ -236,7 +234,7 @@ delFromFM (Branch key elt size fm_l fm_r) del_key
        LT -> mkBalBranch key elt (delFromFM fm_l del_key) fm_r
        EQ -> glueBal fm_l fm_r
 
-delListFromFM fm keys = foldl delFromFM fm keys
+delListFromFM fm keys = foldl' delFromFM fm keys
 \end{code}
 
 %************************************************************************
@@ -588,8 +586,6 @@ glueVBal fm_l@(Branch key_l elt_l _ fm_ll fm_lr)
   | otherwise          -- We now need the same two cases as in glueBal above.
   = glueBal fm_l fm_r
   where
-    (mid_key_l,mid_elt_l) = findMax fm_l
-    (mid_key_r,mid_elt_r) = findMin fm_r
     size_l = sizeFM fm_l
     size_r = sizeFM fm_r
 \end{code}
@@ -654,6 +650,10 @@ pprX (Branch key elt sz fm_l fm_r)
  = parens (hcat [pprX fm_l, space,
                      ppr key, space, int (IF_GHC(I# sz, sz)), space,
                      pprX fm_r])
+#else
+-- and when not debugging the package itself...
+instance (Outputable key, Outputable elt) => Outputable (FiniteMap key elt) where
+    ppr fm = ppr (fmToList fm)
 #endif
 
 #if 0
@@ -671,32 +671,6 @@ instance (Ord key, Ord elt) => Ord (FiniteMap key elt) where
 
 %************************************************************************
 %*                                                                     *
-\subsection{FiniteSets---a thin veneer}
-%*                                                                     *
-%************************************************************************
-
-\begin{code}
-type FiniteSet key = FiniteMap key ()
-emptySet       :: FiniteSet key
-mkSet          :: (Ord key OUTPUTABLE_key) => [key] -> FiniteSet key
-isEmptySet     :: FiniteSet key -> Bool
-elementOf      :: (Ord key OUTPUTABLE_key) => key -> FiniteSet key -> Bool
-minusSet       :: (Ord key OUTPUTABLE_key) => FiniteSet key -> FiniteSet key -> FiniteSet key
-setToList      :: FiniteSet key -> [key]
-union          :: (Ord key OUTPUTABLE_key) => FiniteSet key -> FiniteSet key -> FiniteSet key
-
-emptySet = emptyFM
-mkSet xs = listToFM [ (x, ()) | x <- xs]
-isEmptySet = isEmptyFM
-elementOf = elemFM
-minusSet  = minusFM
-setToList = keysFM
-union = plusFM
-
-\end{code}
-
-%************************************************************************
-%*                                                                     *
 \subsection{Efficiency pragmas for GHC}
 %*                                                                     *
 %************************************************************************
@@ -705,7 +679,9 @@ When the FiniteMap module is used in GHC, we specialise it for
 \tr{Uniques}, for dastardly efficiency reasons.
 
 \begin{code}
-#if __GLASGOW_HASKELL__ && !defined(REALLY_HASKELL_1_3)
+#if 0
+
+#if __GLASGOW_HASKELL__
 
 {-# SPECIALIZE addListToFM
                :: FiniteMap (FAST_STRING, FAST_STRING) elt -> [((FAST_STRING, FAST_STRING),elt)] -> FiniteMap (FAST_STRING, FAST_STRING) elt
@@ -767,4 +743,6 @@ When the FiniteMap module is used in GHC, we specialise it for
     #-}
 
 #endif {- compiling with ghc and have specialiser -}
+
+#endif {- 0 -}
 \end{code}