2 % (c) The AQUA Project, Glasgow University, 1994-1998
4 \section[UniqFM]{Specialised finite maps, for things with @Uniques@}
6 Based on @FiniteMaps@ (as you would expect).
8 Basically, the things need to be in class @Uniquable@, and we use the
9 @getUnique@ method to grab their @Uniques@.
11 (A similar thing to @UniqSet@, as opposed to @Set@.)
15 UniqFM, -- abstract type
22 addToUFM,addToUFM_C,addToUFM_Acc,
23 addListToUFM,addListToUFM_C,
25 addListToUFM_Directly,
37 elemUFM, elemUFM_Directly,
38 filterUFM, filterUFM_Directly,
42 lookupUFM, lookupUFM_Directly,
43 lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
48 #include "HsVersions.h"
50 import Unique ( Uniquable(..), Unique, getKey#, mkUniqueGrimily )
51 import Maybes ( maybeToBool )
55 import GLAEXTS -- Lots of Int# operations
58 %************************************************************************
60 \subsection{The @UniqFM@ type, and signatures for the functions}
62 %************************************************************************
64 We use @FiniteMaps@, with a (@getUnique@-able) @Unique@ as ``key''.
67 emptyUFM :: UniqFM elt
68 isNullUFM :: UniqFM elt -> Bool
69 unitUFM :: Uniquable key => key -> elt -> UniqFM elt
70 unitDirectlyUFM -- got the Unique already
71 :: Unique -> elt -> UniqFM elt
72 listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt
74 :: [(Unique, elt)] -> UniqFM elt
76 addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt
77 addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
79 :: UniqFM elt -> Unique -> elt -> UniqFM elt
81 addToUFM_C :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
84 -> UniqFM elt -- result
86 addToUFM_Acc :: Uniquable key =>
87 (elt -> elts -> elts) -- Add to existing
88 -> (elt -> elts) -- New element
91 -> UniqFM elts -- result
93 addListToUFM_C :: Uniquable key => (elt -> elt -> elt)
94 -> UniqFM elt -> [(key,elt)]
97 delFromUFM :: Uniquable key => UniqFM elt -> key -> UniqFM elt
98 delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
99 delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
101 plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
103 plusUFM_C :: (elt -> elt -> elt)
104 -> UniqFM elt -> UniqFM elt -> UniqFM elt
106 minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
108 intersectUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
109 intersectUFM_C :: (elt1 -> elt2 -> elt3)
110 -> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
111 intersectsUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool
113 foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
114 mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
115 filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
116 filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
118 sizeUFM :: UniqFM elt -> Int
119 hashUFM :: UniqFM elt -> Int
120 elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
121 elemUFM_Directly:: Unique -> UniqFM elt -> Bool
123 lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
124 lookupUFM_Directly -- when you've got the Unique already
125 :: UniqFM elt -> Unique -> Maybe elt
127 :: Uniquable key => UniqFM elt -> elt -> key -> elt
128 lookupWithDefaultUFM_Directly
129 :: UniqFM elt -> elt -> Unique -> elt
131 keysUFM :: UniqFM elt -> [Unique] -- Get the keys
132 eltsUFM :: UniqFM elt -> [elt]
133 ufmToList :: UniqFM elt -> [(Unique, elt)]
136 %************************************************************************
138 \subsection{The @IdFinMap@ and @TyVarFinMap@ specialisations for Ids/TyVars}
140 %************************************************************************
143 -- Turn off for now, these need to be updated (SDM 4/98)
146 #ifdef __GLASGOW_HASKELL__
147 -- I don't think HBC was too happy about this (WDP 94/10)
150 addListToUFM :: UniqFM elt -> [(Name, elt)] -> UniqFM elt
153 addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name, elt)] -> UniqFM elt
156 addToUFM :: UniqFM elt -> Unique -> elt -> UniqFM elt
159 listToUFM :: [(Unique, elt)] -> UniqFM elt
162 lookupUFM :: UniqFM elt -> Name -> Maybe elt
163 , UniqFM elt -> Unique -> Maybe elt
166 #endif /* __GLASGOW_HASKELL__ */
170 %************************************************************************
172 \subsection{Andy Gill's underlying @UniqFM@ machinery}
174 %************************************************************************
176 ``Uniq Finite maps'' are the heart and soul of the compiler's
177 lookup-tables/environments. Important stuff! It works well with
178 Dense and Sparse ranges.
179 Both @Uq@ Finite maps and @Hash@ Finite Maps
180 are built ontop of Int Finite Maps.
182 This code is explained in the paper:
184 A Gill, S Peyton Jones, B O'Sullivan, W Partain and Aqua Friends
185 "A Cheap balancing act that grows on a tree"
186 Glasgow FP Workshop, Sep 1994, pp??-??
189 %************************************************************************
191 \subsubsection{The @UniqFM@ type, and signatures for the functions}
193 %************************************************************************
195 @UniqFM a@ is a mapping from Unique to a.
197 First, the DataType itself; which is either a Node, a Leaf, or an Empty.
202 | LeafUFM FastInt ele
203 | NodeUFM FastInt -- the switching
207 -- INVARIANT: the children of a NodeUFM are never EmptyUFMs
210 -- for debugging only :-)
211 instance Outputable (UniqFM a) where
212 ppr(NodeUFM a b t1 t2) =
213 sep [text "NodeUFM " <+> int IBOX(a) <+> int IBOX(b),
214 nest 1 (parens (ppr t1)),
215 nest 1 (parens (ppr t2))]
216 ppr (LeafUFM x a) = text "LeafUFM " <+> int IBOX(x)
217 ppr (EmptyUFM) = empty
219 -- and when not debugging the package itself...
220 instance Outputable a => Outputable (UniqFM a) where
221 ppr ufm = ppr (ufmToList ufm)
224 %************************************************************************
226 \subsubsection{The @UniqFM@ functions}
228 %************************************************************************
230 First the ways of building a UniqFM.
234 unitUFM key elt = mkLeafUFM (getKey# (getUnique key)) elt
235 unitDirectlyUFM key elt = mkLeafUFM (getKey# key) elt
237 listToUFM key_elt_pairs
238 = addListToUFM_C use_snd EmptyUFM key_elt_pairs
240 listToUFM_Directly uniq_elt_pairs
241 = addListToUFM_directly_C use_snd EmptyUFM uniq_elt_pairs
244 Now ways of adding things to UniqFMs.
246 There is an alternative version of @addListToUFM_C@, that uses @plusUFM@,
247 but the semantics of this operation demands a linear insertion;
248 perhaps the version without the combinator function
249 could be optimised using it.
252 addToUFM fm key elt = addToUFM_C use_snd fm key elt
254 addToUFM_Directly fm u elt = insert_ele use_snd fm (getKey# u) elt
256 addToUFM_C combiner fm key elt
257 = insert_ele combiner fm (getKey# (getUnique key)) elt
259 addToUFM_Acc add unit fm key item
260 = insert_ele combiner fm (getKey# (getUnique key)) (unit item)
262 combiner old _unit_item = add item old
264 addListToUFM fm key_elt_pairs = addListToUFM_C use_snd fm key_elt_pairs
265 addListToUFM_Directly fm uniq_elt_pairs = addListToUFM_directly_C use_snd fm uniq_elt_pairs
267 addListToUFM_C combiner fm key_elt_pairs
268 = foldl (\ fm (k, e) -> insert_ele combiner fm (getKey# (getUnique k)) e)
271 addListToUFM_directly_C combiner fm uniq_elt_pairs
272 = foldl (\ fm (k, e) -> insert_ele combiner fm (getKey# k) e)
276 Now ways of removing things from UniqFM.
279 delListFromUFM fm lst = foldl delFromUFM fm lst
281 delFromUFM fm key = delete fm (getKey# (getUnique key))
282 delFromUFM_Directly fm u = delete fm (getKey# u)
284 delete EmptyUFM _ = EmptyUFM
285 delete fm key = del_ele fm
287 del_ele :: UniqFM a -> UniqFM a
289 del_ele lf@(LeafUFM j _)
290 | j ==# key = EmptyUFM
291 | otherwise = lf -- no delete!
293 del_ele nd@(NodeUFM j p t1 t2)
295 = mkSLNodeUFM (NodeUFMData j p) (del_ele t1) t2
297 = mkLSNodeUFM (NodeUFMData j p) t1 (del_ele t2)
299 del_ele _ = panic "Found EmptyUFM FM when rec-deleting"
302 Now ways of adding two UniqFM's together.
305 plusUFM tr1 tr2 = plusUFM_C use_snd tr1 tr2
307 plusUFM_C f EmptyUFM tr = tr
308 plusUFM_C f tr EmptyUFM = tr
309 plusUFM_C f fm1 fm2 = mix_trees fm1 fm2
311 mix_trees (LeafUFM i a) t2 = insert_ele (flip f) t2 i a
312 mix_trees t1 (LeafUFM i a) = insert_ele f t1 i a
314 mix_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
316 (ask_about_common_ancestor
320 -- Given a disjoint j,j' (p >^ p' && p' >^ p):
324 -- t1 t2 t1' t2' j j'
329 mix_branches (NewRoot nd False)
330 = mkLLNodeUFM nd left_t right_t
331 mix_branches (NewRoot nd True)
332 = mkLLNodeUFM nd right_t left_t
338 -- t1 t2 t1' t2' t1 + t1' t2 + t2'
340 mix_branches (SameRoot)
341 = mkSSNodeUFM (NodeUFMData j p)
344 -- Now the 4 different other ways; all like this:
346 -- Given j >^ j' (and, say, j > j')
350 -- t1 t2 t1' t2' t1 t2 + j'
353 mix_branches (LeftRoot Leftt) -- | trace "LL" True
356 (mix_trees t1 right_t)
359 mix_branches (LeftRoot Rightt) -- | trace "LR" True
363 (mix_trees t2 right_t)
365 mix_branches (RightRoot Leftt) -- | trace "RL" True
368 (mix_trees left_t t1')
371 mix_branches (RightRoot Rightt) -- | trace "RR" True
375 (mix_trees left_t t2')
377 mix_trees _ _ = panic "EmptyUFM found when inserting into plusInt"
380 And ways of subtracting them. First the base cases,
381 then the full D&C approach.
384 minusUFM EmptyUFM _ = EmptyUFM
385 minusUFM t1 EmptyUFM = t1
386 minusUFM fm1 fm2 = minus_trees fm1 fm2
389 -- Notice the asymetry of subtraction
391 minus_trees lf@(LeafUFM i a) t2 =
396 minus_trees t1 (LeafUFM i _) = delete t1 i
398 minus_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
400 (ask_about_common_ancestor
404 -- Given a disjoint j,j' (p >^ p' && p' >^ p):
408 -- t1 t2 t1' t2' t1 t2
413 minus_branches (NewRoot nd _) = left_t
419 -- t1 t2 t1' t2' t1 + t1' t2 + t2'
421 minus_branches (SameRoot)
422 = mkSSNodeUFM (NodeUFMData j p)
425 -- Now the 4 different other ways; all like this:
426 -- again, with asymatry
429 -- The left is above the right
431 minus_branches (LeftRoot Leftt)
434 (minus_trees t1 right_t)
436 minus_branches (LeftRoot Rightt)
440 (minus_trees t2 right_t)
443 -- The right is above the left
445 minus_branches (RightRoot Leftt)
446 = minus_trees left_t t1'
447 minus_branches (RightRoot Rightt)
448 = minus_trees left_t t2'
450 minus_trees _ _ = panic "EmptyUFM found when insering into plusInt"
453 And taking the intersection of two UniqFM's.
456 intersectUFM t1 t2 = intersectUFM_C use_snd t1 t2
457 intersectsUFM t1 t2 = isNullUFM (intersectUFM_C (\ _ _ -> error "urk") t1 t2)
459 intersectUFM_C f EmptyUFM _ = EmptyUFM
460 intersectUFM_C f _ EmptyUFM = EmptyUFM
461 intersectUFM_C f fm1 fm2 = intersect_trees fm1 fm2
463 intersect_trees (LeafUFM i a) t2 =
466 Just b -> mkLeafUFM i (f a b)
468 intersect_trees t1 (LeafUFM i a) =
471 Just b -> mkLeafUFM i (f b a)
473 intersect_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
475 (ask_about_common_ancestor
479 -- Given a disjoint j,j' (p >^ p' && p' >^ p):
482 -- / \ + / \ ==> EmptyUFM
487 intersect_branches (NewRoot nd _) = EmptyUFM
493 -- t1 t2 t1' t2' t1 x t1' t2 x t2'
495 intersect_branches (SameRoot)
496 = mkSSNodeUFM (NodeUFMData j p)
497 (intersect_trees t1 t1')
498 (intersect_trees t2 t2')
499 -- Now the 4 different other ways; all like this:
501 -- Given j >^ j' (and, say, j > j')
505 -- t1 t2 t1' t2' t1' t2'
507 -- This does cut down the search space quite a bit.
509 intersect_branches (LeftRoot Leftt)
510 = intersect_trees t1 right_t
511 intersect_branches (LeftRoot Rightt)
512 = intersect_trees t2 right_t
513 intersect_branches (RightRoot Leftt)
514 = intersect_trees left_t t1'
515 intersect_branches (RightRoot Rightt)
516 = intersect_trees left_t t2'
518 intersect_trees x y = panic ("EmptyUFM found when intersecting trees")
521 Now the usual set of `collection' operators, like map, fold, etc.
524 foldUFM f a (NodeUFM _ _ t1 t2) = foldUFM f (foldUFM f a t2) t1
525 foldUFM f a (LeafUFM _ obj) = f obj a
526 foldUFM f a EmptyUFM = a
530 mapUFM fn EmptyUFM = EmptyUFM
531 mapUFM fn fm = map_tree fn fm
533 filterUFM fn EmptyUFM = EmptyUFM
534 filterUFM fn fm = filter_tree pred fm
536 pred (i::FastInt) e = fn e
538 filterUFM_Directly fn EmptyUFM = EmptyUFM
539 filterUFM_Directly fn fm = filter_tree pred fm
541 pred i e = fn (mkUniqueGrimily (iBox i)) e
544 Note, this takes a long time, O(n), but
545 because we dont want to do this very often, we put up with this.
546 O'rable, but how often do we look at the size of
551 sizeUFM (NodeUFM _ _ t1 t2) = sizeUFM t1 + sizeUFM t2
552 sizeUFM (LeafUFM _ _) = 1
554 isNullUFM EmptyUFM = True
557 -- hashing is used in VarSet.uniqAway, and should be fast
558 -- We use a cheap and cheerful method for now
560 hashUFM (NodeUFM n _ _ _) = iBox n
561 hashUFM (LeafUFM n _) = iBox n
564 looking up in a hurry is the {\em whole point} of this binary tree lark.
565 Lookup up a binary tree is easy (and fast).
568 elemUFM key fm = maybeToBool (lookupUFM fm key)
569 elemUFM_Directly key fm = maybeToBool (lookupUFM_Directly fm key)
571 lookupUFM fm key = lookUp fm (getKey# (getUnique key))
572 lookupUFM_Directly fm key = lookUp fm (getKey# key)
574 lookupWithDefaultUFM fm deflt key
575 = case lookUp fm (getKey# (getUnique key)) of
579 lookupWithDefaultUFM_Directly fm deflt key
580 = case lookUp fm (getKey# key) of
584 lookUp EmptyUFM _ = Nothing
585 lookUp fm i = lookup_tree fm
587 lookup_tree :: UniqFM a -> Maybe a
589 lookup_tree (LeafUFM j b)
591 | otherwise = Nothing
592 lookup_tree (NodeUFM j p t1 t2)
593 | j ># i = lookup_tree t1
594 | otherwise = lookup_tree t2
596 lookup_tree EmptyUFM = panic "lookup Failed"
599 folds are *wonderful* things.
602 eltsUFM fm = foldUFM (:) [] fm
604 ufmToList fm = fold_tree (\ iu elt rest -> (mkUniqueGrimily (iBox iu), elt) : rest) [] fm
606 keysUFM fm = fold_tree (\ iu elt rest -> mkUniqueGrimily (iBox iu) : rest) [] fm
608 fold_tree f a (NodeUFM _ _ t1 t2) = fold_tree f (fold_tree f a t2) t1
609 fold_tree f a (LeafUFM iu obj) = f iu obj a
610 fold_tree f a EmptyUFM = a
613 %************************************************************************
615 \subsubsection{The @UniqFM@ type, and its functions}
617 %************************************************************************
619 You should always use these to build the tree.
620 There are 4 versions of mkNodeUFM, depending on
621 the strictness of the two sub-tree arguments.
622 The strictness is used *both* to prune out
623 empty trees, *and* to improve performance,
624 stoping needless thunks lying around.
625 The rule of thumb (from experence with these trees)
626 is make thunks strict, but data structures lazy.
627 If in doubt, use mkSSNodeUFM, which has the `strongest'
628 functionality, but may do a few needless evaluations.
631 mkLeafUFM :: FastInt -> a -> UniqFM a
632 mkLeafUFM i a = LeafUFM i a
634 -- The *ONLY* ways of building a NodeUFM.
636 mkSSNodeUFM (NodeUFMData j p) EmptyUFM t2 = t2
637 mkSSNodeUFM (NodeUFMData j p) t1 EmptyUFM = t1
638 mkSSNodeUFM (NodeUFMData j p) t1 t2
639 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
642 mkSLNodeUFM (NodeUFMData j p) EmptyUFM t2 = t2
643 mkSLNodeUFM (NodeUFMData j p) t1 t2
644 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
647 mkLSNodeUFM (NodeUFMData j p) t1 EmptyUFM = t1
648 mkLSNodeUFM (NodeUFMData j p) t1 t2
649 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
652 mkLLNodeUFM (NodeUFMData j p) t1 t2
653 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
663 correctNodeUFM j p t1 t2
664 = correct (j-p) (j-1) p t1 && correct j ((j-1)+p) p t2
666 correct low high _ (LeafUFM i _)
667 = low <= iBox i && iBox i <= high
668 correct low high above_p (NodeUFM j p _ _)
669 = low <= iBox j && iBox j <= high && above_p > iBox p
670 correct _ _ _ EmptyUFM = panic "EmptyUFM stored inside a tree"
673 Note: doing SAT on this by hand seems to make it worse. Todo: Investigate,
674 and if necessary do $\lambda$ lifting on our functions that are bound.
678 :: (a -> a -> a) -- old -> new -> result
684 insert_ele f EmptyUFM i new = mkLeafUFM i new
686 insert_ele f (LeafUFM j old) i new
688 mkLLNodeUFM (getCommonNodeUFMData
693 | j ==# i = mkLeafUFM j (f old new)
695 mkLLNodeUFM (getCommonNodeUFMData
701 insert_ele f n@(NodeUFM j p t1 t2) i a
703 = if (i >=# (j -# p))
704 then mkSLNodeUFM (NodeUFMData j p) (insert_ele f t1 i a) t2
705 else mkLLNodeUFM (getCommonNodeUFMData
711 = if (i <=# ((j -# _ILIT(1)) +# p))
712 then mkLSNodeUFM (NodeUFMData j p) t1 (insert_ele f t2 i a)
713 else mkLLNodeUFM (getCommonNodeUFMData
723 map_tree f (NodeUFM j p t1 t2)
724 = mkLLNodeUFM (NodeUFMData j p) (map_tree f t1) (map_tree f t2)
725 -- NB. lazy! we know the tree is well-formed.
726 map_tree f (LeafUFM i obj)
727 = mkLeafUFM i (f obj)
728 map_tree f _ = panic "map_tree failed"
732 filter_tree :: (FastInt -> a -> Bool) -> UniqFM a -> UniqFM a
733 filter_tree f nd@(NodeUFM j p t1 t2)
734 = mkSSNodeUFM (NodeUFMData j p) (filter_tree f t1) (filter_tree f t2)
736 filter_tree f lf@(LeafUFM i obj)
738 | otherwise = EmptyUFM
739 filter_tree f _ = panic "filter_tree failed"
742 %************************************************************************
744 \subsubsection{The @UniqFM@ type, and signatures for the functions}
746 %************************************************************************
750 This is the information that is held inside a NodeUFM, packaged up for
755 = NodeUFMData FastInt
759 This is the information used when computing new NodeUFMs.
762 data Side = Leftt | Rightt -- NB: avoid 1.3 names "Left" and "Right"
764 = LeftRoot Side -- which side is the right down ?
765 | RightRoot Side -- which side is the left down ?
766 | SameRoot -- they are the same !
767 | NewRoot NodeUFMData -- here's the new, common, root
768 Bool -- do you need to swap left and right ?
771 This specifies the relationship between NodeUFMData and CalcNodeUFMData.
774 indexToRoot :: FastInt -> NodeUFMData
778 l = (_ILIT(1) :: FastInt)
780 NodeUFMData (((i `shiftR_` l) `shiftL_` l) +# _ILIT(1)) l
782 getCommonNodeUFMData :: NodeUFMData -> NodeUFMData -> NodeUFMData
784 getCommonNodeUFMData (NodeUFMData i p) (NodeUFMData i2 p2)
785 | p ==# p2 = getCommonNodeUFMData_ p j j2
786 | p <# p2 = getCommonNodeUFMData_ p2 (j `quotFastInt` (p2 `quotFastInt` p)) j2
787 | otherwise = getCommonNodeUFMData_ p j (j2 `quotFastInt` (p `quotFastInt` p2))
789 l = (_ILIT(1) :: FastInt)
790 j = i `quotFastInt` (p `shiftL_` l)
791 j2 = i2 `quotFastInt` (p2 `shiftL_` l)
793 getCommonNodeUFMData_ :: FastInt -> FastInt -> FastInt -> NodeUFMData
795 getCommonNodeUFMData_ p j j_
797 = NodeUFMData (((j `shiftL_` l) +# l) *# p) p
799 = getCommonNodeUFMData_ (p `shiftL_` l) (j `shiftR_` l) (j_ `shiftR_` l)
801 ask_about_common_ancestor :: NodeUFMData -> NodeUFMData -> CommonRoot
803 ask_about_common_ancestor x@(NodeUFMData j p) y@(NodeUFMData j2 p2)
804 | j ==# j2 = SameRoot
806 = case getCommonNodeUFMData x y of
807 nd@(NodeUFMData j3 p3)
808 | j3 ==# j -> LeftRoot (decideSide (j ># j2))
809 | j3 ==# j2 -> RightRoot (decideSide (j <# j2))
810 | otherwise -> NewRoot nd (j ># j2)
812 decideSide :: Bool -> Side
813 decideSide True = Leftt
814 decideSide False = Rightt
817 This might be better in Util.lhs ?
820 Now the bit twiddling functions.
822 shiftL_ :: FastInt -> FastInt -> FastInt
823 shiftR_ :: FastInt -> FastInt -> FastInt
825 #if __GLASGOW_HASKELL__
826 {-# INLINE shiftL_ #-}
827 {-# INLINE shiftR_ #-}
828 #if __GLASGOW_HASKELL__ >= 503
829 shiftL_ n p = word2Int#((int2Word# n) `uncheckedShiftL#` p)
831 shiftL_ n p = word2Int#((int2Word# n) `shiftL#` p)
833 shiftR_ n p = word2Int#((int2Word# n) `shiftr` p)
835 #if __GLASGOW_HASKELL__ >= 503
836 shiftr x y = uncheckedShiftRL# x y
838 shiftr x y = shiftRL# x y
842 shiftL_ n p = n * (2 ^ p)
843 shiftR_ n p = n `quot` (2 ^ p)
849 use_snd :: a -> b -> b