X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FFiniteMap.lhs;h=319e386a8e9beb5abfe7002e798aac88ad6bf730;hb=3cbb4112ec0d75f517fb07ccb6ae42039686b757;hp=03f087a1fe55d1b8a77adb4a3ea334c200fd72bb;hpb=e7d21ee4f8ac907665a7e170c71d59e13a01da09;p=ghc-hetmet.git diff --git a/ghc/compiler/utils/FiniteMap.lhs b/ghc/compiler/utils/FiniteMap.lhs index 03f087a..319e386 100644 --- a/ghc/compiler/utils/FiniteMap.lhs +++ b/ghc/compiler/utils/FiniteMap.lhs @@ -1,5 +1,5 @@ % -% (c) The AQUA Project, Glasgow University, 1994-1995 +% (c) The AQUA Project, Glasgow University, 1994-1996 % \section[FiniteMap]{An implementation of finite maps} @@ -18,13 +18,17 @@ The code is SPECIALIZEd to various highly-desirable types (e.g., Id) near the end (only \tr{#ifdef COMPILING_GHC}). \begin{code} -#if defined(COMPILING_GHC) +#ifdef COMPILING_GHC #include "HsVersions.h" #define IF_NOT_GHC(a) {--} #else #define ASSERT(e) {--} #define IF_NOT_GHC(a) a #define COMMA , +#define _tagCmp compare +#define _LT LT +#define _GT GT +#define _EQ EQ #endif #if defined(COMPILING_GHC) && defined(DEBUG_FINITEMAPS)/* NB NB NB */ @@ -36,50 +40,59 @@ near the end (only \tr{#ifdef COMPILING_GHC}). module FiniteMap ( FiniteMap, -- abstract type - emptyFM, singletonFM, listToFM, + emptyFM, unitFM, listToFM, - addToFM, addListToFM, - IF_NOT_GHC(addToFM_C COMMA) + addToFM, + addToFM_C, + addListToFM, addListToFM_C, - IF_NOT_GHC(delFromFM COMMA) + delFromFM, delListFromFM, - plusFM, plusFM_C, - IF_NOT_GHC(intersectFM COMMA intersectFM_C COMMA) - minusFM, -- exported for GHCI only + plusFM, + plusFM_C, + minusFM, + foldFM, - IF_NOT_GHC(mapFM COMMA foldFM COMMA filterFM COMMA) + intersectFM, + intersectFM_C, + mapFM, filterFM, - IF_NOT_GHC(sizeFM COMMA) - isEmptyFM, elemFM, lookupFM, lookupWithDefaultFM, - - fmToList, keysFM, eltsFM{-used in GHCI-} + sizeFM, isEmptyFM, elemFM, lookupFM, lookupWithDefaultFM, -#if defined(COMPILING_GHC) - , FiniteSet(..), emptySet, mkSet, isEmptySet - , elementOf, setToList, union, minusSet{-exported for GHCI-} -#endif + fmToList, keysFM, eltsFM - -- To make it self-sufficient -#if __HASKELL1__ < 3 - , Maybe +#ifdef COMPILING_GHC + , bagToFM + , SYN_IE(FiniteSet), emptySet, mkSet, isEmptySet + , elementOf, setToList, union, minusSet #endif ) where -import Maybes - -#if defined(COMPILING_GHC) -import AbsUniType -import Pretty -import Outputable -import Util -import CLabelInfo ( CLabel ) -- for specialising -#if ! OMIT_NATIVE_CODEGEN -import AsmRegAlloc ( Reg ) -- ditto -#define IF_NCG(a) a +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201 +IMPORT_DELOOPER(SpecLoop) #else -#define IF_NCG(a) {--} +import {-# SOURCE #-} Name #endif + +#if __GLASGOW_HASKELL__ >= 202 +import GlaExts +#endif +#if defined(USE_FAST_STRINGS) +import FastString +#endif +import Maybes +import Bag ( Bag, foldrBag ) +import Outputable ( PprStyle, Outputable(..) ) +import Pretty ( Doc ) + +#ifdef COMPILING_GHC + +# if ! OMIT_NATIVE_CODEGEN +# define IF_NCG(a) a +# else +# define IF_NCG(a) {--} +# endif #endif -- SIGH: but we use unboxed "sizes"... @@ -100,9 +113,13 @@ import AsmRegAlloc ( Reg ) -- ditto \begin{code} -- BUILDING emptyFM :: FiniteMap key elt -singletonFM :: key -> elt -> FiniteMap key elt +unitFM :: key -> elt -> FiniteMap key elt listToFM :: (Ord key OUTPUTABLE_key) => [(key,elt)] -> FiniteMap key elt -- In the case of duplicates, the last is taken +#ifdef COMPILING_GHC +bagToFM :: (Ord key OUTPUTABLE_key) => Bag (key,elt) -> FiniteMap key elt + -- In the case of duplicates, who knows which is taken +#endif -- ADDING AND DELETING -- Throws away any previous binding @@ -113,10 +130,10 @@ addListToFM :: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> [(key,elt)] -> F -- Combines with previous binding addToFM_C :: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt) - -> FiniteMap key elt -> key -> elt + -> FiniteMap key elt -> key -> elt -> FiniteMap key elt addListToFM_C :: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt) - -> FiniteMap key elt -> [(key,elt)] + -> FiniteMap key elt -> [(key,elt)] -> FiniteMap key elt -- Deletion doesn't complain if you try to delete something @@ -130,20 +147,20 @@ plusFM :: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt -- Combines bindings for the same thing with the given function -plusFM_C :: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt) +plusFM_C :: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt) -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt minusFM :: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> 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 -> elt) - -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt +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 -- MAPPING, FOLDING, FILTERING foldFM :: (key -> elt -> a -> a) -> a -> FiniteMap key elt -> a mapFM :: (key -> elt1 -> elt2) -> FiniteMap key elt1 -> FiniteMap key elt2 -filterFM :: (Ord key OUTPUTABLE_key) => (key -> elt -> Bool) +filterFM :: (Ord key OUTPUTABLE_key) => (key -> elt -> Bool) -> FiniteMap key elt -> FiniteMap key elt -- INTERROGATING @@ -185,7 +202,7 @@ factor of at most \tr{sIZE_RATIO} \begin{code} data FiniteMap key elt - = EmptyFM + = EmptyFM | Branch key elt -- Key and elt stored here IF_GHC(Int#,Int{-STRICT-}) -- Size >= 1 (FiniteMap key elt) -- Children @@ -203,9 +220,13 @@ emptyFM -- #define EmptyFM (Branch _ _ IF_GHC(0#,0) _ _) -singletonFM key elt = Branch key elt IF_GHC(1#,1) emptyFM emptyFM +unitFM key elt = Branch key elt IF_GHC(1#,1) emptyFM emptyFM -listToFM key_elt_pairs = addListToFM emptyFM key_elt_pairs +listToFM = addListToFM emptyFM + +#ifdef COMPILING_GHC +bagToFM = foldrBag (\(k,v) fm -> addToFM fm k v) emptyFM +#endif \end{code} %************************************************************************ @@ -217,7 +238,7 @@ listToFM key_elt_pairs = addListToFM emptyFM key_elt_pairs \begin{code} addToFM fm key elt = addToFM_C (\ old new -> new) fm key elt -addToFM_C combiner EmptyFM key elt = singletonFM key elt +addToFM_C combiner EmptyFM key elt = unitFM key elt addToFM_C combiner (Branch key elt size fm_l fm_r) new_key new_elt #ifdef __GLASGOW_HASKELL__ = case _tagCmp new_key key of @@ -246,7 +267,7 @@ delFromFM (Branch key elt size fm_l fm_r) del_key _GT -> mkBalBranch key elt fm_l (delFromFM fm_r del_key) _LT -> mkBalBranch key elt (delFromFM fm_l del_key) fm_r _EQ -> glueBal fm_l fm_r -#else +#else | del_key > key = mkBalBranch key elt fm_l (delFromFM fm_r del_key) @@ -270,7 +291,7 @@ delListFromFM fm keys = foldl delFromFM fm keys plusFM_C combiner EmptyFM fm2 = fm2 plusFM_C combiner fm1 EmptyFM = fm1 plusFM_C combiner fm1 (Branch split_key elt2 _ left right) - = mkVBalBranch split_key new_elt + = mkVBalBranch split_key new_elt (plusFM_C combiner lts left) (plusFM_C combiner gts right) where @@ -308,7 +329,7 @@ intersectFM_C combiner fm1 (Branch split_key elt2 _ left right) | maybeToBool maybe_elt1 -- split_elt *is* in intersection = mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left) - (intersectFM_C combiner gts right) + (intersectFM_C combiner gts right) | otherwise -- split_elt is *not* in intersection = glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right) @@ -333,7 +354,7 @@ foldFM k z (Branch key elt _ fm_l fm_r) = foldFM k (k key elt (foldFM k z fm_r)) fm_l mapFM f EmptyFM = emptyFM -mapFM f (Branch key elt size fm_l fm_r) +mapFM f (Branch key elt size fm_l fm_r) = Branch key (f key elt) size (mapFM f fm_l) (mapFM f fm_r) filterFM p EmptyFM = emptyFM @@ -364,7 +385,7 @@ lookupFM (Branch key elt _ fm_l fm_r) key_to_find = case _tagCmp key_to_find key of _LT -> lookupFM fm_l key_to_find _GT -> lookupFM fm_r key_to_find - _EQ -> Just elt + _EQ -> Just elt #else | key_to_find < key = lookupFM fm_l key_to_find | key_to_find > key = lookupFM fm_r key_to_find @@ -406,7 +427,7 @@ eltsFM fm = foldFM (\ key elt rest -> elt : rest) [] fm @mkBranch@ simply gets the size component right. This is the ONLY (non-trivial) place the Branch object is built, so the ASSERTion recursively checks consistency. (The trivial use of Branch is in -@singletonFM@.) +@unitFM@.) \begin{code} sIZE_RATIO :: Int @@ -414,7 +435,7 @@ sIZE_RATIO = 5 mkBranch :: (Ord key OUTPUTABLE_key) -- Used for the assertion checking only => Int - -> key -> elt + -> key -> elt -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt @@ -422,7 +443,7 @@ mkBranch which key elt fm_l fm_r = --ASSERT( left_ok && right_ok && balance_ok ) #if defined(COMPILING_GHC) && defined(DEBUG_FINITEMAPS) if not ( left_ok && right_ok && balance_ok ) then - pprPanic ("mkBranch:"++show which) (ppAboves [ppr PprDebug [left_ok, right_ok, balance_ok], + pprPanic ("mkBranch:"++show which) (vcat [ppr PprDebug [left_ok, right_ok, balance_ok], ppr PprDebug key, ppr PprDebug fm_l, ppr PprDebug fm_r]) @@ -486,41 +507,41 @@ out of whack. \begin{code} mkBalBranch :: (Ord key OUTPUTABLE_key) - => key -> elt + => key -> elt -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt mkBalBranch key elt fm_L fm_R - | size_l + size_r < 2 + | size_l + size_r < 2 = mkBranch 1{-which-} key elt fm_L fm_R | size_r > sIZE_RATIO * size_l -- Right tree too big = case fm_R of - Branch _ _ _ fm_rl fm_rr + Branch _ _ _ fm_rl fm_rr | sizeFM fm_rl < 2 * sizeFM fm_rr -> single_L fm_L fm_R | otherwise -> double_L fm_L fm_R -- Other case impossible | size_l > sIZE_RATIO * size_r -- Left tree too big = case fm_L of - Branch _ _ _ fm_ll fm_lr + Branch _ _ _ fm_ll fm_lr | sizeFM fm_lr < 2 * sizeFM fm_ll -> single_R fm_L fm_R | otherwise -> double_R fm_L fm_R -- Other case impossible | otherwise -- No imbalance = mkBranch 2{-which-} key elt fm_L fm_R - + where size_l = sizeFM fm_L size_r = sizeFM fm_R - single_L fm_l (Branch key_r elt_r _ fm_rl fm_rr) + single_L fm_l (Branch key_r elt_r _ fm_rl fm_rr) = mkBranch 3{-which-} key_r elt_r (mkBranch 4{-which-} key elt fm_l fm_rl) fm_rr double_L fm_l (Branch key_r elt_r _ (Branch key_rl elt_rl _ fm_rll fm_rlr) fm_rr) - = mkBranch 5{-which-} key_rl elt_rl (mkBranch 6{-which-} key elt fm_l fm_rll) + = mkBranch 5{-which-} key_rl elt_rl (mkBranch 6{-which-} key elt fm_l fm_rll) (mkBranch 7{-which-} key_r elt_r fm_rlr fm_rr) single_R (Branch key_l elt_l _ fm_ll fm_lr) fm_r @@ -534,7 +555,7 @@ mkBalBranch key elt fm_L fm_R \begin{code} mkVBalBranch :: (Ord key OUTPUTABLE_key) - => key -> elt + => key -> elt -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt @@ -557,7 +578,7 @@ mkVBalBranch key elt fm_l@(Branch key_l elt_l _ fm_ll fm_lr) | otherwise = mkBranch 13{-which-} key elt fm_l fm_r - where + where size_l = sizeFM fm_l size_r = sizeFM fm_r \end{code} @@ -579,13 +600,13 @@ glueBal :: (Ord key OUTPUTABLE_key) glueBal EmptyFM fm2 = fm2 glueBal fm1 EmptyFM = fm1 -glueBal fm1 fm2 +glueBal fm1 fm2 -- The case analysis here (absent in Adams' program) is really to deal -- with the case where fm2 is a singleton. Then deleting the minimum means -- we pass an empty tree to mkBalBranch, which breaks its invariant. | sizeFM fm2 > sizeFM fm1 = mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2) - + | otherwise = mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2 where @@ -604,7 +625,7 @@ glueVBal :: (Ord key OUTPUTABLE_key) glueVBal EmptyFM fm2 = fm2 glueVBal fm1 EmptyFM = fm1 glueVBal fm_l@(Branch key_l elt_l _ fm_ll fm_lr) - fm_r@(Branch key_r elt_r _ fm_rl fm_rr) + fm_r@(Branch key_r elt_r _ fm_rl fm_rr) | sIZE_RATIO * size_l < size_r = mkBalBranch key_r elt_r (glueVBal fm_l fm_rl) fm_rr @@ -630,7 +651,6 @@ glueVBal fm_l@(Branch key_l elt_l _ fm_ll fm_lr) splitLT, splitGT :: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> key -> FiniteMap key elt -- splitLT fm split_key = fm restricted to keys < split_key --- splitGE fm split_key = fm restricted to keys >= split_key (UNUSED) -- splitGT fm split_key = fm restricted to keys > split_key splitLT EmptyFM split_key = emptyFM @@ -646,21 +666,6 @@ splitLT (Branch key elt _ fm_l fm_r) split_key | otherwise = fm_l #endif -{- UNUSED: -splitGE EmptyFM split_key = emptyFM -splitGE (Branch key elt _ fm_l fm_r) split_key -#ifdef __GLASGOW_HASKELL__ - = case _tagCmp split_key key of - _GT -> splitGE fm_r split_key - _LT -> mkVBalBranch key elt (splitGE fm_l split_key) fm_r - _EQ -> mkVBalBranch key elt emptyFM fm_r -#else - | split_key > key = splitGE fm_r split_key - | split_key < key = mkVBalBranch key elt (splitGE fm_l split_key) fm_r - | otherwise = mkVBalBranch key elt emptyFM fm_r -#endif --} - splitGT EmptyFM split_key = emptyFM splitGT (Branch key elt _ fm_l fm_r) split_key #ifdef __GLASGOW_HASKELL__ @@ -698,22 +703,28 @@ deleteMax (Branch key elt _ fm_l fm_r) = mkBalBranch key elt fm_l (deleteMax %************************************************************************ \begin{code} -#if defined(COMPILING_GHC) - -{- this is the real one actually... -instance (Outputable key, Outputable elt) => Outputable (FiniteMap key elt) where - ppr sty fm = ppr sty (fmToList fm) --} +#if defined(COMPILING_GHC) && defined(DEBUG_FINITEMAPS) --- temp debugging (ToDo: rm) instance (Outputable key) => Outputable (FiniteMap key elt) where ppr sty fm = pprX sty fm -pprX sty EmptyFM = ppChar '!' +pprX sty EmptyFM = char '!' pprX sty (Branch key elt sz fm_l fm_r) - = ppBesides [ppLparen, pprX sty fm_l, ppSP, - ppr sty key, ppSP, ppInt (IF_GHC(I# sz, sz)), ppSP, - pprX sty fm_r, ppRparen] + = parens (hcat [pprX sty fm_l, space, + ppr sty key, space, int (IF_GHC(I# sz, sz)), space, + pprX sty fm_r]) +#endif + +#ifndef COMPILING_GHC +instance (Eq key, Eq elt) => Eq (FiniteMap key elt) where + fm_1 == fm_2 = (sizeFM fm_1 == sizeFM fm_2) && -- quick test + (fmToList fm_1 == fmToList fm_2) + +{- NO: not clear what The Right Thing to do is: +instance (Ord key, Ord elt) => Ord (FiniteMap key elt) where + fm_1 <= fm_2 = (sizeFM fm_1 <= sizeFM fm_2) && -- quick test + (fmToList fm_1 <= fmToList fm_2) +-} #endif \end{code} @@ -724,7 +735,7 @@ pprX sty (Branch key elt sz fm_l fm_r) %************************************************************************ \begin{code} -#if defined(COMPILING_GHC) +#ifdef COMPILING_GHC type FiniteSet key = FiniteMap key () emptySet :: FiniteSet key @@ -756,94 +767,64 @@ When the FiniteMap module is used in GHC, we specialise it for \tr{Uniques}, for dastardly efficiency reasons. \begin{code} -#if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ - -- the __GLASGOW_HASKELL__ chk avoids an hbc 0.999.7 bug +#if defined(COMPILING_GHC) && __GLASGOW_HASKELL__ && !defined(REALLY_HASKELL_1_3) -{-# SPECIALIZE listToFM - :: [(Int,elt)] -> FiniteMap Int elt, - [(CLabel,elt)] -> FiniteMap CLabel elt, - [(FAST_STRING,elt)] -> FiniteMap FAST_STRING elt, - [((FAST_STRING,FAST_STRING),elt)] -> FiniteMap (FAST_STRING, FAST_STRING) elt - IF_NCG(COMMA [(Reg COMMA elt)] -> FiniteMap Reg elt) - #-} -{-# SPECIALIZE addToFM - :: FiniteMap Int elt -> Int -> elt -> FiniteMap Int elt, - FiniteMap FAST_STRING elt -> FAST_STRING -> elt -> FiniteMap FAST_STRING elt, - FiniteMap CLabel elt -> CLabel -> elt -> FiniteMap CLabel elt - IF_NCG(COMMA FiniteMap Reg elt -> Reg -> elt -> FiniteMap Reg elt) - #-} {-# SPECIALIZE addListToFM - :: FiniteMap Int elt -> [(Int,elt)] -> FiniteMap Int elt, - FiniteMap CLabel elt -> [(CLabel,elt)] -> FiniteMap CLabel elt + :: FiniteMap (FAST_STRING, 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) #-} -{-NOT EXPORTED!! # SPECIALIZE addToFM_C - :: (elt -> elt -> elt) -> FiniteMap Int elt -> Int -> elt -> FiniteMap Int elt, - (elt -> elt -> elt) -> FiniteMap CLabel elt -> CLabel -> elt -> FiniteMap CLabel elt - IF_NCG(COMMA (elt -> elt -> elt) -> FiniteMap Reg elt -> Reg -> elt -> FiniteMap Reg elt) - #-} {-# SPECIALIZE addListToFM_C - :: (elt -> elt -> elt) -> FiniteMap Int elt -> [(Int,elt)] -> FiniteMap Int elt, - (elt -> elt -> elt) -> FiniteMap TyCon elt -> [(TyCon,elt)] -> FiniteMap TyCon elt, - (elt -> elt -> elt) -> FiniteMap CLabel elt -> [(CLabel,elt)] -> FiniteMap CLabel elt + :: (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 IF_NCG(COMMA (elt -> elt -> elt) -> FiniteMap Reg elt -> [(Reg COMMA elt)] -> FiniteMap Reg elt) #-} -{-NOT EXPORTED!!! # SPECIALIZE delFromFM - :: FiniteMap Int elt -> Int -> FiniteMap Int elt, - FiniteMap CLabel elt -> CLabel -> FiniteMap CLabel elt - IF_NCG(COMMA FiniteMap Reg elt -> Reg -> FiniteMap Reg elt) - #-} -{-# SPECIALIZE delListFromFM - :: FiniteMap Int elt -> [Int] -> FiniteMap Int elt, - FiniteMap CLabel elt -> [CLabel] -> FiniteMap CLabel elt - IF_NCG(COMMA FiniteMap Reg elt -> [Reg] -> 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 RdrName elt -> RdrName -> elt -> FiniteMap RdrName elt + IF_NCG(COMMA FiniteMap Reg elt -> Reg -> elt -> FiniteMap Reg elt) #-} -{-# SPECIALIZE elemFM - :: FAST_STRING -> FiniteMap FAST_STRING elt -> Bool +{-# 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 + IF_NCG(COMMA (elt -> elt -> elt) -> FiniteMap Reg elt -> Reg -> elt -> FiniteMap Reg elt) #-} -{-not EXPORTED!!! # SPECIALIZE filterFM - :: (Int -> elt -> Bool) -> FiniteMap Int elt -> FiniteMap Int elt, - (CLabel -> elt -> Bool) -> FiniteMap CLabel elt -> FiniteMap CLabel elt - IF_NCG(COMMA (Reg -> elt -> Bool) -> FiniteMap Reg elt -> FiniteMap Reg elt) +{-# SPECIALIZE bagToFM + :: Bag (FAST_STRING,elt) -> FiniteMap FAST_STRING elt #-} -{-NOT EXPORTED!!! # SPECIALIZE intersectFM - :: FiniteMap Int elt -> FiniteMap Int elt -> FiniteMap Int elt, - FiniteMap CLabel elt -> FiniteMap CLabel elt -> FiniteMap CLabel elt - IF_NCG(COMMA FiniteMap Reg elt -> FiniteMap Reg elt -> FiniteMap Reg elt) +{-# SPECIALIZE delListFromFM + :: FiniteMap RdrName elt -> [RdrName] -> FiniteMap RdrName elt + , FiniteMap FAST_STRING elt -> [FAST_STRING] -> FiniteMap FAST_STRING elt + IF_NCG(COMMA FiniteMap Reg elt -> [Reg] -> FiniteMap Reg elt) #-} -{-not EXPORTED !!!# SPECIALIZE intersectFM_C - :: (elt -> elt -> elt) -> FiniteMap Int elt -> FiniteMap Int elt -> FiniteMap Int elt, - (elt -> elt -> elt) -> FiniteMap CLabel elt -> FiniteMap CLabel elt -> FiniteMap CLabel elt - IF_NCG(COMMA (elt -> elt -> elt) -> FiniteMap Reg elt -> FiniteMap Reg elt -> 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 + IF_NCG(COMMA [(Reg COMMA elt)] -> FiniteMap Reg elt) #-} {-# SPECIALIZE lookupFM - :: FiniteMap Int elt -> Int -> Maybe elt, - FiniteMap CLabel elt -> CLabel -> Maybe elt, - FiniteMap FAST_STRING elt -> FAST_STRING -> Maybe elt, - FiniteMap (FAST_STRING,FAST_STRING) elt -> (FAST_STRING,FAST_STRING) -> Maybe elt + :: 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 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 Int elt -> elt -> Int -> elt, - FiniteMap CLabel elt -> elt -> CLabel -> elt + :: FiniteMap FAST_STRING elt -> elt -> FAST_STRING -> elt IF_NCG(COMMA FiniteMap Reg elt -> elt -> Reg -> elt) #-} -{-# SPECIALIZE minusFM - :: FiniteMap Int elt -> FiniteMap Int elt -> FiniteMap Int elt, - FiniteMap TyCon elt -> FiniteMap TyCon elt -> FiniteMap TyCon elt, - FiniteMap FAST_STRING elt -> FiniteMap FAST_STRING elt -> FiniteMap FAST_STRING elt, - FiniteMap CLabel elt -> FiniteMap CLabel elt -> FiniteMap CLabel elt - IF_NCG(COMMA FiniteMap Reg elt -> FiniteMap Reg elt -> FiniteMap Reg elt) - #-} {-# SPECIALIZE plusFM - :: FiniteMap Int elt -> FiniteMap Int elt -> FiniteMap Int elt, - FiniteMap TyCon elt -> FiniteMap TyCon elt -> FiniteMap TyCon elt, - FiniteMap CLabel elt -> FiniteMap CLabel elt -> FiniteMap CLabel elt + :: FiniteMap RdrName elt -> FiniteMap RdrName elt -> FiniteMap RdrName elt + , FiniteMap FAST_STRING 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 Int elt -> FiniteMap Int elt -> FiniteMap Int elt, - (elt -> elt -> elt) -> FiniteMap CLabel elt -> FiniteMap CLabel elt -> FiniteMap CLabel elt + :: (elt -> elt -> elt) -> FiniteMap FAST_STRING elt -> FiniteMap FAST_STRING elt -> FiniteMap FAST_STRING elt IF_NCG(COMMA (elt -> elt -> elt) -> FiniteMap Reg elt -> FiniteMap Reg elt -> FiniteMap Reg elt) #-}