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,
36 elemUFM, elemUFM_Directly,
37 filterUFM, filterUFM_Directly,
41 lookupUFM, lookupUFM_Directly,
42 lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
47 #include "HsVersions.h"
49 import Unique ( Uniquable(..), Unique, getKey#, mkUniqueGrimily )
50 import Maybes ( maybeToBool )
54 import GLAEXTS -- Lots of Int# operations
57 %************************************************************************
59 \subsection{The @UniqFM@ type, and signatures for the functions}
61 %************************************************************************
63 We use @FiniteMaps@, with a (@getUnique@-able) @Unique@ as ``key''.
66 emptyUFM :: UniqFM elt
67 isNullUFM :: UniqFM elt -> Bool
68 unitUFM :: Uniquable key => key -> elt -> UniqFM elt
69 unitDirectlyUFM -- got the Unique already
70 :: Unique -> elt -> UniqFM elt
71 listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt
73 :: [(Unique, elt)] -> UniqFM elt
75 addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt
76 addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
78 :: UniqFM elt -> Unique -> elt -> UniqFM elt
80 addToUFM_C :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
83 -> UniqFM elt -- result
85 addToUFM_Acc :: Uniquable key =>
86 (elt -> elts -> elts) -- Add to existing
87 -> (elt -> elts) -- New element
90 -> UniqFM elts -- result
92 addListToUFM_C :: Uniquable key => (elt -> elt -> elt)
93 -> UniqFM elt -> [(key,elt)]
96 delFromUFM :: Uniquable key => UniqFM elt -> key -> UniqFM elt
97 delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
98 delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
100 plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
102 plusUFM_C :: (elt -> elt -> elt)
103 -> UniqFM elt -> UniqFM elt -> UniqFM elt
105 minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
107 intersectUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
108 intersectUFM_C :: (elt1 -> elt2 -> elt3)
109 -> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
110 foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
111 mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
112 filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
113 filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
115 sizeUFM :: UniqFM elt -> Int
116 hashUFM :: UniqFM elt -> Int
117 elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
118 elemUFM_Directly:: Unique -> UniqFM elt -> Bool
120 lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
121 lookupUFM_Directly -- when you've got the Unique already
122 :: UniqFM elt -> Unique -> Maybe elt
124 :: Uniquable key => UniqFM elt -> elt -> key -> elt
125 lookupWithDefaultUFM_Directly
126 :: UniqFM elt -> elt -> Unique -> elt
128 keysUFM :: UniqFM elt -> [Unique] -- Get the keys
129 eltsUFM :: UniqFM elt -> [elt]
130 ufmToList :: UniqFM elt -> [(Unique, elt)]
133 %************************************************************************
135 \subsection{The @IdFinMap@ and @TyVarFinMap@ specialisations for Ids/TyVars}
137 %************************************************************************
140 -- Turn off for now, these need to be updated (SDM 4/98)
143 #ifdef __GLASGOW_HASKELL__
144 -- I don't think HBC was too happy about this (WDP 94/10)
147 addListToUFM :: UniqFM elt -> [(Name, elt)] -> UniqFM elt
150 addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name, elt)] -> UniqFM elt
153 addToUFM :: UniqFM elt -> Unique -> elt -> UniqFM elt
156 listToUFM :: [(Unique, elt)] -> UniqFM elt
159 lookupUFM :: UniqFM elt -> Name -> Maybe elt
160 , UniqFM elt -> Unique -> Maybe elt
163 #endif /* __GLASGOW_HASKELL__ */
167 %************************************************************************
169 \subsection{Andy Gill's underlying @UniqFM@ machinery}
171 %************************************************************************
173 ``Uniq Finite maps'' are the heart and soul of the compiler's
174 lookup-tables/environments. Important stuff! It works well with
175 Dense and Sparse ranges.
176 Both @Uq@ Finite maps and @Hash@ Finite Maps
177 are built ontop of Int Finite Maps.
179 This code is explained in the paper:
181 A Gill, S Peyton Jones, B O'Sullivan, W Partain and Aqua Friends
182 "A Cheap balancing act that grows on a tree"
183 Glasgow FP Workshop, Sep 1994, pp??-??
186 %************************************************************************
188 \subsubsection{The @UniqFM@ type, and signatures for the functions}
190 %************************************************************************
192 @UniqFM a@ is a mapping from Unique to a.
194 First, the DataType itself; which is either a Node, a Leaf, or an Empty.
199 | LeafUFM FastInt ele
200 | NodeUFM FastInt -- the switching
204 -- INVARIANT: the children of a NodeUFM are never EmptyUFMs
207 -- for debugging only :-)
208 instance Outputable (UniqFM a) where
209 ppr(NodeUFM a b t1 t2) =
210 sep [text "NodeUFM " <+> int IBOX(a) <+> int IBOX(b),
211 nest 1 (parens (ppr t1)),
212 nest 1 (parens (ppr t2))]
213 ppr (LeafUFM x a) = text "LeafUFM " <+> int IBOX(x)
214 ppr (EmptyUFM) = empty
216 -- and when not debugging the package itself...
217 instance Outputable a => Outputable (UniqFM a) where
218 ppr ufm = ppr (ufmToList ufm)
221 %************************************************************************
223 \subsubsection{The @UniqFM@ functions}
225 %************************************************************************
227 First the ways of building a UniqFM.
231 unitUFM key elt = mkLeafUFM (getKey# (getUnique key)) elt
232 unitDirectlyUFM key elt = mkLeafUFM (getKey# key) elt
234 listToUFM key_elt_pairs
235 = addListToUFM_C use_snd EmptyUFM key_elt_pairs
237 listToUFM_Directly uniq_elt_pairs
238 = addListToUFM_directly_C use_snd EmptyUFM uniq_elt_pairs
241 Now ways of adding things to UniqFMs.
243 There is an alternative version of @addListToUFM_C@, that uses @plusUFM@,
244 but the semantics of this operation demands a linear insertion;
245 perhaps the version without the combinator function
246 could be optimised using it.
249 addToUFM fm key elt = addToUFM_C use_snd fm key elt
251 addToUFM_Directly fm u elt = insert_ele use_snd fm (getKey# u) elt
253 addToUFM_C combiner fm key elt
254 = insert_ele combiner fm (getKey# (getUnique key)) elt
256 addToUFM_Acc add unit fm key item
257 = insert_ele combiner fm (getKey# (getUnique key)) (unit item)
259 combiner old _unit_item = add item old
261 addListToUFM fm key_elt_pairs = addListToUFM_C use_snd fm key_elt_pairs
262 addListToUFM_Directly fm uniq_elt_pairs = addListToUFM_directly_C use_snd fm uniq_elt_pairs
264 addListToUFM_C combiner fm key_elt_pairs
265 = foldl (\ fm (k, e) -> insert_ele combiner fm (getKey# (getUnique k)) e)
268 addListToUFM_directly_C combiner fm uniq_elt_pairs
269 = foldl (\ fm (k, e) -> insert_ele combiner fm (getKey# k) e)
273 Now ways of removing things from UniqFM.
276 delListFromUFM fm lst = foldl delFromUFM fm lst
278 delFromUFM fm key = delete fm (getKey# (getUnique key))
279 delFromUFM_Directly fm u = delete fm (getKey# u)
281 delete EmptyUFM _ = EmptyUFM
282 delete fm key = del_ele fm
284 del_ele :: UniqFM a -> UniqFM a
286 del_ele lf@(LeafUFM j _)
287 | j ==# key = EmptyUFM
288 | otherwise = lf -- no delete!
290 del_ele nd@(NodeUFM j p t1 t2)
292 = mkSLNodeUFM (NodeUFMData j p) (del_ele t1) t2
294 = mkLSNodeUFM (NodeUFMData j p) t1 (del_ele t2)
296 del_ele _ = panic "Found EmptyUFM FM when rec-deleting"
299 Now ways of adding two UniqFM's together.
302 plusUFM tr1 tr2 = plusUFM_C use_snd tr1 tr2
304 plusUFM_C f EmptyUFM tr = tr
305 plusUFM_C f tr EmptyUFM = tr
306 plusUFM_C f fm1 fm2 = mix_trees fm1 fm2
308 mix_trees (LeafUFM i a) t2 = insert_ele (flip f) t2 i a
309 mix_trees t1 (LeafUFM i a) = insert_ele f t1 i a
311 mix_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
313 (ask_about_common_ancestor
317 -- Given a disjoint j,j' (p >^ p' && p' >^ p):
321 -- t1 t2 t1' t2' j j'
326 mix_branches (NewRoot nd False)
327 = mkLLNodeUFM nd left_t right_t
328 mix_branches (NewRoot nd True)
329 = mkLLNodeUFM nd right_t left_t
335 -- t1 t2 t1' t2' t1 + t1' t2 + t2'
337 mix_branches (SameRoot)
338 = mkSSNodeUFM (NodeUFMData j p)
341 -- Now the 4 different other ways; all like this:
343 -- Given j >^ j' (and, say, j > j')
347 -- t1 t2 t1' t2' t1 t2 + j'
350 mix_branches (LeftRoot Leftt) -- | trace "LL" True
353 (mix_trees t1 right_t)
356 mix_branches (LeftRoot Rightt) -- | trace "LR" True
360 (mix_trees t2 right_t)
362 mix_branches (RightRoot Leftt) -- | trace "RL" True
365 (mix_trees left_t t1')
368 mix_branches (RightRoot Rightt) -- | trace "RR" True
372 (mix_trees left_t t2')
374 mix_trees _ _ = panic "EmptyUFM found when inserting into plusInt"
377 And ways of subtracting them. First the base cases,
378 then the full D&C approach.
381 minusUFM EmptyUFM _ = EmptyUFM
382 minusUFM t1 EmptyUFM = t1
383 minusUFM fm1 fm2 = minus_trees fm1 fm2
386 -- Notice the asymetry of subtraction
388 minus_trees lf@(LeafUFM i a) t2 =
393 minus_trees t1 (LeafUFM i _) = delete t1 i
395 minus_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
397 (ask_about_common_ancestor
401 -- Given a disjoint j,j' (p >^ p' && p' >^ p):
405 -- t1 t2 t1' t2' t1 t2
410 minus_branches (NewRoot nd _) = left_t
416 -- t1 t2 t1' t2' t1 + t1' t2 + t2'
418 minus_branches (SameRoot)
419 = mkSSNodeUFM (NodeUFMData j p)
422 -- Now the 4 different other ways; all like this:
423 -- again, with asymatry
426 -- The left is above the right
428 minus_branches (LeftRoot Leftt)
431 (minus_trees t1 right_t)
433 minus_branches (LeftRoot Rightt)
437 (minus_trees t2 right_t)
440 -- The right is above the left
442 minus_branches (RightRoot Leftt)
443 = minus_trees left_t t1'
444 minus_branches (RightRoot Rightt)
445 = minus_trees left_t t2'
447 minus_trees _ _ = panic "EmptyUFM found when insering into plusInt"
450 And taking the intersection of two UniqFM's.
453 intersectUFM t1 t2 = intersectUFM_C use_snd t1 t2
455 intersectUFM_C f EmptyUFM _ = EmptyUFM
456 intersectUFM_C f _ EmptyUFM = EmptyUFM
457 intersectUFM_C f fm1 fm2 = intersect_trees fm1 fm2
459 intersect_trees (LeafUFM i a) t2 =
462 Just b -> mkLeafUFM i (f a b)
464 intersect_trees t1 (LeafUFM i a) =
467 Just b -> mkLeafUFM i (f b a)
469 intersect_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
471 (ask_about_common_ancestor
475 -- Given a disjoint j,j' (p >^ p' && p' >^ p):
478 -- / \ + / \ ==> EmptyUFM
483 intersect_branches (NewRoot nd _) = EmptyUFM
489 -- t1 t2 t1' t2' t1 x t1' t2 x t2'
491 intersect_branches (SameRoot)
492 = mkSSNodeUFM (NodeUFMData j p)
493 (intersect_trees t1 t1')
494 (intersect_trees t2 t2')
495 -- Now the 4 different other ways; all like this:
497 -- Given j >^ j' (and, say, j > j')
501 -- t1 t2 t1' t2' t1' t2'
503 -- This does cut down the search space quite a bit.
505 intersect_branches (LeftRoot Leftt)
506 = intersect_trees t1 right_t
507 intersect_branches (LeftRoot Rightt)
508 = intersect_trees t2 right_t
509 intersect_branches (RightRoot Leftt)
510 = intersect_trees left_t t1'
511 intersect_branches (RightRoot Rightt)
512 = intersect_trees left_t t2'
514 intersect_trees x y = panic ("EmptyUFM found when intersecting trees")
517 Now the usual set of `collection' operators, like map, fold, etc.
520 foldUFM f a (NodeUFM _ _ t1 t2) = foldUFM f (foldUFM f a t2) t1
521 foldUFM f a (LeafUFM _ obj) = f obj a
522 foldUFM f a EmptyUFM = a
526 mapUFM fn EmptyUFM = EmptyUFM
527 mapUFM fn fm = map_tree fn fm
529 filterUFM fn EmptyUFM = EmptyUFM
530 filterUFM fn fm = filter_tree pred fm
532 pred (i::FastInt) e = fn e
534 filterUFM_Directly fn EmptyUFM = EmptyUFM
535 filterUFM_Directly fn fm = filter_tree pred fm
537 pred i e = fn (mkUniqueGrimily (iBox i)) e
540 Note, this takes a long time, O(n), but
541 because we dont want to do this very often, we put up with this.
542 O'rable, but how often do we look at the size of
547 sizeUFM (NodeUFM _ _ t1 t2) = sizeUFM t1 + sizeUFM t2
548 sizeUFM (LeafUFM _ _) = 1
550 isNullUFM EmptyUFM = True
553 -- hashing is used in VarSet.uniqAway, and should be fast
554 -- We use a cheap and cheerful method for now
556 hashUFM (NodeUFM n _ _ _) = iBox n
557 hashUFM (LeafUFM n _) = iBox n
560 looking up in a hurry is the {\em whole point} of this binary tree lark.
561 Lookup up a binary tree is easy (and fast).
564 elemUFM key fm = maybeToBool (lookupUFM fm key)
565 elemUFM_Directly key fm = maybeToBool (lookupUFM_Directly fm key)
567 lookupUFM fm key = lookUp fm (getKey# (getUnique key))
568 lookupUFM_Directly fm key = lookUp fm (getKey# key)
570 lookupWithDefaultUFM fm deflt key
571 = case lookUp fm (getKey# (getUnique key)) of
575 lookupWithDefaultUFM_Directly fm deflt key
576 = case lookUp fm (getKey# key) of
580 lookUp EmptyUFM _ = Nothing
581 lookUp fm i = lookup_tree fm
583 lookup_tree :: UniqFM a -> Maybe a
585 lookup_tree (LeafUFM j b)
587 | otherwise = Nothing
588 lookup_tree (NodeUFM j p t1 t2)
589 | j ># i = lookup_tree t1
590 | otherwise = lookup_tree t2
592 lookup_tree EmptyUFM = panic "lookup Failed"
595 folds are *wonderful* things.
598 eltsUFM fm = foldUFM (:) [] fm
600 ufmToList fm = fold_tree (\ iu elt rest -> (mkUniqueGrimily (iBox iu), elt) : rest) [] fm
602 keysUFM fm = fold_tree (\ iu elt rest -> mkUniqueGrimily (iBox iu) : rest) [] fm
604 fold_tree f a (NodeUFM _ _ t1 t2) = fold_tree f (fold_tree f a t2) t1
605 fold_tree f a (LeafUFM iu obj) = f iu obj a
606 fold_tree f a EmptyUFM = a
609 %************************************************************************
611 \subsubsection{The @UniqFM@ type, and its functions}
613 %************************************************************************
615 You should always use these to build the tree.
616 There are 4 versions of mkNodeUFM, depending on
617 the strictness of the two sub-tree arguments.
618 The strictness is used *both* to prune out
619 empty trees, *and* to improve performance,
620 stoping needless thunks lying around.
621 The rule of thumb (from experence with these trees)
622 is make thunks strict, but data structures lazy.
623 If in doubt, use mkSSNodeUFM, which has the `strongest'
624 functionality, but may do a few needless evaluations.
627 mkLeafUFM :: FastInt -> a -> UniqFM a
628 mkLeafUFM i a = LeafUFM i a
630 -- The *ONLY* ways of building a NodeUFM.
632 mkSSNodeUFM (NodeUFMData j p) EmptyUFM t2 = t2
633 mkSSNodeUFM (NodeUFMData j p) t1 EmptyUFM = t1
634 mkSSNodeUFM (NodeUFMData j p) t1 t2
635 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
638 mkSLNodeUFM (NodeUFMData j p) EmptyUFM t2 = t2
639 mkSLNodeUFM (NodeUFMData j p) t1 t2
640 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
643 mkLSNodeUFM (NodeUFMData j p) t1 EmptyUFM = t1
644 mkLSNodeUFM (NodeUFMData j p) t1 t2
645 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
648 mkLLNodeUFM (NodeUFMData j p) t1 t2
649 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
659 correctNodeUFM j p t1 t2
660 = correct (j-p) (j-1) p t1 && correct j ((j-1)+p) p t2
662 correct low high _ (LeafUFM i _)
663 = low <= iBox i && iBox i <= high
664 correct low high above_p (NodeUFM j p _ _)
665 = low <= iBox j && iBox j <= high && above_p > iBox p
666 correct _ _ _ EmptyUFM = panic "EmptyUFM stored inside a tree"
669 Note: doing SAT on this by hand seems to make it worse. Todo: Investigate,
670 and if necessary do $\lambda$ lifting on our functions that are bound.
674 :: (a -> a -> a) -- old -> new -> result
680 insert_ele f EmptyUFM i new = mkLeafUFM i new
682 insert_ele f (LeafUFM j old) i new
684 mkLLNodeUFM (getCommonNodeUFMData
689 | j ==# i = mkLeafUFM j (f old new)
691 mkLLNodeUFM (getCommonNodeUFMData
697 insert_ele f n@(NodeUFM j p t1 t2) i a
699 = if (i >=# (j -# p))
700 then mkSLNodeUFM (NodeUFMData j p) (insert_ele f t1 i a) t2
701 else mkLLNodeUFM (getCommonNodeUFMData
707 = if (i <=# ((j -# _ILIT(1)) +# p))
708 then mkLSNodeUFM (NodeUFMData j p) t1 (insert_ele f t2 i a)
709 else mkLLNodeUFM (getCommonNodeUFMData
719 map_tree f (NodeUFM j p t1 t2)
720 = mkLLNodeUFM (NodeUFMData j p) (map_tree f t1) (map_tree f t2)
721 -- NB. lazy! we know the tree is well-formed.
722 map_tree f (LeafUFM i obj)
723 = mkLeafUFM i (f obj)
724 map_tree f _ = panic "map_tree failed"
728 filter_tree :: (FastInt -> a -> Bool) -> UniqFM a -> UniqFM a
729 filter_tree f nd@(NodeUFM j p t1 t2)
730 = mkSSNodeUFM (NodeUFMData j p) (filter_tree f t1) (filter_tree f t2)
732 filter_tree f lf@(LeafUFM i obj)
734 | otherwise = EmptyUFM
735 filter_tree f _ = panic "filter_tree failed"
738 %************************************************************************
740 \subsubsection{The @UniqFM@ type, and signatures for the functions}
742 %************************************************************************
746 This is the information that is held inside a NodeUFM, packaged up for
751 = NodeUFMData FastInt
755 This is the information used when computing new NodeUFMs.
758 data Side = Leftt | Rightt -- NB: avoid 1.3 names "Left" and "Right"
760 = LeftRoot Side -- which side is the right down ?
761 | RightRoot Side -- which side is the left down ?
762 | SameRoot -- they are the same !
763 | NewRoot NodeUFMData -- here's the new, common, root
764 Bool -- do you need to swap left and right ?
767 This specifies the relationship between NodeUFMData and CalcNodeUFMData.
770 indexToRoot :: FastInt -> NodeUFMData
774 l = (_ILIT(1) :: FastInt)
776 NodeUFMData (((i `shiftR_` l) `shiftL_` l) +# _ILIT(1)) l
778 getCommonNodeUFMData :: NodeUFMData -> NodeUFMData -> NodeUFMData
780 getCommonNodeUFMData (NodeUFMData i p) (NodeUFMData i2 p2)
781 | p ==# p2 = getCommonNodeUFMData_ p j j2
782 | p <# p2 = getCommonNodeUFMData_ p2 (j `quotFastInt` (p2 `quotFastInt` p)) j2
783 | otherwise = getCommonNodeUFMData_ p j (j2 `quotFastInt` (p `quotFastInt` p2))
785 l = (_ILIT(1) :: FastInt)
786 j = i `quotFastInt` (p `shiftL_` l)
787 j2 = i2 `quotFastInt` (p2 `shiftL_` l)
789 getCommonNodeUFMData_ :: FastInt -> FastInt -> FastInt -> NodeUFMData
791 getCommonNodeUFMData_ p j j_
793 = NodeUFMData (((j `shiftL_` l) +# l) *# p) p
795 = getCommonNodeUFMData_ (p `shiftL_` l) (j `shiftR_` l) (j_ `shiftR_` l)
797 ask_about_common_ancestor :: NodeUFMData -> NodeUFMData -> CommonRoot
799 ask_about_common_ancestor x@(NodeUFMData j p) y@(NodeUFMData j2 p2)
800 | j ==# j2 = SameRoot
802 = case getCommonNodeUFMData x y of
803 nd@(NodeUFMData j3 p3)
804 | j3 ==# j -> LeftRoot (decideSide (j ># j2))
805 | j3 ==# j2 -> RightRoot (decideSide (j <# j2))
806 | otherwise -> NewRoot nd (j ># j2)
808 decideSide :: Bool -> Side
809 decideSide True = Leftt
810 decideSide False = Rightt
813 This might be better in Util.lhs ?
816 Now the bit twiddling functions.
818 shiftL_ :: FastInt -> FastInt -> FastInt
819 shiftR_ :: FastInt -> FastInt -> FastInt
821 #if __GLASGOW_HASKELL__
822 {-# INLINE shiftL_ #-}
823 {-# INLINE shiftR_ #-}
824 #if __GLASGOW_HASKELL__ >= 503
825 shiftL_ n p = word2Int#((int2Word# n) `uncheckedShiftL#` p)
827 shiftL_ n p = word2Int#((int2Word# n) `shiftL#` p)
829 shiftR_ n p = word2Int#((int2Word# n) `shiftr` p)
831 #if __GLASGOW_HASKELL__ >= 503
832 shiftr x y = uncheckedShiftRL# x y
834 shiftr x y = shiftRL# x y
838 shiftL_ n p = n * (2 ^ p)
839 shiftR_ n p = n `quot` (2 ^ p)
845 use_snd :: a -> b -> b