X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FFiniteMap.lhs;h=9168d3656f60006255f6651f89e31aefc3cbca9f;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=432d4f2cf9db793459e0d81b114dc6b25a522f4b;hpb=9dd6e1c216993624a2cd74b62ca0f0569c02c26b;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/FiniteMap.lhs b/ghc/compiler/utils/FiniteMap.lhs
index 432d4f2..9168d36 100644
--- 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}
 
@@ -38,15 +38,13 @@ module FiniteMap (
 
 	intersectFM,
 	intersectFM_C,
-	mapFM, filterFM,
+	mapFM, filterFM, 
 
 	sizeFM, isEmptyFM, elemFM, lookupFM, lookupWithDefaultFM,
 
 	fmToList, keysFM, eltsFM
 
 	, bagToFM
-	, FiniteSet, emptySet, mkSet, isEmptySet
-	, elementOf, setToList, union, minusSet
 
     ) where
 
@@ -59,13 +57,13 @@ module FiniteMap (
 #define OUTPUTABLE_key {--}
 #endif
 
-import {-# SOURCE #-} Name
-import GlaExts
-import FastString
 import Maybes
 import Bag	  ( Bag, foldrBag )
+import Util
 import Outputable
 
+import GLAEXTS
+
 #if ! OMIT_NATIVE_CODEGEN
 #  define IF_NCG(a) a
 #else
@@ -105,6 +103,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 +129,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
@@ -139,6 +138,7 @@ mapFM		:: (key -> elt1 -> elt2) -> FiniteMap key elt1 -> FiniteMap key elt2
 filterFM	:: (Ord key OUTPUTABLE_key) => (key -> elt -> Bool)
 			   -> FiniteMap key elt -> FiniteMap key elt
 
+
 --	INTERROGATING
 sizeFM		:: FiniteMap key elt -> Int
 isEmptyFM	:: FiniteMap key elt -> Bool
@@ -194,7 +194,7 @@ emptyFM
     bottom = panic "emptyFM"
 -}
 
--- #define EmptyFM (Branch _ _ IF_GHC(0#,0) _ _)
+--  #define EmptyFM (Branch _ _ IF_GHC(0#,0) _ _)
 
 unitFM key elt = Branch key elt IF_GHC(1#,1) emptyFM emptyFM
 
@@ -222,7 +222,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}
@@ -235,7 +235,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}
 
 %************************************************************************
@@ -587,8 +587,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}
@@ -653,6 +651,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
@@ -670,32 +672,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}
 %*									*
 %************************************************************************
