-%
-% (c) The AQUA Project, Glasgow University, 1994-1996
+
+% (c) The AQUA Project, Glasgow University, 1994-1998
%
\section[FiniteMap]{An implementation of finite maps}
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
#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
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
-- (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
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
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
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}
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}
%************************************************************************
| 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}
= 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
%************************************************************************
%* *
-\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}
%* *
%************************************************************************
\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}