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_GHC -w #-}
17 -- The above warning supression flag is a temporary kludge.
18 -- While working on this module you are encouraged to remove it and fix
19 -- any warnings in the module. See
20 -- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
24 UniqFM, -- abstract type
31 addToUFM,addToUFM_C,addToUFM_Acc,
32 addListToUFM,addListToUFM_C,
34 addListToUFM_Directly,
46 elemUFM, elemUFM_Directly,
47 filterUFM, filterUFM_Directly,
51 lookupUFM, lookupUFM_Directly,
52 lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
57 #include "HsVersions.h"
59 import Unique ( Uniquable(..), Unique, getKey#, mkUniqueGrimily )
60 import Maybes ( maybeToBool )
64 import GHC.Exts -- Lots of Int# operations
67 %************************************************************************
69 \subsection{The @UniqFM@ type, and signatures for the functions}
71 %************************************************************************
73 We use @FiniteMaps@, with a (@getUnique@-able) @Unique@ as ``key''.
76 emptyUFM :: UniqFM elt
77 isNullUFM :: UniqFM elt -> Bool
78 unitUFM :: Uniquable key => key -> elt -> UniqFM elt
79 unitDirectlyUFM -- got the Unique already
80 :: Unique -> elt -> UniqFM elt
81 listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt
83 :: [(Unique, elt)] -> UniqFM elt
85 addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt
86 addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
88 :: UniqFM elt -> Unique -> elt -> UniqFM elt
90 addToUFM_C :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
93 -> UniqFM elt -- result
95 addToUFM_Acc :: Uniquable key =>
96 (elt -> elts -> elts) -- Add to existing
97 -> (elt -> elts) -- New element
100 -> UniqFM elts -- result
102 addListToUFM_C :: Uniquable key => (elt -> elt -> elt)
103 -> UniqFM elt -> [(key,elt)]
106 delFromUFM :: Uniquable key => UniqFM elt -> key -> UniqFM elt
107 delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
108 delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
110 plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
112 plusUFM_C :: (elt -> elt -> elt)
113 -> UniqFM elt -> UniqFM elt -> UniqFM elt
115 minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
117 intersectUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
118 intersectUFM_C :: (elt1 -> elt2 -> elt3)
119 -> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
120 intersectsUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool
122 foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
123 mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
124 filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
125 filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
127 sizeUFM :: UniqFM elt -> Int
128 hashUFM :: UniqFM elt -> Int
129 elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
130 elemUFM_Directly:: Unique -> UniqFM elt -> Bool
132 lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
133 lookupUFM_Directly -- when you've got the Unique already
134 :: UniqFM elt -> Unique -> Maybe elt
136 :: Uniquable key => UniqFM elt -> elt -> key -> elt
137 lookupWithDefaultUFM_Directly
138 :: UniqFM elt -> elt -> Unique -> elt
140 keysUFM :: UniqFM elt -> [Unique] -- Get the keys
141 eltsUFM :: UniqFM elt -> [elt]
142 ufmToList :: UniqFM elt -> [(Unique, elt)]
145 %************************************************************************
147 \subsection{The @IdFinMap@ and @TyVarFinMap@ specialisations for Ids/TyVars}
149 %************************************************************************
152 -- Turn off for now, these need to be updated (SDM 4/98)
155 #ifdef __GLASGOW_HASKELL__
156 -- I don't think HBC was too happy about this (WDP 94/10)
159 addListToUFM :: UniqFM elt -> [(Name, elt)] -> UniqFM elt
162 addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name, elt)] -> UniqFM elt
165 addToUFM :: UniqFM elt -> Unique -> elt -> UniqFM elt
168 listToUFM :: [(Unique, elt)] -> UniqFM elt
171 lookupUFM :: UniqFM elt -> Name -> Maybe elt
172 , UniqFM elt -> Unique -> Maybe elt
175 #endif /* __GLASGOW_HASKELL__ */
179 %************************************************************************
181 \subsection{Andy Gill's underlying @UniqFM@ machinery}
183 %************************************************************************
185 ``Uniq Finite maps'' are the heart and soul of the compiler's
186 lookup-tables/environments. Important stuff! It works well with
187 Dense and Sparse ranges.
188 Both @Uq@ Finite maps and @Hash@ Finite Maps
189 are built ontop of Int Finite Maps.
191 This code is explained in the paper:
193 A Gill, S Peyton Jones, B O'Sullivan, W Partain and Aqua Friends
194 "A Cheap balancing act that grows on a tree"
195 Glasgow FP Workshop, Sep 1994, pp??-??
198 %************************************************************************
200 \subsubsection{The @UniqFM@ type, and signatures for the functions}
202 %************************************************************************
204 @UniqFM a@ is a mapping from Unique to a.
206 First, the DataType itself; which is either a Node, a Leaf, or an Empty.
211 | LeafUFM FastInt ele
212 | NodeUFM FastInt -- the switching
216 -- INVARIANT: the children of a NodeUFM are never EmptyUFMs
219 -- for debugging only :-)
220 instance Outputable (UniqFM a) where
221 ppr(NodeUFM a b t1 t2) =
222 sep [text "NodeUFM " <+> int IBOX(a) <+> int IBOX(b),
223 nest 1 (parens (ppr t1)),
224 nest 1 (parens (ppr t2))]
225 ppr (LeafUFM x a) = text "LeafUFM " <+> int IBOX(x)
226 ppr (EmptyUFM) = empty
228 -- and when not debugging the package itself...
229 instance Outputable a => Outputable (UniqFM a) where
230 ppr ufm = ppr (ufmToList ufm)
233 %************************************************************************
235 \subsubsection{The @UniqFM@ functions}
237 %************************************************************************
239 First the ways of building a UniqFM.
243 unitUFM key elt = mkLeafUFM (getKey# (getUnique key)) elt
244 unitDirectlyUFM key elt = mkLeafUFM (getKey# key) elt
246 listToUFM key_elt_pairs
247 = addListToUFM_C use_snd EmptyUFM key_elt_pairs
249 listToUFM_Directly uniq_elt_pairs
250 = addListToUFM_directly_C use_snd EmptyUFM uniq_elt_pairs
253 Now ways of adding things to UniqFMs.
255 There is an alternative version of @addListToUFM_C@, that uses @plusUFM@,
256 but the semantics of this operation demands a linear insertion;
257 perhaps the version without the combinator function
258 could be optimised using it.
261 addToUFM fm key elt = addToUFM_C use_snd fm key elt
263 addToUFM_Directly fm u elt = insert_ele use_snd fm (getKey# u) elt
265 addToUFM_C combiner fm key elt
266 = insert_ele combiner fm (getKey# (getUnique key)) elt
268 addToUFM_Acc add unit fm key item
269 = insert_ele combiner fm (getKey# (getUnique key)) (unit item)
271 combiner old _unit_item = add item old
273 addListToUFM fm key_elt_pairs = addListToUFM_C use_snd fm key_elt_pairs
274 addListToUFM_Directly fm uniq_elt_pairs = addListToUFM_directly_C use_snd fm uniq_elt_pairs
276 addListToUFM_C combiner fm key_elt_pairs
277 = foldl (\ fm (k, e) -> insert_ele combiner fm (getKey# (getUnique k)) e)
280 addListToUFM_directly_C combiner fm uniq_elt_pairs
281 = foldl (\ fm (k, e) -> insert_ele combiner fm (getKey# k) e)
285 Now ways of removing things from UniqFM.
288 delListFromUFM fm lst = foldl delFromUFM fm lst
290 delFromUFM fm key = delete fm (getKey# (getUnique key))
291 delFromUFM_Directly fm u = delete fm (getKey# u)
293 delete EmptyUFM _ = EmptyUFM
294 delete fm key = del_ele fm
296 del_ele :: UniqFM a -> UniqFM a
298 del_ele lf@(LeafUFM j _)
299 | j ==# key = EmptyUFM
300 | otherwise = lf -- no delete!
302 del_ele nd@(NodeUFM j p t1 t2)
304 = mkSLNodeUFM (NodeUFMData j p) (del_ele t1) t2
306 = mkLSNodeUFM (NodeUFMData j p) t1 (del_ele t2)
308 del_ele _ = panic "Found EmptyUFM FM when rec-deleting"
311 Now ways of adding two UniqFM's together.
314 plusUFM tr1 tr2 = plusUFM_C use_snd tr1 tr2
316 plusUFM_C f EmptyUFM tr = tr
317 plusUFM_C f tr EmptyUFM = tr
318 plusUFM_C f fm1 fm2 = mix_trees fm1 fm2
320 mix_trees (LeafUFM i a) t2 = insert_ele (flip f) t2 i a
321 mix_trees t1 (LeafUFM i a) = insert_ele f t1 i a
323 mix_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
325 (ask_about_common_ancestor
329 -- Given a disjoint j,j' (p >^ p' && p' >^ p):
333 -- t1 t2 t1' t2' j j'
338 mix_branches (NewRoot nd False)
339 = mkLLNodeUFM nd left_t right_t
340 mix_branches (NewRoot nd True)
341 = mkLLNodeUFM nd right_t left_t
347 -- t1 t2 t1' t2' t1 + t1' t2 + t2'
349 mix_branches (SameRoot)
350 = mkSSNodeUFM (NodeUFMData j p)
353 -- Now the 4 different other ways; all like this:
355 -- Given j >^ j' (and, say, j > j')
359 -- t1 t2 t1' t2' t1 t2 + j'
362 mix_branches (LeftRoot Leftt) -- | trace "LL" True
365 (mix_trees t1 right_t)
368 mix_branches (LeftRoot Rightt) -- | trace "LR" True
372 (mix_trees t2 right_t)
374 mix_branches (RightRoot Leftt) -- | trace "RL" True
377 (mix_trees left_t t1')
380 mix_branches (RightRoot Rightt) -- | trace "RR" True
384 (mix_trees left_t t2')
386 mix_trees _ _ = panic "EmptyUFM found when inserting into plusInt"
389 And ways of subtracting them. First the base cases,
390 then the full D&C approach.
393 minusUFM EmptyUFM _ = EmptyUFM
394 minusUFM t1 EmptyUFM = t1
395 minusUFM fm1 fm2 = minus_trees fm1 fm2
398 -- Notice the asymetry of subtraction
400 minus_trees lf@(LeafUFM i a) t2 =
405 minus_trees t1 (LeafUFM i _) = delete t1 i
407 minus_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
409 (ask_about_common_ancestor
413 -- Given a disjoint j,j' (p >^ p' && p' >^ p):
417 -- t1 t2 t1' t2' t1 t2
422 minus_branches (NewRoot nd _) = left_t
428 -- t1 t2 t1' t2' t1 + t1' t2 + t2'
430 minus_branches (SameRoot)
431 = mkSSNodeUFM (NodeUFMData j p)
434 -- Now the 4 different other ways; all like this:
435 -- again, with asymatry
438 -- The left is above the right
440 minus_branches (LeftRoot Leftt)
443 (minus_trees t1 right_t)
445 minus_branches (LeftRoot Rightt)
449 (minus_trees t2 right_t)
452 -- The right is above the left
454 minus_branches (RightRoot Leftt)
455 = minus_trees left_t t1'
456 minus_branches (RightRoot Rightt)
457 = minus_trees left_t t2'
459 minus_trees _ _ = panic "EmptyUFM found when insering into plusInt"
462 And taking the intersection of two UniqFM's.
465 intersectUFM t1 t2 = intersectUFM_C use_snd t1 t2
466 intersectsUFM t1 t2 = isNullUFM (intersectUFM_C (\ _ _ -> error "urk") t1 t2)
468 intersectUFM_C f EmptyUFM _ = EmptyUFM
469 intersectUFM_C f _ EmptyUFM = EmptyUFM
470 intersectUFM_C f fm1 fm2 = intersect_trees fm1 fm2
472 intersect_trees (LeafUFM i a) t2 =
475 Just b -> mkLeafUFM i (f a b)
477 intersect_trees t1 (LeafUFM i a) =
480 Just b -> mkLeafUFM i (f b a)
482 intersect_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
484 (ask_about_common_ancestor
488 -- Given a disjoint j,j' (p >^ p' && p' >^ p):
491 -- / \ + / \ ==> EmptyUFM
496 intersect_branches (NewRoot nd _) = EmptyUFM
502 -- t1 t2 t1' t2' t1 x t1' t2 x t2'
504 intersect_branches (SameRoot)
505 = mkSSNodeUFM (NodeUFMData j p)
506 (intersect_trees t1 t1')
507 (intersect_trees t2 t2')
508 -- Now the 4 different other ways; all like this:
510 -- Given j >^ j' (and, say, j > j')
514 -- t1 t2 t1' t2' t1' t2'
516 -- This does cut down the search space quite a bit.
518 intersect_branches (LeftRoot Leftt)
519 = intersect_trees t1 right_t
520 intersect_branches (LeftRoot Rightt)
521 = intersect_trees t2 right_t
522 intersect_branches (RightRoot Leftt)
523 = intersect_trees left_t t1'
524 intersect_branches (RightRoot Rightt)
525 = intersect_trees left_t t2'
527 intersect_trees x y = panic ("EmptyUFM found when intersecting trees")
530 Now the usual set of `collection' operators, like map, fold, etc.
533 foldUFM f a (NodeUFM _ _ t1 t2) = foldUFM f (foldUFM f a t2) t1
534 foldUFM f a (LeafUFM _ obj) = f obj a
535 foldUFM f a EmptyUFM = a
539 mapUFM fn EmptyUFM = EmptyUFM
540 mapUFM fn fm = map_tree fn fm
542 filterUFM fn EmptyUFM = EmptyUFM
543 filterUFM fn fm = filter_tree pred fm
545 pred (i::FastInt) e = fn e
547 filterUFM_Directly fn EmptyUFM = EmptyUFM
548 filterUFM_Directly fn fm = filter_tree pred fm
550 pred i e = fn (mkUniqueGrimily (iBox i)) e
553 Note, this takes a long time, O(n), but
554 because we dont want to do this very often, we put up with this.
555 O'rable, but how often do we look at the size of
560 sizeUFM (NodeUFM _ _ t1 t2) = sizeUFM t1 + sizeUFM t2
561 sizeUFM (LeafUFM _ _) = 1
563 isNullUFM EmptyUFM = True
566 -- hashing is used in VarSet.uniqAway, and should be fast
567 -- We use a cheap and cheerful method for now
569 hashUFM (NodeUFM n _ _ _) = iBox n
570 hashUFM (LeafUFM n _) = iBox n
573 looking up in a hurry is the {\em whole point} of this binary tree lark.
574 Lookup up a binary tree is easy (and fast).
577 elemUFM key fm = maybeToBool (lookupUFM fm key)
578 elemUFM_Directly key fm = maybeToBool (lookupUFM_Directly fm key)
580 lookupUFM fm key = lookUp fm (getKey# (getUnique key))
581 lookupUFM_Directly fm key = lookUp fm (getKey# key)
583 lookupWithDefaultUFM fm deflt key
584 = case lookUp fm (getKey# (getUnique key)) of
588 lookupWithDefaultUFM_Directly fm deflt key
589 = case lookUp fm (getKey# key) of
593 lookUp EmptyUFM _ = Nothing
594 lookUp fm i = lookup_tree fm
596 lookup_tree :: UniqFM a -> Maybe a
598 lookup_tree (LeafUFM j b)
600 | otherwise = Nothing
601 lookup_tree (NodeUFM j p t1 t2)
602 | j ># i = lookup_tree t1
603 | otherwise = lookup_tree t2
605 lookup_tree EmptyUFM = panic "lookup Failed"
608 folds are *wonderful* things.
611 eltsUFM fm = foldUFM (:) [] fm
613 ufmToList fm = fold_tree (\ iu elt rest -> (mkUniqueGrimily (iBox iu), elt) : rest) [] fm
615 keysUFM fm = fold_tree (\ iu elt rest -> mkUniqueGrimily (iBox iu) : rest) [] fm
617 fold_tree f a (NodeUFM _ _ t1 t2) = fold_tree f (fold_tree f a t2) t1
618 fold_tree f a (LeafUFM iu obj) = f iu obj a
619 fold_tree f a EmptyUFM = a
622 %************************************************************************
624 \subsubsection{The @UniqFM@ type, and its functions}
626 %************************************************************************
628 You should always use these to build the tree.
629 There are 4 versions of mkNodeUFM, depending on
630 the strictness of the two sub-tree arguments.
631 The strictness is used *both* to prune out
632 empty trees, *and* to improve performance,
633 stoping needless thunks lying around.
634 The rule of thumb (from experence with these trees)
635 is make thunks strict, but data structures lazy.
636 If in doubt, use mkSSNodeUFM, which has the `strongest'
637 functionality, but may do a few needless evaluations.
640 mkLeafUFM :: FastInt -> a -> UniqFM a
641 mkLeafUFM i a = LeafUFM i a
643 -- The *ONLY* ways of building a NodeUFM.
645 mkSSNodeUFM (NodeUFMData j p) EmptyUFM t2 = t2
646 mkSSNodeUFM (NodeUFMData j p) t1 EmptyUFM = t1
647 mkSSNodeUFM (NodeUFMData j p) t1 t2
648 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
651 mkSLNodeUFM (NodeUFMData j p) EmptyUFM t2 = t2
652 mkSLNodeUFM (NodeUFMData j p) t1 t2
653 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
656 mkLSNodeUFM (NodeUFMData j p) t1 EmptyUFM = t1
657 mkLSNodeUFM (NodeUFMData j p) t1 t2
658 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
661 mkLLNodeUFM (NodeUFMData j p) t1 t2
662 = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
672 correctNodeUFM j p t1 t2
673 = correct (j-p) (j-1) p t1 && correct j ((j-1)+p) p t2
675 correct low high _ (LeafUFM i _)
676 = low <= iBox i && iBox i <= high
677 correct low high above_p (NodeUFM j p _ _)
678 = low <= iBox j && iBox j <= high && above_p > iBox p
679 correct _ _ _ EmptyUFM = panic "EmptyUFM stored inside a tree"
682 Note: doing SAT on this by hand seems to make it worse. Todo: Investigate,
683 and if necessary do $\lambda$ lifting on our functions that are bound.
687 :: (a -> a -> a) -- old -> new -> result
693 insert_ele f EmptyUFM i new = mkLeafUFM i new
695 insert_ele f (LeafUFM j old) i new
697 mkLLNodeUFM (getCommonNodeUFMData
702 | j ==# i = mkLeafUFM j (f old new)
704 mkLLNodeUFM (getCommonNodeUFMData
710 insert_ele f n@(NodeUFM j p t1 t2) i a
712 = if (i >=# (j -# p))
713 then mkSLNodeUFM (NodeUFMData j p) (insert_ele f t1 i a) t2
714 else mkLLNodeUFM (getCommonNodeUFMData
720 = if (i <=# ((j -# _ILIT(1)) +# p))
721 then mkLSNodeUFM (NodeUFMData j p) t1 (insert_ele f t2 i a)
722 else mkLLNodeUFM (getCommonNodeUFMData
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 f _ = panic "map_tree failed"
741 filter_tree :: (FastInt -> a -> Bool) -> UniqFM a -> UniqFM a
742 filter_tree f nd@(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 f _ = 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
787 l = (_ILIT(1) :: FastInt)
789 NodeUFMData (((i `shiftR_` l) `shiftL_` l) +# _ILIT(1)) l
791 getCommonNodeUFMData :: NodeUFMData -> NodeUFMData -> NodeUFMData
793 getCommonNodeUFMData (NodeUFMData i p) (NodeUFMData i2 p2)
794 | p ==# p2 = getCommonNodeUFMData_ p j j2
795 | p <# p2 = getCommonNodeUFMData_ p2 (j `quotFastInt` (p2 `quotFastInt` p)) j2
796 | otherwise = getCommonNodeUFMData_ p j (j2 `quotFastInt` (p `quotFastInt` p2))
798 l = (_ILIT(1) :: FastInt)
799 j = i `quotFastInt` (p `shiftL_` l)
800 j2 = i2 `quotFastInt` (p2 `shiftL_` l)
802 getCommonNodeUFMData_ :: FastInt -> FastInt -> FastInt -> NodeUFMData
804 getCommonNodeUFMData_ p j j_
806 = NodeUFMData (((j `shiftL_` l) +# l) *# p) p
808 = getCommonNodeUFMData_ (p `shiftL_` l) (j `shiftR_` l) (j_ `shiftR_` l)
810 ask_about_common_ancestor :: NodeUFMData -> NodeUFMData -> CommonRoot
812 ask_about_common_ancestor x@(NodeUFMData j p) y@(NodeUFMData j2 p2)
813 | j ==# j2 = SameRoot
815 = case getCommonNodeUFMData x y of
816 nd@(NodeUFMData j3 p3)
817 | j3 ==# j -> LeftRoot (decideSide (j ># j2))
818 | j3 ==# j2 -> RightRoot (decideSide (j <# j2))
819 | otherwise -> NewRoot nd (j ># j2)
821 decideSide :: Bool -> Side
822 decideSide True = Leftt
823 decideSide False = Rightt
826 This might be better in Util.lhs ?
829 Now the bit twiddling functions.
831 shiftL_ :: FastInt -> FastInt -> FastInt
832 shiftR_ :: FastInt -> FastInt -> FastInt
834 #if __GLASGOW_HASKELL__
835 {-# INLINE shiftL_ #-}
836 {-# INLINE shiftR_ #-}
837 shiftL_ n p = word2Int#((int2Word# n) `uncheckedShiftL#` p)
838 shiftR_ n p = word2Int#((int2Word# n) `uncheckedShiftRL#` p)
841 shiftL_ n p = n * (2 ^ p)
842 shiftR_ n p = n `quot` (2 ^ p)
848 use_snd :: a -> b -> b