X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2Futils%2FUniqFM.lhs;h=124d6beac2b9d45331735d289e8e4c227eb3769f;hb=30d559930fff086ad3a8ef4162e7d748d1e96b70;hp=a2f48801a424fed1e301224f9ad63ebabf8a336f;hpb=e7498a3ee1d0484d02a9e86633cc179c76ebf36e;p=ghc-hetmet.git diff --git a/ghc/compiler/utils/UniqFM.lhs b/ghc/compiler/utils/UniqFM.lhs index a2f4880..124d6be 100644 --- a/ghc/compiler/utils/UniqFM.lhs +++ b/ghc/compiler/utils/UniqFM.lhs @@ -1,39 +1,28 @@ % -% (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, unitDirectlyUFM, listToUFM, listToUFM_Directly, - addToUFM, - addListToUFM, + addToUFM,addToUFM_C, + addListToUFM,addListToUFM_C, addToUFM_Directly, addListToUFM_Directly, - IF_NOT_GHC(addToUFM_C COMMA) - addListToUFM_C, delFromUFM, delFromUFM_Directly, delListFromUFM, @@ -41,34 +30,29 @@ module UniqFM ( plusUFM_C, minusUFM, intersectUFM, - IF_NOT_GHC(intersectUFM_C COMMA) - IF_NOT_GHC(foldUFM COMMA) + intersectUFM_C, + foldUFM, mapUFM, + elemUFM, filterUFM, sizeUFM, + hashUFM, isNullUFM, lookupUFM, lookupUFM_Directly, lookupWithDefaultUFM, lookupWithDefaultUFM_Directly, - eltsUFM, - ufmToList + eltsUFM, keysUFM, + ufmToList ) where -#if defined(COMPILING_GHC) -IMP_Ubiq(){-uitous-} -#endif +#include "HsVersions.h" -import Unique ( Unique, u2i, mkUniqueGrimily ) -import Util ---import Outputable ( Outputable(..), ExportFlag ) -import Pretty ( Pretty(..), PrettyRep ) -import PprStyle ( PprStyle ) -import SrcLoc ( SrcLoc ) - -#if ! OMIT_NATIVE_CODEGEN -#define IF_NCG(a) a -#else -#define IF_NCG(a) {--} -#endif +import {-# SOURCE #-} Name ( Name ) + +import Unique ( Uniquable(..), Unique, u2i, mkUniqueGrimily ) +import Panic +import GlaExts -- Lots of Int# operations +import FastTypes +import Outputable \end{code} %************************************************************************ @@ -77,7 +61,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 @@ -94,8 +78,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 @@ -119,6 +106,8 @@ mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2 filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt sizeUFM :: UniqFM elt -> Int +hashUFM :: 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 @@ -128,6 +117,7 @@ lookupWithDefaultUFM lookupWithDefaultUFM_Directly :: UniqFM elt -> elt -> Unique -> elt +keysUFM :: UniqFM elt -> [Int] -- Get the keys eltsUFM :: UniqFM elt -> [elt] ufmToList :: UniqFM elt -> [(Unique, elt)] \end{code} @@ -139,89 +129,31 @@ ufmToList :: UniqFM elt -> [(Unique, elt)] %************************************************************************ \begin{code} -#if 0 - -type IdFinMap elt = UniqFM elt -type TyVarFinMap elt = UniqFM elt -type NameFinMap elt = UniqFM elt -type RegFinMap elt = UniqFM elt +-- 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) {-# SPECIALIZE - unitUFM :: Id -> elt -> IdFinMap elt, - TyVar -> elt -> TyVarFinMap elt, - Name -> elt -> NameFinMap elt - IF_NCG(COMMA Reg -> elt -> RegFinMap elt) - #-} -{-# SPECIALIZE - listToUFM :: [(Id, elt)] -> IdFinMap elt, - [(TyVar,elt)] -> TyVarFinMap elt, - [(Name, elt)] -> NameFinMap elt - IF_NCG(COMMA [(Reg COMMA elt)] -> RegFinMap elt) - #-} -{-# SPECIALIZE - addToUFM :: IdFinMap elt -> Id -> elt -> IdFinMap elt, - TyVarFinMap elt -> TyVar -> elt -> TyVarFinMap elt, - NameFinMap elt -> Name -> elt -> NameFinMap elt - IF_NCG(COMMA RegFinMap elt -> Reg -> elt -> RegFinMap elt) + addListToUFM :: UniqFM elt -> [(Name, elt)] -> UniqFM elt #-} {-# SPECIALIZE - addListToUFM :: IdFinMap elt -> [(Id, elt)] -> IdFinMap elt, - TyVarFinMap elt -> [(TyVar,elt)] -> TyVarFinMap elt, - NameFinMap elt -> [(Name,elt)] -> NameFinMap elt - IF_NCG(COMMA RegFinMap elt -> [(Reg COMMA elt)] -> RegFinMap elt) + addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name, elt)] -> UniqFM elt #-} {-# SPECIALIZE - addToUFM_C :: (elt -> elt -> elt) - -> IdFinMap elt -> Id -> elt -> IdFinMap elt, - (elt -> elt -> elt) - -> TyVarFinMap elt -> TyVar -> elt -> TyVarFinMap elt, - (elt -> elt -> elt) - -> NameFinMap elt -> Name -> elt -> NameFinMap elt - IF_NCG(COMMA (elt -> elt -> elt) - -> RegFinMap elt -> Reg -> elt -> RegFinMap elt) + addToUFM :: UniqFM elt -> Unique -> elt -> UniqFM elt #-} {-# SPECIALIZE - addListToUFM_C :: (elt -> elt -> elt) - -> IdFinMap elt -> [(Id,elt)] -> IdFinMap elt, - (elt -> elt -> elt) - -> TyVarFinMap elt -> [(TyVar,elt)] -> TyVarFinMap elt, - (elt -> elt -> elt) - -> NameFinMap elt -> [(Name,elt)] -> NameFinMap elt - IF_NCG(COMMA (elt -> elt -> elt) - -> RegFinMap elt -> [(Reg COMMA elt)] -> RegFinMap elt) + listToUFM :: [(Unique, elt)] -> UniqFM elt #-} {-# SPECIALIZE - delFromUFM :: IdFinMap elt -> Id -> IdFinMap elt, - TyVarFinMap elt -> TyVar -> TyVarFinMap elt, - NameFinMap elt -> Name -> NameFinMap elt - IF_NCG(COMMA RegFinMap elt -> Reg -> RegFinMap elt) - #-} -{-# SPECIALIZE - delListFromUFM :: IdFinMap elt -> [Id] -> IdFinMap elt, - TyVarFinMap elt -> [TyVar] -> TyVarFinMap elt, - NameFinMap elt -> [Name] -> NameFinMap elt - IF_NCG(COMMA RegFinMap elt -> [Reg] -> RegFinMap elt) - #-} - -{-# SPECIALIZE - lookupUFM :: IdFinMap elt -> Id -> Maybe elt, - TyVarFinMap elt -> TyVar -> Maybe elt, - NameFinMap elt -> Name -> Maybe elt - IF_NCG(COMMA RegFinMap elt -> Reg -> Maybe elt) - #-} -{-# SPECIALIZE - lookupWithDefaultUFM - :: IdFinMap elt -> elt -> Id -> elt, - TyVarFinMap elt -> elt -> TyVar -> elt, - NameFinMap elt -> elt -> Name -> elt - IF_NCG(COMMA RegFinMap elt -> elt -> Reg -> elt) + lookupUFM :: UniqFM elt -> Name -> Maybe elt + , UniqFM elt -> Unique -> Maybe elt #-} #endif {- __GLASGOW_HASKELL__ -} -#endif {- 0 -} +#endif \end{code} %************************************************************************ @@ -256,27 +188,25 @@ First, the DataType itself; which is either a Node, a Leaf, or an Empty. \begin{code} data UniqFM ele = EmptyUFM - | LeafUFM FAST_INT ele - | NodeUFM FAST_INT -- the switching - FAST_INT -- the delta + | LeafUFM FastInt ele + | NodeUFM FastInt -- the switching + FastInt -- the delta (UniqFM ele) (UniqFM ele) -class Uniquable a where - uniqueOf :: a -> Unique - --- for debugging only :-) {- -instance Text (UniqFM a) where - showsPrec _ (NodeUFM a b t1 t2) = - showString "NodeUFM " . shows (IBOX(a)) - . showString " " . shows (IBOX(b)) - . showString " (" . shows t1 - . showString ") (" . shows t2 - . showString ")" - showsPrec _ (LeafUFM x a) = showString "LeafUFM " . shows (IBOX(x)) - showsPrec _ (EmptyUFM) = id +-- for debugging only :-) +instance Outputable (UniqFM a) where + ppr(NodeUFM a b t1 t2) = + sep [text "NodeUFM " <+> int IBOX(a) <+> int IBOX(b), + nest 1 (parens (ppr t1)), + nest 1 (parens (ppr t2))] + ppr (LeafUFM x a) = text "LeafUFM " <+> int IBOX(x) + ppr (EmptyUFM) = empty -} +-- and when not debugging the package itself... +instance Outputable a => Outputable (UniqFM a) where + ppr ufm = ppr (ufmToList ufm) \end{code} %************************************************************************ @@ -289,7 +219,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 @@ -312,13 +242,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 @@ -331,7 +261,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 @@ -340,11 +270,11 @@ delete fm key = del_ele fm del_ele :: UniqFM a -> UniqFM a del_ele lf@(LeafUFM j _) - | j _EQ_ key = EmptyUFM + | j ==# key = EmptyUFM | otherwise = lf -- no delete! del_ele nd@(NodeUFM j p t1 t2) - | j _GT_ key + | j ># key = mkSLNodeUFM (NodeUFMData j p) (del_ele t1) t2 | otherwise = mkLSNodeUFM (NodeUFMData j p) t1 (del_ele t2) @@ -441,8 +371,8 @@ minusUFM fm1 fm2 = minus_trees fm1 fm2 -- -- Notice the asymetry of subtraction -- - minus_trees lf@(LeafUFM i a) t2 = - case lookup t2 i of + minus_trees lf@(LeafUFM i a) t2 = + case lookUp t2 i of Nothing -> lf Just b -> EmptyUFM @@ -513,12 +443,12 @@ intersectUFM_C f _ EmptyUFM = EmptyUFM intersectUFM_C f fm1 fm2 = intersect_trees fm1 fm2 where intersect_trees (LeafUFM i a) t2 = - case lookup t2 i of + case lookUp t2 i of Nothing -> EmptyUFM Just b -> mkLeafUFM i (f a b) intersect_trees t1 (LeafUFM i a) = - case lookup t1 i of + case lookUp t1 i of Nothing -> EmptyUFM Just b -> mkLeafUFM i (f b a) @@ -573,9 +503,12 @@ intersectUFM_C f fm1 fm2 = intersect_trees fm1 fm2 Now the usual set of `collection' operators, like map, fold, etc. \begin{code} -foldUFM fn a EmptyUFM = a -foldUFM fn a fm = fold_tree fn a fm +foldUFM f a (NodeUFM _ _ t1 t2) = foldUFM f (foldUFM f a t2) t1 +foldUFM f a (LeafUFM _ obj) = f obj a +foldUFM f a EmptyUFM = a +\end{code} +\begin{code} mapUFM fn EmptyUFM = EmptyUFM mapUFM fn fm = map_tree fn fm @@ -595,35 +528,45 @@ sizeUFM (LeafUFM _ _) = 1 isNullUFM EmptyUFM = True isNullUFM _ = False + +-- hashing is used in VarSet.uniqAway, and should be fast +-- We use a cheap and cheerful method for now +hashUFM EmptyUFM = 0 +hashUFM (NodeUFM n _ _ _) = iBox n +hashUFM (LeafUFM n _) = iBox n \end{code} 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)) -lookupUFM_Directly fm key = lookup fm (u2i 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 lookupWithDefaultUFM_Directly fm deflt key - = case lookup fm (u2i key) of + = case lookUp fm (u2i key) of Nothing -> deflt Just elt -> elt -lookup EmptyUFM _ = Nothing -lookup fm i = lookup_tree fm +lookUp EmptyUFM _ = Nothing +lookUp fm i = lookup_tree fm where lookup_tree :: UniqFM a -> Maybe a lookup_tree (LeafUFM j b) - | j _EQ_ i = Just b + | j ==# i = Just b | otherwise = Nothing lookup_tree (NodeUFM j p t1 t2) - | j _GT_ i = lookup_tree t1 + | j ># i = lookup_tree t1 | otherwise = lookup_tree t2 lookup_tree EmptyUFM = panic "lookup Failed" @@ -632,17 +575,15 @@ lookup fm i = lookup_tree fm folds are *wonderful* things. \begin{code} -eltsUFM EmptyUFM = [] -eltsUFM fm = fold_tree (:) [] fm +eltsUFM fm = foldUFM (:) [] fm -ufmToList EmptyUFM = [] -ufmToList fm - = fold_tree (\ iu elt rest -> (mkUniqueGrimily iu, elt) : rest) [] fm - where - fold_tree f a (NodeUFM _ _ t1 t2) = fold_tree f (fold_tree f a t2) t1 - fold_tree f a (LeafUFM iu obj) = f iu obj a +ufmToList fm = fold_tree (\ iu elt rest -> (mkUniqueGrimily iu, elt) : rest) [] fm + +keysUFM fm = fold_tree (\ iu elt rest -> iBox iu : rest) [] fm - fold_tree f a EmptyUFM = panic "Should Never fold over an EmptyUFM" +fold_tree f a (NodeUFM _ _ t1 t2) = fold_tree f (fold_tree f a t2) t1 +fold_tree f a (LeafUFM iu obj) = f iu obj a +fold_tree f a EmptyUFM = a \end{code} %************************************************************************ @@ -663,7 +604,7 @@ If in doubt, use mkSSNodeUFM, which has the `strongest' functionality, but may do a few needless evaluations. \begin{code} -mkLeafUFM :: FAST_INT -> a -> UniqFM a +mkLeafUFM :: FastInt -> a -> UniqFM a mkLeafUFM i a = LeafUFM i a -- The *ONLY* ways of building a NodeUFM. @@ -671,21 +612,21 @@ mkLeafUFM i a = LeafUFM i a mkSSNodeUFM (NodeUFMData j p) EmptyUFM t2 = t2 mkSSNodeUFM (NodeUFMData j p) t1 EmptyUFM = t1 mkSSNodeUFM (NodeUFMData j p) t1 t2 - = ASSERT(correctNodeUFM (IBOX(j)) (IBOX(p)) t1 t2) + = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2) NodeUFM j p t1 t2 mkSLNodeUFM (NodeUFMData j p) EmptyUFM t2 = t2 mkSLNodeUFM (NodeUFMData j p) t1 t2 - = ASSERT(correctNodeUFM (IBOX(j)) (IBOX(p)) t1 t2) + = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2) NodeUFM j p t1 t2 mkLSNodeUFM (NodeUFMData j p) t1 EmptyUFM = t1 mkLSNodeUFM (NodeUFMData j p) t1 t2 - = ASSERT(correctNodeUFM (IBOX(j)) (IBOX(p)) t1 t2) + = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2) NodeUFM j p t1 t2 mkLLNodeUFM (NodeUFMData j p) t1 t2 - = ASSERT(correctNodeUFM (IBOX(j)) (IBOX(p)) t1 t2) + = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2) NodeUFM j p t1 t2 correctNodeUFM @@ -699,9 +640,9 @@ correctNodeUFM j p t1 t2 = correct (j-p) (j-1) p t1 && correct j ((j-1)+p) p t2 where correct low high _ (LeafUFM i _) - = low <= IBOX(i) && IBOX(i) <= high + = low <= iBox i && iBox i <= high correct low high above_p (NodeUFM j p _ _) - = low <= IBOX(j) && IBOX(j) <= high && above_p > IBOX(p) + = low <= iBox j && iBox j <= high && above_p > iBox p correct _ _ _ EmptyUFM = panic "EmptyUFM stored inside a tree" \end{code} @@ -712,20 +653,20 @@ and if necessary do $\lambda$ lifting on our functions that are bound. insert_ele :: (a -> a -> a) -> UniqFM a - -> FAST_INT + -> FastInt -> a -> UniqFM a insert_ele f EmptyUFM i new = mkLeafUFM i new insert_ele f (LeafUFM j old) i new - | j _GT_ i = + | j ># i = mkLLNodeUFM (getCommonNodeUFMData (indexToRoot i) (indexToRoot j)) (mkLeafUFM i new) (mkLeafUFM j old) - | j _EQ_ i = mkLeafUFM j (f old new) + | j ==# i = mkLeafUFM j (f old new) | otherwise = mkLLNodeUFM (getCommonNodeUFMData (indexToRoot i) @@ -734,8 +675,8 @@ insert_ele f (LeafUFM j old) i new (mkLeafUFM i new) insert_ele f n@(NodeUFM j p t1 t2) i a - | i _LT_ j - = if (i _GE_ (j _SUB_ p)) + | i <# j + = if (i >=# (j -# p)) then mkSLNodeUFM (NodeUFMData j p) (insert_ele f t1 i a) t2 else mkLLNodeUFM (getCommonNodeUFMData (indexToRoot i) @@ -743,7 +684,7 @@ insert_ele f n@(NodeUFM j p t1 t2) i a (mkLeafUFM i a) n | otherwise - = if (i _LE_ ((j _SUB_ ILIT(1)) _ADD_ p)) + = if (i <=# ((j -# _ILIT(1)) +# p)) then mkLSNodeUFM (NodeUFMData j p) t1 (insert_ele f t2 i a) else mkLLNodeUFM (getCommonNodeUFMData (indexToRoot i) @@ -752,14 +693,7 @@ insert_ele f n@(NodeUFM j p t1 t2) i a (mkLeafUFM i a) \end{code} -This has got a left to right ordering. -\begin{code} -fold_tree f a (NodeUFM _ _ t1 t2) = fold_tree f (fold_tree f a t2) t1 -fold_tree f a (LeafUFM _ obj) = f obj a - -fold_tree f a EmptyUFM = panic "Should Never fold over an EmptyUFM" -\end{code} \begin{code} map_tree f (NodeUFM j p t1 t2) @@ -777,6 +711,7 @@ filter_tree f nd@(NodeUFM j p t1 t2) filter_tree f lf@(LeafUFM i obj) | f obj = lf | otherwise = EmptyUFM +filter_tree f _ = panic "filter_tree failed" \end{code} %************************************************************************ @@ -792,8 +727,8 @@ consumer use. \begin{code} data NodeUFMData - = NodeUFMData FAST_INT - FAST_INT + = NodeUFMData FastInt + FastInt \end{code} This is the information used when computing new NodeUFMs. @@ -811,43 +746,43 @@ data CommonRoot This specifies the relationship between NodeUFMData and CalcNodeUFMData. \begin{code} -indexToRoot :: FAST_INT -> NodeUFMData +indexToRoot :: FastInt -> NodeUFMData indexToRoot i = let - l = (ILIT(1) :: FAST_INT) + l = (_ILIT(1) :: FastInt) in - NodeUFMData (((i `shiftR_` l) `shiftL_` l) _ADD_ ILIT(1)) l + NodeUFMData (((i `shiftR_` l) `shiftL_` l) +# _ILIT(1)) l getCommonNodeUFMData :: NodeUFMData -> NodeUFMData -> NodeUFMData getCommonNodeUFMData (NodeUFMData i p) (NodeUFMData i2 p2) - | p _EQ_ p2 = getCommonNodeUFMData_ p j j2 - | p _LT_ p2 = getCommonNodeUFMData_ p2 (j _QUOT_ (p2 _QUOT_ p)) j2 - | otherwise = getCommonNodeUFMData_ p j (j2 _QUOT_ (p _QUOT_ p2)) + | p ==# p2 = getCommonNodeUFMData_ p j j2 + | p <# p2 = getCommonNodeUFMData_ p2 (j `quotFastInt` (p2 `quotFastInt` p)) j2 + | otherwise = getCommonNodeUFMData_ p j (j2 `quotFastInt` (p `quotFastInt` p2)) where - l = (ILIT(1) :: FAST_INT) - j = i _QUOT_ (p `shiftL_` l) - j2 = i2 _QUOT_ (p2 `shiftL_` l) + l = (_ILIT(1) :: FastInt) + j = i `quotFastInt` (p `shiftL_` l) + j2 = i2 `quotFastInt` (p2 `shiftL_` l) - getCommonNodeUFMData_ :: FAST_INT -> FAST_INT -> FAST_INT -> NodeUFMData + getCommonNodeUFMData_ :: FastInt -> FastInt -> FastInt -> NodeUFMData getCommonNodeUFMData_ p j j_ - | j _EQ_ j_ - = NodeUFMData (((j `shiftL_` l) _ADD_ l) _MUL_ p) p + | j ==# j_ + = NodeUFMData (((j `shiftL_` l) +# l) *# p) p | otherwise = getCommonNodeUFMData_ (p `shiftL_` l) (j `shiftR_` l) (j_ `shiftR_` l) ask_about_common_ancestor :: NodeUFMData -> NodeUFMData -> CommonRoot ask_about_common_ancestor x@(NodeUFMData j p) y@(NodeUFMData j2 p2) - | j _EQ_ j2 = SameRoot + | j ==# j2 = SameRoot | otherwise = case getCommonNodeUFMData x y of nd@(NodeUFMData j3 p3) - | j3 _EQ_ j -> LeftRoot (decideSide (j _GT_ j2)) - | j3 _EQ_ j2 -> RightRoot (decideSide (j _LT_ j2)) - | otherwise -> NewRoot nd (j _GT_ j2) + | j3 ==# j -> LeftRoot (decideSide (j ># j2)) + | j3 ==# j2 -> RightRoot (decideSide (j <# j2)) + | otherwise -> NewRoot nd (j ># j2) where decideSide :: Bool -> Side decideSide True = Leftt @@ -859,8 +794,8 @@ This might be better in Util.lhs ? Now the bit twiddling functions. \begin{code} -shiftL_ :: FAST_INT -> FAST_INT -> FAST_INT -shiftR_ :: FAST_INT -> FAST_INT -> FAST_INT +shiftL_ :: FastInt -> FastInt -> FastInt +shiftR_ :: FastInt -> FastInt -> FastInt #if __GLASGOW_HASKELL__ {-# INLINE shiftL_ #-} @@ -868,7 +803,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) @@ -877,12 +812,7 @@ shiftR_ n p = n `quot` (2 ^ p) #endif {- not GHC -} \end{code} -Andy's extras: ToDo: to Util. - \begin{code} -use_fst :: a -> b -> a -use_fst a b = a - use_snd :: a -> b -> b use_snd a b = b \end{code}