2 % (c) The University of Glasgow 2006
3 % (c) The AQUA Project, Glasgow University, 1994-1998
6 UniqFM: Specialised finite maps, for things with @Uniques@
8 Based on @FiniteMaps@ (as you would expect).
10 Basically, the things need to be in class @Uniquable@, and we use the
11 @getUnique@ method to grab their @Uniques@.
13 (A similar thing to @UniqSet@, as opposed to @Set@.)
16 {-# OPTIONS -Wall -fno-warn-name-shadowing #-}
18 UniqFM(..), -- abstract type
19 -- (de-abstracted for MachRegs.trivColorable optimisation BL 2007/09)
26 addToUFM,addToUFM_C,addToUFM_Acc,
27 addListToUFM,addListToUFM_C,
29 addListToUFM_Directly,
39 foldUFM, foldUFM_Directly,
41 elemUFM, elemUFM_Directly,
42 filterUFM, filterUFM_Directly,
46 lookupUFM, lookupUFM_Directly,
47 lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
52 #include "HsVersions.h"
54 import Unique ( Uniquable(..), Unique, getKeyFastInt, mkUniqueGrimily )
55 import Maybes ( maybeToBool )
60 %************************************************************************
62 \subsection{The @UniqFM@ type, and signatures for the functions}
64 %************************************************************************
66 We use @FiniteMaps@, with a (@getUnique@-able) @Unique@ as ``key''.
69 emptyUFM :: UniqFM elt
70 isNullUFM :: UniqFM elt -> Bool
71 unitUFM :: Uniquable key => key -> elt -> UniqFM elt
72 unitDirectlyUFM -- got the Unique already
73 :: Unique -> elt -> UniqFM elt
74 listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt
76 :: [(Unique, elt)] -> UniqFM elt
78 addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt
79 addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
80 addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
82 :: UniqFM elt -> Unique -> elt -> UniqFM elt
84 addToUFM_C :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
87 -> UniqFM elt -- result
89 addToUFM_Acc :: Uniquable key =>
90 (elt -> elts -> elts) -- Add to existing
91 -> (elt -> elts) -- New element
94 -> UniqFM elts -- result
96 addListToUFM_C :: Uniquable key => (elt -> elt -> elt)
97 -> UniqFM elt -> [(key,elt)]
100 delFromUFM :: Uniquable key => UniqFM elt -> key -> UniqFM elt
101 delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
102 delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
104 plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
106 plusUFM_C :: (elt -> elt -> elt)
107 -> UniqFM elt -> UniqFM elt -> UniqFM elt
109 minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
111 intersectUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
112 intersectUFM_C :: (elt1 -> elt2 -> elt3)
113 -> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
114 intersectsUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool
116 foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
117 foldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
118 mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
119 filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
120 filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
122 sizeUFM :: UniqFM elt -> Int
123 hashUFM :: UniqFM elt -> Int
124 elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
125 elemUFM_Directly:: Unique -> UniqFM elt -> Bool
127 lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
128 lookupUFM_Directly -- when you've got the Unique already
129 :: UniqFM elt -> Unique -> Maybe elt
131 :: Uniquable key => UniqFM elt -> elt -> key -> elt
132 lookupWithDefaultUFM_Directly
133 :: UniqFM elt -> elt -> Unique -> elt
135 keysUFM :: UniqFM elt -> [Unique] -- Get the keys
136 eltsUFM :: UniqFM elt -> [elt]
137 ufmToList :: UniqFM elt -> [(Unique, elt)]
140 %************************************************************************
142 \subsection{The @IdFinMap@ and @TyVarFinMap@ specialisations for Ids/TyVars}
144 %************************************************************************
147 -- Turn off for now, these need to be updated (SDM 4/98)
150 #ifdef __GLASGOW_HASKELL__
151 -- I don't think HBC was too happy about this (WDP 94/10)
154 addListToUFM :: UniqFM elt -> [(Name, elt)] -> UniqFM elt
157 addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name, elt)] -> UniqFM elt
160 addToUFM :: UniqFM elt -> Unique -> elt -> UniqFM elt
163 listToUFM :: [(Unique, elt)] -> UniqFM elt
166 lookupUFM :: UniqFM elt -> Name -> Maybe elt
167 , UniqFM elt -> Unique -> Maybe elt
170 #endif /* __GLASGOW_HASKELL__ */
174 %************************************************************************
176 \subsection{Andy Gill's underlying @UniqFM@ machinery}
178 %************************************************************************
180 ``Uniq Finite maps'' are the heart and soul of the compiler's
181 lookup-tables/environments. Important stuff! It works well with
182 Dense and Sparse ranges.
183 Both @Uq@ Finite maps and @Hash@ Finite Maps
184 are built ontop of Int Finite Maps.
186 This code is explained in the paper:
188 A Gill, S Peyton Jones, B O'Sullivan, W Partain and Aqua Friends
189 "A Cheap balancing act that grows on a tree"
190 Glasgow FP Workshop, Sep 1994, pp??-??
193 %************************************************************************
195 \subsubsection{The @UniqFM@ type, and signatures for the functions}
197 %************************************************************************
199 @UniqFM a@ is a mapping from Unique to a.
201 First, the DataType itself; which is either a Node, a Leaf, or an Empty.
206 | LeafUFM !FastInt ele
207 | NodeUFM !FastInt -- the switching
208 !FastInt -- the delta
211 -- INVARIANT: the children of a NodeUFM are never EmptyUFMs
214 -- for debugging only :-)
215 instance Outputable (UniqFM a) where
216 ppr(NodeUFM a b t1 t2) =
217 sep [text "NodeUFM " <+> int IBOX(a) <+> int IBOX(b),
218 nest 1 (parens (ppr t1)),
219 nest 1 (parens (ppr t2))]
220 ppr (LeafUFM x a) = text "LeafUFM " <+> int IBOX(x)
221 ppr (EmptyUFM) = empty
223 -- and when not debugging the package itself...
224 instance Outputable a => Outputable (UniqFM a) where
225 ppr ufm = ppr (ufmToList ufm)
228 %************************************************************************
230 \subsubsection{The @UniqFM@ functions}
232 %************************************************************************
234 First the ways of building a UniqFM.
238 unitUFM key elt = mkLeafUFM (getKeyFastInt (getUnique key)) elt
239 unitDirectlyUFM key elt = mkLeafUFM (getKeyFastInt key) elt
241 listToUFM key_elt_pairs
242 = addListToUFM_C use_snd EmptyUFM key_elt_pairs
244 listToUFM_Directly uniq_elt_pairs
245 = addListToUFM_directly_C use_snd EmptyUFM uniq_elt_pairs
248 Now ways of adding things to UniqFMs.
250 There is an alternative version of @addListToUFM_C@, that uses @plusUFM@,
251 but the semantics of this operation demands a linear insertion;
252 perhaps the version without the combinator function
253 could be optimised using it.
256 addToUFM fm key elt = addToUFM_C use_snd fm key elt
258 addToUFM_Directly fm u elt = insert_ele use_snd fm (getKeyFastInt u) elt
260 addToUFM_C combiner fm key elt
261 = insert_ele combiner fm (getKeyFastInt (getUnique key)) elt
263 addToUFM_Acc add unit fm key item
264 = insert_ele combiner fm (getKeyFastInt (getUnique key)) (unit item)
266 combiner old _unit_item = add item old
268 addListToUFM fm key_elt_pairs = addListToUFM_C use_snd fm key_elt_pairs
269 addListToUFM_Directly fm uniq_elt_pairs = addListToUFM_directly_C use_snd fm uniq_elt_pairs
271 addListToUFM_C combiner fm key_elt_pairs
272 = foldl (\ fm (k, e) -> insert_ele combiner fm (getKeyFastInt (getUnique k)) e)
275 addListToUFM_directly_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Unique,elt)] -> UniqFM elt
276 addListToUFM_directly_C combiner fm uniq_elt_pairs
277 = foldl (\ fm (k, e) -> insert_ele combiner fm (getKeyFastInt k) e)
281 Now ways of removing things from UniqFM.
284 delListFromUFM fm lst = foldl delFromUFM fm lst
286 delFromUFM fm key = delete fm (getKeyFastInt (getUnique key))
287 delFromUFM_Directly fm u = delete fm (getKeyFastInt u)
289 delete :: UniqFM a -> FastInt -> UniqFM a
290 delete EmptyUFM _ = EmptyUFM
291 delete fm key = del_ele fm
293 del_ele :: UniqFM a -> UniqFM a
295 del_ele lf@(LeafUFM j _)
296 | j ==# key = EmptyUFM
297 | otherwise = lf -- no delete!
299 del_ele (NodeUFM j p t1 t2)
301 = mkSLNodeUFM (NodeUFMData j p) (del_ele t1) t2
303 = mkLSNodeUFM (NodeUFMData j p) t1 (del_ele t2)
305 del_ele _ = panic "Found EmptyUFM FM when rec-deleting"
308 Now ways of adding two UniqFM's together.
311 plusUFM tr1 tr2 = plusUFM_C use_snd tr1 tr2
313 plusUFM_C _ EmptyUFM tr = tr
314 plusUFM_C _ tr EmptyUFM = tr
315 plusUFM_C f fm1 fm2 = mix_trees fm1 fm2
317 mix_trees (LeafUFM i a) t2 = insert_ele (flip f) t2 i a
318 mix_trees t1 (LeafUFM i a) = insert_ele f t1 i a
320 mix_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
322 (ask_about_common_ancestor
326 -- Given a disjoint j,j' (p >^ p' && p' >^ p):
330 -- t1 t2 t1' t2' j j'
335 mix_branches (NewRoot nd False)
336 = mkLLNodeUFM nd left_t right_t
337 mix_branches (NewRoot nd True)
338 = mkLLNodeUFM nd right_t left_t
344 -- t1 t2 t1' t2' t1 + t1' t2 + t2'
346 mix_branches (SameRoot)
347 = mkSSNodeUFM (NodeUFMData j p)
350 -- Now the 4 different other ways; all like this:
352 -- Given j >^ j' (and, say, j > j')
356 -- t1 t2 t1' t2' t1 t2 + j'
359 mix_branches (LeftRoot Leftt) -- | trace "LL" True
362 (mix_trees t1 right_t)
365 mix_branches (LeftRoot Rightt) -- | trace "LR" True
369 (mix_trees t2 right_t)
371 mix_branches (RightRoot Leftt) -- | trace "RL" True
374 (mix_trees left_t t1')
377 mix_branches (RightRoot Rightt) -- | trace "RR" True
381 (mix_trees left_t t2')
383 mix_trees _ _ = panic "EmptyUFM found when inserting into plusInt"
386 And ways of subtracting them. First the base cases,
387 then the full D&C approach.
390 minusUFM EmptyUFM _ = EmptyUFM
391 minusUFM t1 EmptyUFM = t1
392 minusUFM fm1 fm2 = minus_trees fm1 fm2
395 -- Notice the asymetry of subtraction
397 minus_trees lf@(LeafUFM i _a) t2 =
402 minus_trees t1 (LeafUFM i _) = delete t1 i
404 minus_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
406 (ask_about_common_ancestor
410 -- Given a disjoint j,j' (p >^ p' && p' >^ p):
414 -- t1 t2 t1' t2' t1 t2
419 minus_branches (NewRoot _ _) = left_t
425 -- t1 t2 t1' t2' t1 + t1' t2 + t2'
427 minus_branches (SameRoot)
428 = mkSSNodeUFM (NodeUFMData j p)
431 -- Now the 4 different other ways; all like this:
432 -- again, with asymatry
435 -- The left is above the right
437 minus_branches (LeftRoot Leftt)
440 (minus_trees t1 right_t)
442 minus_branches (LeftRoot Rightt)
446 (minus_trees t2 right_t)
449 -- The right is above the left
451 minus_branches (RightRoot Leftt)
452 = minus_trees left_t t1'
453 minus_branches (RightRoot Rightt)
454 = minus_trees left_t t2'
456 minus_trees _ _ = panic "EmptyUFM found when insering into plusInt"
459 And taking the intersection of two UniqFM's.
462 intersectUFM t1 t2 = intersectUFM_C use_snd t1 t2
463 intersectsUFM t1 t2 = isNullUFM (intersectUFM_C (\ _ _ -> error "urk") t1 t2)
465 intersectUFM_C _ EmptyUFM _ = EmptyUFM
466 intersectUFM_C _ _ EmptyUFM = EmptyUFM
467 intersectUFM_C f fm1 fm2 = intersect_trees fm1 fm2
469 intersect_trees (LeafUFM i a) t2 =
472 Just b -> mkLeafUFM i (f a b)
474 intersect_trees t1 (LeafUFM i a) =
477 Just b -> mkLeafUFM i (f b a)
479 intersect_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
481 (ask_about_common_ancestor
485 -- Given a disjoint j,j' (p >^ p' && p' >^ p):
488 -- / \ + / \ ==> EmptyUFM
493 intersect_branches (NewRoot _nd _) = EmptyUFM
499 -- t1 t2 t1' t2' t1 x t1' t2 x t2'
501 intersect_branches (SameRoot)
502 = mkSSNodeUFM (NodeUFMData j p)
503 (intersect_trees t1 t1')
504 (intersect_trees t2 t2')
505 -- Now the 4 different other ways; all like this:
507 -- Given j >^ j' (and, say, j > j')
511 -- t1 t2 t1' t2' t1' t2'
513 -- This does cut down the search space quite a bit.
515 intersect_branches (LeftRoot Leftt)
516 = intersect_trees t1 right_t
517 intersect_branches (LeftRoot Rightt)
518 = intersect_trees t2 right_t
519 intersect_branches (RightRoot Leftt)
520 = intersect_trees left_t t1'
521 intersect_branches (RightRoot Rightt)
522 = intersect_trees left_t t2'
524 intersect_trees _ _ = panic ("EmptyUFM found when intersecting trees")
527 Now the usual set of `collection' operators, like map, fold, etc.
530 foldUFM f a (NodeUFM _ _ t1 t2) = foldUFM f (foldUFM f a t2) t1
531 foldUFM f a (LeafUFM _ obj) = f obj a
532 foldUFM _ a EmptyUFM = a
536 mapUFM _fn EmptyUFM = EmptyUFM
537 mapUFM fn fm = map_tree fn fm
539 filterUFM _fn EmptyUFM = EmptyUFM
540 filterUFM fn fm = filter_tree (\_ e -> fn e) fm
542 filterUFM_Directly _fn EmptyUFM = EmptyUFM
543 filterUFM_Directly fn fm = filter_tree pred fm
545 pred i e = fn (mkUniqueGrimily (iBox i)) e
548 Note, this takes a long time, O(n), but
549 because we dont want to do this very often, we put up with this.
550 O'rable, but how often do we look at the size of
555 sizeUFM (NodeUFM _ _ t1 t2) = sizeUFM t1 + sizeUFM t2
556 sizeUFM (LeafUFM _ _) = 1
558 isNullUFM EmptyUFM = True
561 -- hashing is used in VarSet.uniqAway, and should be fast
562 -- We use a cheap and cheerful method for now
564 hashUFM (NodeUFM n _ _ _) = iBox n
565 hashUFM (LeafUFM n _) = iBox n
568 looking up in a hurry is the {\em whole point} of this binary tree lark.
569 Lookup up a binary tree is easy (and fast).
572 elemUFM key fm = maybeToBool (lookupUFM fm key)
573 elemUFM_Directly key fm = maybeToBool (lookupUFM_Directly fm key)
575 lookupUFM fm key = lookUp fm (getKeyFastInt (getUnique key))
576 lookupUFM_Directly fm key = lookUp fm (getKeyFastInt key)
578 lookupWithDefaultUFM fm deflt key
579 = case lookUp fm (getKeyFastInt (getUnique key)) of
583 lookupWithDefaultUFM_Directly fm deflt key
584 = case lookUp fm (getKeyFastInt key) of
588 lookUp :: UniqFM a -> FastInt -> Maybe a
589 lookUp EmptyUFM _ = Nothing
590 lookUp fm i = lookup_tree fm
592 lookup_tree :: UniqFM a -> Maybe a
594 lookup_tree (LeafUFM j b)
596 | otherwise = Nothing
597 lookup_tree (NodeUFM j _ t1 t2)
598 | j ># i = lookup_tree t1
599 | otherwise = lookup_tree t2
601 lookup_tree EmptyUFM = panic "lookup Failed"
604 folds are *wonderful* things.
607 eltsUFM fm = foldUFM (:) [] fm
608 keysUFM fm = foldUFM_Directly (\u _ l -> u : l) [] fm
609 ufmToList fm = foldUFM_Directly (\u e l -> (u, e) : l) [] fm
610 foldUFM_Directly f = fold_tree (\iu e a -> f (mkUniqueGrimily (iBox iu)) e a)
612 fold_tree :: (FastInt -> elt -> a -> a) -> a -> UniqFM elt -> a
613 fold_tree f a (NodeUFM _ _ t1 t2) = fold_tree f (fold_tree f a t2) t1
614 fold_tree f a (LeafUFM iu obj) = f iu obj a
615 fold_tree _ a EmptyUFM = a
618 %************************************************************************
620 \subsubsection{The @UniqFM@ type, and its functions}
622 %************************************************************************
624 You should always use these to build the tree.
625 There are 4 versions of mkNodeUFM, depending on
626 the strictness of the two sub-tree arguments.
627 The strictness is used *both* to prune out
628 empty trees, *and* to improve performance,
629 stoping needless thunks lying around.
630 The rule of thumb (from experence with these trees)
631 is make thunks strict, but data structures lazy.
632 If in doubt, use mkSSNodeUFM, which has the `strongest'
633 functionality, but may do a few needless evaluations.
636 mkLeafUFM :: FastInt -> a -> UniqFM a
637 mkLeafUFM i a = LeafUFM i a
639 -- The *ONLY* ways of building a NodeUFM.
641 mkSSNodeUFM, mkSLNodeUFM, mkLSNodeUFM, mkLLNodeUFM ::
642 NodeUFMData -> UniqFM a -> UniqFM a -> UniqFM a
644 mkSSNodeUFM (NodeUFMData _ _) EmptyUFM t2 = t2
645 mkSSNodeUFM (NodeUFMData _ _) t1 EmptyUFM = t1
646 mkSSNodeUFM (NodeUFMData j p) t1 t2
647 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
650 mkSLNodeUFM (NodeUFMData _ _) EmptyUFM t2 = t2
651 mkSLNodeUFM (NodeUFMData j p) t1 t2
652 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
655 mkLSNodeUFM (NodeUFMData _ _) t1 EmptyUFM = t1
656 mkLSNodeUFM (NodeUFMData j p) t1 t2
657 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
660 mkLLNodeUFM (NodeUFMData j p) t1 t2
661 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
671 correctNodeUFM j p t1 t2
672 = correct (j-p) (j-1) p t1 && correct j ((j-1)+p) p t2
674 correct low high _ (LeafUFM i _)
675 = low <= iBox i && iBox i <= high
676 correct low high above_p (NodeUFM j p _ _)
677 = low <= iBox j && iBox j <= high && above_p > iBox p
678 correct _ _ _ EmptyUFM = panic "EmptyUFM stored inside a tree"
681 Note: doing SAT on this by hand seems to make it worse. Todo: Investigate,
682 and if necessary do $\lambda$ lifting on our functions that are bound.
686 :: (a -> a -> a) -- old -> new -> result
692 insert_ele _f EmptyUFM i new = mkLeafUFM i new
694 insert_ele f (LeafUFM j old) i new
696 mkLLNodeUFM (getCommonNodeUFMData
701 | j ==# i = mkLeafUFM j $ f old new
703 mkLLNodeUFM (getCommonNodeUFMData
709 insert_ele f n@(NodeUFM j p t1 t2) i a
711 = if (i >=# (j -# p))
712 then mkSLNodeUFM (NodeUFMData j p) (insert_ele f t1 i a) t2
713 else mkLLNodeUFM (getCommonNodeUFMData
719 = if (i <=# ((j -# _ILIT(1)) +# p))
720 then mkLSNodeUFM (NodeUFMData j p) t1 (insert_ele f t2 i a)
721 else mkLLNodeUFM (getCommonNodeUFMData
731 map_tree :: (a -> b) -> UniqFM a -> UniqFM b
732 map_tree f (NodeUFM j p t1 t2)
733 = mkLLNodeUFM (NodeUFMData j p) (map_tree f t1) (map_tree f t2)
734 -- NB. lazy! we know the tree is well-formed.
735 map_tree f (LeafUFM i obj)
736 = mkLeafUFM i (f obj)
737 map_tree _ _ = panic "map_tree failed"
741 filter_tree :: (FastInt -> a -> Bool) -> UniqFM a -> UniqFM a
742 filter_tree f (NodeUFM j p t1 t2)
743 = mkSSNodeUFM (NodeUFMData j p) (filter_tree f t1) (filter_tree f t2)
745 filter_tree f lf@(LeafUFM i obj)
747 | otherwise = EmptyUFM
748 filter_tree _ _ = panic "filter_tree failed"
751 %************************************************************************
753 \subsubsection{The @UniqFM@ type, and signatures for the functions}
755 %************************************************************************
759 This is the information that is held inside a NodeUFM, packaged up for
764 = NodeUFMData FastInt
768 This is the information used when computing new NodeUFMs.
771 data Side = Leftt | Rightt -- NB: avoid 1.3 names "Left" and "Right"
773 = LeftRoot Side -- which side is the right down ?
774 | RightRoot Side -- which side is the left down ?
775 | SameRoot -- they are the same !
776 | NewRoot NodeUFMData -- here's the new, common, root
777 Bool -- do you need to swap left and right ?
780 This specifies the relationship between NodeUFMData and CalcNodeUFMData.
783 indexToRoot :: FastInt -> NodeUFMData
786 = NodeUFMData ((shiftL1 (shiftR1 i)) +# _ILIT(1)) (_ILIT(1))
788 getCommonNodeUFMData :: NodeUFMData -> NodeUFMData -> NodeUFMData
790 getCommonNodeUFMData (NodeUFMData i p) (NodeUFMData i2 p2)
791 | p ==# p2 = getCommonNodeUFMData_ p j j2
792 | p <# p2 = getCommonNodeUFMData_ p2 (j `quotFastInt` (p2 `quotFastInt` p)) j2
793 | otherwise = getCommonNodeUFMData_ p j (j2 `quotFastInt` (p `quotFastInt` p2))
795 j = i `quotFastInt` (shiftL1 p)
796 j2 = i2 `quotFastInt` (shiftL1 p2)
798 getCommonNodeUFMData_ :: FastInt -> FastInt -> FastInt -> NodeUFMData
800 getCommonNodeUFMData_ p j j_
802 = NodeUFMData (((shiftL1 j) +# _ILIT(1)) *# p) p
804 = getCommonNodeUFMData_ (shiftL1 p) (shiftR1 j) (shiftR1 j_)
806 ask_about_common_ancestor :: NodeUFMData -> NodeUFMData -> CommonRoot
808 ask_about_common_ancestor x@(NodeUFMData j _p) y@(NodeUFMData j2 _p2)
809 | j ==# j2 = SameRoot
811 = case getCommonNodeUFMData x y of
812 nd@(NodeUFMData j3 _p3)
813 | j3 ==# j -> LeftRoot (decideSide (j ># j2))
814 | j3 ==# j2 -> RightRoot (decideSide (j <# j2))
815 | otherwise -> NewRoot nd (j ># j2)
817 decideSide :: Bool -> Side
818 decideSide True = Leftt
819 decideSide False = Rightt
822 This might be better in Util.lhs ?
825 Now the bit twiddling functions.
827 shiftL1 :: FastInt -> FastInt
828 shiftR1 :: FastInt -> FastInt
830 {-# INLINE shiftL1 #-}
831 {-# INLINE shiftR1 #-}
833 shiftL1 n = n `shiftLFastInt` _ILIT(1)
834 shiftR1 n = n `shiftR_FastInt` _ILIT(1)
838 use_snd :: a -> b -> b
843 _unused :: FS.FastString