@@ -704,66 +680,70 @@ 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
+		:: FiniteMap (FastString, FAST_STRING) elt -> [((FAST_STRING, FAST_STRING),elt)] -> FiniteMap (FAST_STRING, FAST_STRING) elt
 		 , FiniteMap RdrName elt -> [(RdrName,elt)] -> FiniteMap RdrName elt
     IF_NCG(COMMA   FiniteMap Reg elt -> [(Reg COMMA elt)] -> FiniteMap Reg elt)
     #-}
 {-# SPECIALIZE addListToFM_C
 		:: (elt -> elt -> elt) -> FiniteMap TyCon elt -> [(TyCon,elt)] -> FiniteMap TyCon elt
-		 , (elt -> elt -> elt) -> FiniteMap FAST_STRING elt -> [(FAST_STRING,elt)] -> FiniteMap FAST_STRING elt
+		 , (elt -> elt -> elt) -> FiniteMap FastString elt -> [(FAST_STRING,elt)] -> FiniteMap FAST_STRING elt
     IF_NCG(COMMA   (elt -> elt -> elt) -> FiniteMap Reg elt -> [(Reg COMMA elt)] -> FiniteMap Reg elt)
     #-}
 {-# SPECIALIZE addToFM
 		:: FiniteMap CLabel elt -> CLabel -> elt  -> FiniteMap CLabel elt
-		 , FiniteMap FAST_STRING elt -> FAST_STRING -> elt  -> FiniteMap FAST_STRING elt
-		 , FiniteMap (FAST_STRING, FAST_STRING) elt -> (FAST_STRING, FAST_STRING) -> elt  -> FiniteMap (FAST_STRING, FAST_STRING) elt
+		 , FiniteMap FastString elt -> FAST_STRING -> elt  -> FiniteMap FAST_STRING elt
+		 , FiniteMap (FastString, FAST_STRING) elt -> (FAST_STRING, FAST_STRING) -> elt  -> FiniteMap (FAST_STRING, FAST_STRING) elt
 		 , FiniteMap RdrName elt -> RdrName -> elt  -> FiniteMap RdrName elt
     IF_NCG(COMMA   FiniteMap Reg elt -> Reg -> elt  -> FiniteMap Reg elt)
     #-}
 {-# SPECIALIZE addToFM_C
 		:: (elt -> elt -> elt) -> FiniteMap (RdrName, RdrName) elt -> (RdrName, RdrName) -> elt -> FiniteMap (RdrName, RdrName) elt
-		 , (elt -> elt -> elt) -> FiniteMap FAST_STRING elt -> FAST_STRING -> elt -> FiniteMap FAST_STRING elt
+		 , (elt -> elt -> elt) -> FiniteMap FastString elt -> FAST_STRING -> elt -> FiniteMap FAST_STRING elt
     IF_NCG(COMMA   (elt -> elt -> elt) -> FiniteMap Reg elt -> Reg -> elt -> FiniteMap Reg elt)
     #-}
 {-# SPECIALIZE bagToFM
-		:: Bag (FAST_STRING,elt) -> FiniteMap FAST_STRING elt
+		:: Bag (FastString,elt) -> FiniteMap FAST_STRING elt
     #-}
 {-# SPECIALIZE delListFromFM
 		:: FiniteMap RdrName elt -> [RdrName]   -> FiniteMap RdrName elt
-		 , FiniteMap FAST_STRING elt -> [FAST_STRING]   -> FiniteMap FAST_STRING elt
+		 , FiniteMap FastString elt -> [FAST_STRING]   -> FiniteMap FAST_STRING elt
     IF_NCG(COMMA   FiniteMap Reg elt -> [Reg]   -> FiniteMap Reg elt)
     #-}
 {-# SPECIALIZE listToFM
 		:: [([Char],elt)] -> FiniteMap [Char] elt
-		 , [(FAST_STRING,elt)] -> FiniteMap FAST_STRING elt
-		 , [((FAST_STRING,FAST_STRING),elt)] -> FiniteMap (FAST_STRING, FAST_STRING) elt
+		 , [(FastString,elt)] -> FiniteMap FAST_STRING elt
+		 , [((FastString,FAST_STRING),elt)] -> FiniteMap (FAST_STRING, FAST_STRING) elt
     IF_NCG(COMMA   [(Reg COMMA elt)] -> FiniteMap Reg elt)
     #-}
 {-# SPECIALIZE lookupFM
 		:: FiniteMap CLabel elt -> CLabel -> Maybe elt
 		 , FiniteMap [Char] elt -> [Char] -> Maybe elt
-		 , FiniteMap FAST_STRING elt -> FAST_STRING -> Maybe elt
-		 , FiniteMap (FAST_STRING,FAST_STRING) elt -> (FAST_STRING,FAST_STRING) -> Maybe elt
+		 , FiniteMap FastString elt -> FAST_STRING -> Maybe elt
+		 , FiniteMap (FastString,FAST_STRING) elt -> (FAST_STRING,FAST_STRING) -> Maybe elt
 		 , FiniteMap RdrName elt -> RdrName -> Maybe elt
 		 , FiniteMap (RdrName,RdrName) elt -> (RdrName,RdrName) -> Maybe elt
     IF_NCG(COMMA   FiniteMap Reg elt -> Reg -> Maybe elt)
     #-}
 {-# SPECIALIZE lookupWithDefaultFM
-		:: FiniteMap FAST_STRING elt -> elt -> FAST_STRING -> elt
+		:: FiniteMap FastString elt -> elt -> FAST_STRING -> elt
     IF_NCG(COMMA   FiniteMap Reg elt -> elt -> Reg -> elt)
     #-}
 {-# SPECIALIZE plusFM
 		:: FiniteMap RdrName elt -> FiniteMap RdrName elt -> FiniteMap RdrName elt
-		 , FiniteMap FAST_STRING elt -> FiniteMap FAST_STRING elt -> FiniteMap FAST_STRING elt
+		 , FiniteMap FastString elt -> FiniteMap FAST_STRING elt -> FiniteMap FAST_STRING elt
     IF_NCG(COMMA   FiniteMap Reg elt -> FiniteMap Reg elt -> FiniteMap Reg elt)
     #-}
 {-# SPECIALIZE plusFM_C
-		:: (elt -> elt -> elt) -> FiniteMap FAST_STRING elt -> FiniteMap FAST_STRING elt -> FiniteMap FAST_STRING elt
+		:: (elt -> elt -> elt) -> FiniteMap FastString elt -> FiniteMap FAST_STRING elt -> FiniteMap FAST_STRING elt
     IF_NCG(COMMA   (elt -> elt -> elt) -> FiniteMap Reg elt -> FiniteMap Reg elt -> FiniteMap Reg elt)
     #-}
 
-#endif {- compiling with ghc and have specialiser -}
+#endif /* compiling with ghc and have specialiser */
+
+#endif /* 0 */
 \end{code}