X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FUniqFM.lhs;h=d0b3d9d90b8627a289cbffae3afbb7b3834970f2;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=1cd56ffbed378c422f695b7f379e7762fb7e67d1;hpb=9d17c6e892b13ada62bb00b4fd720ab6edb14734;p=ghc-hetmet.git diff --git a/ghc/compiler/utils/UniqFM.lhs b/ghc/compiler/utils/UniqFM.lhs index 1cd56ff..d0b3d9d 100644 --- a/ghc/compiler/utils/UniqFM.lhs +++ b/ghc/compiler/utils/UniqFM.lhs @@ -1,27 +1,18 @@ % -% (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@.) \begin{code} -#if defined(COMPILING_GHC) -#include "HsVersions.h" -#define IF_NOT_GHC(a) {--} -#else -#define ASSERT(e) {--} -#define IF_NOT_GHC(a) a -#endif - module UniqFM ( UniqFM, -- abstract type - Uniquable(..), -- class to go with it emptyUFM, unitUFM, @@ -39,36 +30,27 @@ module UniqFM ( plusUFM_C, minusUFM, intersectUFM, - IF_NOT_GHC(intersectUFM_C COMMA) - IF_NOT_GHC(foldUFM COMMA) + intersectUFM_C, + foldUFM, mapUFM, + elemUFM, filterUFM, sizeUFM, isNullUFM, lookupUFM, lookupUFM_Directly, lookupWithDefaultUFM, lookupWithDefaultUFM_Directly, eltsUFM, keysUFM, - ufmToList -#if defined(COMPILING_GHC) - ,FAST_STRING -#endif + ufmToList, + FastString ) where -IMP_Ubiq() +#include "HsVersions.h" -#if defined(COMPILING_GHC) -# if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201 -IMPORT_DELOOPER( SpecLoop ) -# else -import {-# SOURCE #-} Name -# endif -#endif +import {-# SOURCE #-} Name ( Name ) -import Unique ( Unique, u2i, mkUniqueGrimily ) +import Unique ( Uniquable(..), Unique, u2i, mkUniqueGrimily ) import Util -import Pretty ( Doc ) -import Outputable ( PprStyle, Outputable(..) ) -import SrcLoc ( SrcLoc ) +import GlaExts -- Lots of Int# operations #if ! OMIT_NATIVE_CODEGEN #define IF_NCG(a) a @@ -83,7 +65,7 @@ import SrcLoc ( SrcLoc ) %* * %************************************************************************ -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 @@ -100,8 +82,11 @@ addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt addToUFM_Directly :: UniqFM elt -> Unique -> elt -> UniqFM elt -addToUFM_C :: Uniquable key => (elt -> elt -> elt) - -> UniqFM elt -> key -> elt -> UniqFM elt +addToUFM_C :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result + -> UniqFM elt -- old + -> key -> elt -- new + -> UniqFM elt -- result + addListToUFM_C :: Uniquable key => (elt -> elt -> elt) -> UniqFM elt -> [(key,elt)] -> UniqFM elt @@ -125,6 +110,7 @@ mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2 filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt sizeUFM :: UniqFM elt -> Int +elemUFM :: Uniquable key => key -> UniqFM elt -> Bool lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt lookupUFM_Directly -- when you've got the Unique already @@ -146,6 +132,9 @@ ufmToList :: UniqFM elt -> [(Unique, elt)] %************************************************************************ \begin{code} +-- Turn off for now, these need to be updated (SDM 4/98) + +#if 0 #ifdef __GLASGOW_HASKELL__ -- I don't think HBC was too happy about this (WDP 94/10) @@ -167,6 +156,7 @@ ufmToList :: UniqFM elt -> [(Unique, elt)] #-} #endif {- __GLASGOW_HASKELL__ -} +#endif \end{code} %************************************************************************ @@ -207,9 +197,6 @@ data UniqFM ele (UniqFM ele) (UniqFM ele) -class Uniquable a where - uniqueOf :: a -> Unique - -- for debugging only :-) {- instance Text (UniqFM a) where @@ -234,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 @@ -257,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 @@ -276,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 @@ -549,11 +536,15 @@ 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} -lookupUFM fm key = lookUp fm (u2i (uniqueOf key)) +elemUFM key fm = case lookUp fm (u2i (getUnique key)) of + Nothing -> False + Just _ -> True + +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 @@ -808,7 +799,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)